282 lines
11 KiB
EmacsLisp
282 lines
11 KiB
EmacsLisp
|
;;; polymode-weave.el --- Weaving facilities for polymodes -*- lexical-binding: t -*-
|
|||
|
|
;;
|
|||
|
|
;; Copyright (C) 2013-2019, Vitalie Spinu
|
|||
|
|
;; Author: Vitalie Spinu
|
|||
|
|
;; URL: https://github.com/vspinu/polymode
|
|||
|
|
;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;
|
|||
|
|
;; This file is *NOT* part of GNU Emacs.
|
|||
|
|
;;
|
|||
|
|
;; This program is free software; you can redistribute it and/or
|
|||
|
|
;; modify it under the terms of the GNU General Public License as
|
|||
|
|
;; published by the Free Software Foundation; either version 3, or
|
|||
|
|
;; (at your option) any later version.
|
|||
|
|
;;
|
|||
|
|
;; This program is distributed in the hope that it will be useful,
|
|||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|||
|
|
;; General Public License for more details.
|
|||
|
|
;;
|
|||
|
|
;; You should have received a copy of the GNU General Public License
|
|||
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|||
|
|
;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;
|
|||
|
|
;;; Commentary:
|
|||
|
|
;;
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
(require 'polymode-core)
|
|||
|
|
(require 'polymode-classes)
|
|||
|
|
|
|||
|
|
(defgroup polymode-weave nil
|
|||
|
|
"Polymode Weavers"
|
|||
|
|
:group 'polymode)
|
|||
|
|
|
|||
|
|
(define-obsolete-variable-alias 'polymode-weave-output-file-format 'polymode-weaver-output-file-format "2018-08")
|
|||
|
|
(defcustom polymode-weaver-output-file-format "%s-woven"
|
|||
|
|
"Format of the weaved files.
|
|||
|
|
%s is substituted with the current file name sans extension."
|
|||
|
|
:group 'polymode-weave
|
|||
|
|
:type 'string)
|
|||
|
|
|
|||
|
|
(defclass pm-weaver (pm-root)
|
|||
|
|
((from-to
|
|||
|
|
:initarg :from-to
|
|||
|
|
:initform '()
|
|||
|
|
:type list
|
|||
|
|
:custom list
|
|||
|
|
:documentation
|
|||
|
|
"
|
|||
|
|
Input-output specifications. An alist with elements of the
|
|||
|
|
form (id reg-from ext-to doc command) or (id . selector).
|
|||
|
|
|
|||
|
|
In both cases ID is the unique identifier of the spec. In
|
|||
|
|
the former case REG-FROM is a regexp used to identify if
|
|||
|
|
current file can be weaved with the spec. EXT-TO is the
|
|||
|
|
extension of the output file. DOC is a short help string
|
|||
|
|
used for interactive completion and messages. COMMAND is a
|
|||
|
|
weaver specific specific command. It can contain the
|
|||
|
|
following format specs:
|
|||
|
|
|
|||
|
|
%i - input file (no dir)
|
|||
|
|
%I - input file (full path)
|
|||
|
|
%o - output file (no dir)
|
|||
|
|
%O - output file (full path)
|
|||
|
|
%b - output file (base name only)
|
|||
|
|
%t - 4th element of the :to spec
|
|||
|
|
|
|||
|
|
When specification is of the form (id . selector), SELECTOR
|
|||
|
|
is a function of variable arguments with first two arguments
|
|||
|
|
being ACTION and ID of the specification. This function is
|
|||
|
|
called in a buffer visiting input file. ACTION is a symbol
|
|||
|
|
and can one of the following:
|
|||
|
|
|
|||
|
|
match - must return non-nil if this specification
|
|||
|
|
applies to the file that current buffer is visiting,
|
|||
|
|
or :nomatch if specification does not apply.
|
|||
|
|
|
|||
|
|
regexp - return a string which is used to match input
|
|||
|
|
file name. If nil, `match' selector must return
|
|||
|
|
non-nil value. This selector is ignored if `match'
|
|||
|
|
returned non-nil.
|
|||
|
|
|
|||
|
|
output-file - return an output file name or a list of
|
|||
|
|
file names. Receives input-file as argument. If this
|
|||
|
|
command returns nil, the output is built from the
|
|||
|
|
input file name and value of 'output-ext command.
|
|||
|
|
|
|||
|
|
This selector can also return a function. This
|
|||
|
|
function will be called in the callback or sentinel of
|
|||
|
|
the weaving process after the weaving was
|
|||
|
|
completed. This function should sniff the output of
|
|||
|
|
the process for errors or file names. It must return a
|
|||
|
|
file name, a list of file names or nil if no such
|
|||
|
|
files have been detected.
|
|||
|
|
|
|||
|
|
ext - extension of output file. If nil and
|
|||
|
|
`output' also returned nil, the exporter won't be able
|
|||
|
|
to identify the output file and no automatic display
|
|||
|
|
or preview will be available.
|
|||
|
|
|
|||
|
|
doc - return documentation string
|
|||
|
|
|
|||
|
|
command - return a string to be used instead of
|
|||
|
|
the :from command. If nil, :from spec command is used.")
|
|||
|
|
(function
|
|||
|
|
:initarg :function
|
|||
|
|
:initform (lambda (command id)
|
|||
|
|
(error "No weaving function declared for this weaver"))
|
|||
|
|
:type (or symbol function)
|
|||
|
|
:documentation
|
|||
|
|
"Function to perform the weaving. Must take 2 arguments
|
|||
|
|
COMMAND and ID. COMMAND is the 5th argument of :from-to spec
|
|||
|
|
with all the formats substituted. ID is the id the
|
|||
|
|
corresponding element in :from-to spec.
|
|||
|
|
|
|||
|
|
If this function returns a filename that file will be
|
|||
|
|
displayed to the user."))
|
|||
|
|
"Root weaver class.")
|
|||
|
|
|
|||
|
|
(defclass pm-callback-weaver (pm-weaver)
|
|||
|
|
((callback
|
|||
|
|
:initarg :callback
|
|||
|
|
:initform nil
|
|||
|
|
:type (or symbol function)
|
|||
|
|
:documentation
|
|||
|
|
"Callback function to be called by :function. There is no
|
|||
|
|
default callback. Callbacks must return the output file."))
|
|||
|
|
"Class to represent weavers that call processes spanned by
|
|||
|
|
Emacs.")
|
|||
|
|
|
|||
|
|
(defclass pm-shell-weaver (pm-weaver)
|
|||
|
|
((function
|
|||
|
|
:initform 'pm-default-shell-weave-function)
|
|||
|
|
(sentinel
|
|||
|
|
:initarg :sentinel
|
|||
|
|
:initform 'pm-default-shell-weave-sentinel
|
|||
|
|
:type (or symbol function)
|
|||
|
|
:documentation
|
|||
|
|
"Sentinel function to be called by :function when a shell
|
|||
|
|
call is involved. Sentinel must return the output file
|
|||
|
|
name.")
|
|||
|
|
(quote
|
|||
|
|
:initarg :quote
|
|||
|
|
:initform nil
|
|||
|
|
:type boolean
|
|||
|
|
:documentation "Non-nil when file arguments must be quoted
|
|||
|
|
with `shell-quote-argument'."))
|
|||
|
|
"Class for weavers that call external processes.")
|
|||
|
|
|
|||
|
|
(defun pm-default-shell-weave-function (command sentinel from-to-id &rest _args)
|
|||
|
|
"Run weaving COMMAND interactively with SENTINEL.
|
|||
|
|
Run command in a buffer (in comint-shell-mode) so that it accepts
|
|||
|
|
user interaction. This is a default function in all weavers that
|
|||
|
|
call a shell command. FROM-TO-ID is the idea of the weaver. ARGS
|
|||
|
|
are ignored."
|
|||
|
|
(pm--run-shell-command command sentinel "*polymode weave*"
|
|||
|
|
(concat "weaving " from-to-id " with command:\n\n "
|
|||
|
|
command "\n\n")))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; METHODS
|
|||
|
|
|
|||
|
|
(declare-function pm-export "polymode-export")
|
|||
|
|
|
|||
|
|
(cl-defgeneric pm-weave (weaver from-to-id &optional ifile)
|
|||
|
|
"Weave current FILE with WEAVER.
|
|||
|
|
WEAVER is an object of class `pm-weaver'. EXPORT is a list of the
|
|||
|
|
form (FROM TO) suitable to be passed to `polymode-export'. If
|
|||
|
|
EXPORT is provided, corresponding exporter's (from to)
|
|||
|
|
specification will be called.")
|
|||
|
|
|
|||
|
|
(cl-defmethod pm-weave ((weaver pm-weaver) from-to-id &optional ifile)
|
|||
|
|
(pm--process-internal weaver from-to-id nil ifile))
|
|||
|
|
|
|||
|
|
(cl-defmethod pm-weave ((weaver pm-callback-weaver) fromto-id &optional ifile)
|
|||
|
|
(let ((cb (pm--wrap-callback weaver :callback ifile))
|
|||
|
|
;; with transitory output, callback might not run
|
|||
|
|
(pm--export-spec (and pm--output-not-real pm--export-spec)))
|
|||
|
|
(pm--process-internal weaver fromto-id nil ifile cb)))
|
|||
|
|
|
|||
|
|
(cl-defmethod pm-weave ((weaver pm-shell-weaver) fromto-id &optional ifile)
|
|||
|
|
(let ((cb (pm--wrap-callback weaver :sentinel ifile))
|
|||
|
|
;; with transitory output, callback might not run
|
|||
|
|
(pm--export-spec (and pm--output-not-real pm--export-spec)))
|
|||
|
|
(pm--process-internal weaver fromto-id nil ifile cb (eieio-oref weaver 'quote))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;; UI
|
|||
|
|
|
|||
|
|
(defvar-local pm--weaver-hist nil)
|
|||
|
|
(defvar-local pm--weave:fromto-hist nil)
|
|||
|
|
(defvar-local pm--weave:fromto-last nil)
|
|||
|
|
|
|||
|
|
(defun polymode-weave (&optional from-to)
|
|||
|
|
"Weave current file.
|
|||
|
|
First time this command is called in a buffer the user is asked
|
|||
|
|
for the weaver to use from a list of known weavers.
|
|||
|
|
|
|||
|
|
FROM-TO is the id of the specification declared in :from-to slot
|
|||
|
|
of the current weaver. If the weaver hasn't been set yet, set the
|
|||
|
|
weaver with `polymode-set-weaver'. You can always change the
|
|||
|
|
weaver manually by invoking `polymode-set-weaver'.
|
|||
|
|
|
|||
|
|
If `from-to' dismissing detect automatically based on current
|
|||
|
|
weaver :from-to specifications. If this detection is ambiguous
|
|||
|
|
ask the user.
|
|||
|
|
|
|||
|
|
When `from-to' is universal argument ask user for specification
|
|||
|
|
for the specification. See also `pm-weaveer' for the complete
|
|||
|
|
specification."
|
|||
|
|
(interactive "P")
|
|||
|
|
(cl-flet ((name.id (el) (cons (funcall (cdr el) 'doc (car el)) (car el))))
|
|||
|
|
(let* ((weaver (symbol-value (or (eieio-oref pm/polymode 'weaver)
|
|||
|
|
(polymode-set-weaver))))
|
|||
|
|
(case-fold-search t)
|
|||
|
|
|
|||
|
|
(opts (mapcar #'name.id (pm--selectors weaver :from-to)))
|
|||
|
|
(ft-id
|
|||
|
|
(cond
|
|||
|
|
;; A. guess from-to spec
|
|||
|
|
((null from-to)
|
|||
|
|
(or
|
|||
|
|
;; 1. repeated weaving; don't ask
|
|||
|
|
pm--weave:fromto-last
|
|||
|
|
|
|||
|
|
;; 2. select :from entries which match to current file
|
|||
|
|
(let ((matched (pm--matched-selectors weaver :from-to)))
|
|||
|
|
(when matched
|
|||
|
|
(if (> (length matched) 1)
|
|||
|
|
(cdr (pm--completing-read "Multiple `from-to' specs matched. Choose one: "
|
|||
|
|
(mapcar #'name.id matched)))
|
|||
|
|
(caar matched))))
|
|||
|
|
|
|||
|
|
;; 3. nothing matched, ask
|
|||
|
|
(let* ((prompt "No `from-to' specs matched. Choose one: ")
|
|||
|
|
(sel (pm--completing-read prompt opts nil t nil 'pm--weave:fromto-hist)))
|
|||
|
|
(cdr sel))))
|
|||
|
|
|
|||
|
|
;; B. C-u, force a :from-to spec
|
|||
|
|
((equal from-to '(4))
|
|||
|
|
(cdr (if (> (length opts) 1)
|
|||
|
|
(pm--completing-read "Weaver type: " opts nil t nil 'pm--weave:fromto-hist)
|
|||
|
|
(car opts))))
|
|||
|
|
;; C. string
|
|||
|
|
((stringp from-to)
|
|||
|
|
(if (assoc from-to (eieio-oref weaver 'from-to))
|
|||
|
|
from-to
|
|||
|
|
(error "Cannot find `from-to' spec '%s' in %s weaver"
|
|||
|
|
from-to (eieio-object-name weaver))))
|
|||
|
|
(t (error "'from-to' argument must be nil, universal argument or a string")))))
|
|||
|
|
|
|||
|
|
(setq-local pm--weave:fromto-last ft-id)
|
|||
|
|
(pm-weave weaver ft-id))))
|
|||
|
|
|
|||
|
|
(defmacro polymode-register-weaver (weaver default &rest configs)
|
|||
|
|
"Add WEAVER to :weavers slot of all config objects in CONFIGS.
|
|||
|
|
When DEFAULT is non-nil, also make weaver the default WEAVER for
|
|||
|
|
each polymode in CONFIGS."
|
|||
|
|
`(dolist (pm ',configs)
|
|||
|
|
(object-add-to-list (symbol-value pm) :weavers ',weaver)
|
|||
|
|
(when ,default (oset (symbol-value pm) :weaver ',weaver))))
|
|||
|
|
|
|||
|
|
(defun polymode-set-weaver ()
|
|||
|
|
"Set the current weaver for this polymode."
|
|||
|
|
(interactive)
|
|||
|
|
(unless pm/polymode
|
|||
|
|
(error "No pm/polymode object found. Not in polymode buffer?"))
|
|||
|
|
(let* ((weavers (pm--abrev-names
|
|||
|
|
"pm-weaver/\\|-weaver$"
|
|||
|
|
(delete-dups (pm--oref-with-parents pm/polymode :weavers))))
|
|||
|
|
(sel (pm--completing-read "Choose weaver: " weavers nil t nil 'pm--weaver-hist))
|
|||
|
|
(out (intern (cdr sel))))
|
|||
|
|
(setq pm--weaver-hist (delete-dups pm--weaver-hist))
|
|||
|
|
(setq-local pm--weave:fromto-last nil)
|
|||
|
|
(oset pm/polymode :weaver out)
|
|||
|
|
out))
|
|||
|
|
|
|||
|
|
(provide 'polymode-weave)
|
|||
|
|
;;; polymode-weave.el ends here
|