Initial commit

elpa/polymode-20170307.322/polymode-core.el

@@ -0,0 +1,660 @@
+;;  -*- lexical-binding: t -*-
+;; COMMON INITIALIZATION, UTILITIES and INTERNALS which didn't fit anywhere else
+
+(require 'cl)
+(require 'font-lock)
+(require 'color)
+(require 'eieio)
+(require 'eieio-base)
+(require 'eieio-custom)
+(require 'format-spec)
+
+
+(defgroup polymode nil
+  "Object oriented framework for multiple modes based on indirect buffers"
+  :link '(emacs-commentary-link "polymode")
+  :group 'tools)
+
+(defgroup polymodes nil
+  "Polymode Configuration Objects"
+  :group 'polymode)
+
+(defgroup hostmodes nil
+  "Polymode Host Chunkmode Objects"
+  :group 'polymode)
+
+(defgroup innermodes nil
+  "Polymode Chunkmode Objects"
+  :group 'polymode)
+
+(defcustom polymode-display-process-buffers t
+  "When non-nil, display weaving and exporting process buffers."
+  :group 'polymode
+  :type 'boolean)
+
+(defcustom polymode-skip-processing-when-unmodified t
+  "If non-nil, consider modification times of input and output files.
+Skip weaving or exporting process when output file is more recent
+than the input file."
+  :group 'polymode
+  :type 'boolean)
+
+(defcustom polymode-mode-name-override-alist '((elisp . emacs-lisp))
+"An alist of inner mode overrides.
+When inner mode is automatically detected from the header of the
+inner chunk (such as in markdown mode), the detected symbol might
+not correspond to the desired mode. This alist maps discovered
+symbols into desired modes.
+
+For example
+
+  (add-to-list 'polymode-mode-name-override-alist '(julia . ess-julia))
+
+will cause installation of `ess-julia-mode' in markdown ```julia chunks."
+:group 'polymode
+:type 'alist)
+
+(defvar polymode-switch-buffer-hook nil
+  "Hook run on switching to a different buffer.
+Each function is run with two arguments `old-buffer' and
+`new-buffer'. This hook is commonly used to transfer state
+between buffers. The hook is run in a new buffer, but you should
+not rely on that. Slot :switch-buffer-functions in `pm-polymode'
+and `pm-chunkmode' objects provides same functionality for
+narrower scope.")
+
+(defvar polymode-init-host-hook nil
+  "Hook run on initialization of every hostmode.
+Ran in a base buffer from `pm-initialze'
+methods. Slot :init-functions in `pm-polymode' objects provides
+similar hook for more focused scope. See
+`polymode-init-inner-hook' and :init-functions slot in
+`pm-chunkmode' objects for similar hooks for inner chunkmodes.")
+
+(defvar polymode-init-inner-hook nil
+  "Hook run on initialization of every `pm-chunkmode' object.
+The hook is run in chunkmode's body buffer from `pm-initialze'
+`pm-chunkmode' methods. Slot :init-functions `pm-chunkmode'
+objects provides same functionality for narrower scope. See also
+`polymode-init-host-hook'.")
+
+;; esential vars
+(defvar-local pm/polymode nil)
+(defvar-local pm/chunkmode nil)
+(defvar-local pm/type nil)
+(defvar-local pm--indent-line-function-original nil)
+;; (defvar-local pm--killed-once nil)
+(defvar-local polymode-mode nil
+  "This variable is t if current \"mode\" is a polymode.")
+
+;; silence the compiler for now
+(defvar pm--output-file nil)
+(defvar pm--input-buffer nil)
+(defvar pm--input-file nil)
+(defvar pm--export-spec nil)
+(defvar pm--input-not-real nil)
+(defvar pm--output-not-real nil)
+(defvar pm/type)
+(defvar pm/polymode)
+(defvar pm/chunkmode)
+(defvar *span*)
+
+(defvar pm-allow-fontification t)
+(defvar pm-allow-after-change-hook t)
+(defvar pm-allow-post-command-hook t)
+
+(defvar pm-initialization-in-progress nil
+  ;; We need this during cascading call-next-method in pm-initialize.
+  ;; -innermodes are initialized after the hostmode setup has taken place. This
+  ;; means that pm-get-span and all the functionality that relies on it will
+  ;; fail to work correctly during the initialization in the call-next-method.
+  ;; This is particularly relevant to font-lock setup and user hooks.
+  "Non nil during polymode objects initialization.
+If this variable is non-nil, various chunk manipulation commands
+relying on `pm-get-span' might not function correctly.")
+
+;; methods api from polymode-methods.el
+(declare-function pm-initialize "polymode-methods")
+(declare-function pm-get-buffer-create "polymode-methods")
+(declare-function pm-select-buffer "polymode-methods")
+(declare-function pm-get-adjust-face "polymode-methods")
+(declare-function pm-get-span "polymode-methods")
+(declare-function pm-indent-line "polymode-methods")
+
+
+;;; CORE
+(defsubst pm-base-buffer ()
+  ;; fixme: redundant with :base-buffer
+  "Return base buffer of current buffer, or the current buffer if it's direct."
+  (or (buffer-base-buffer (current-buffer))
+      (current-buffer)))
+
+(defun pm-get-cached-span (&optional pos)
+  "Get cached span at POS"
+  (let ((span (get-text-property (or pos (point)) :pm-span)))
+    (when span
+      (save-restriction
+        (widen)
+        (let* ((beg (nth 1 span))
+               (end (max beg (1- (nth 2 span)))))
+          (when (<= end (point-max))
+            (and (eq span (get-text-property beg :pm-span))
+                 (eq span (get-text-property end :pm-span))
+                 span)))))))
+
+(defun pm-get-innermost-span (&optional pos no-cache)
+  "Get span object at POS.
+If NO-CACHE is non-nil, don't use cache and force re-computation
+of the span."
+  (save-excursion
+    (save-restriction
+      (widen)
+      (let* ((span (or (and (not no-cache)
+                            (pm-get-cached-span pos))
+                       (pm-get-span pm/polymode pos)))
+             (beg (nth 1 span))
+             (end (nth 2 span)))
+        ;; might be used by external applications like flyspell
+        (with-silent-modifications
+          (add-text-properties beg end
+                               (list :pm-span span
+                                     :pm-span-type (car span)
+                                     :pm-span-beg beg
+                                     :pm-span-end end)))
+        span))))
+
+(defun pm-span-to-range (span)
+  (and span (cons (nth 1 span) (nth 2 span))))
+
+(defun pm-get-innermost-range (&optional pos no-cache)
+  (pm-span-to-range (pm-get-innermost-span pos no-cache)))
+
+(defvar pm--select-buffer-visibly nil)
+
+(defun pm-switch-to-buffer (&optional pos-or-span)
+  "Bring the appropriate polymode buffer to front.
+This is done visually for the user with `switch-to-buffer'. All
+necessary adjustment like overlay and undo history transport are
+performed."
+  (let ((span (if (or (null pos-or-span)
+                      (number-or-marker-p pos-or-span))
+                  (pm-get-innermost-span pos-or-span)
+                pos-or-span))
+        (pm--select-buffer-visibly t))
+    (pm-select-buffer (car (last span)) span)))
+
+(defun pm-set-buffer (&optional pos-or-span)
+  "Set buffer to polymode buffer appropriate for POS-OR-SPAN.
+This is done with `set-buffer' and no visual adjustments are
+done."
+  (let ((span (if (or (null pos-or-span)
+                      (number-or-marker-p pos-or-span))
+                  (pm-get-innermost-span pos-or-span)
+                pos-or-span))
+        (pm--select-buffer-visibly nil))
+    (pm-select-buffer (car (last span)) span)))
+
+(defun pm-map-over-spans (fun beg end &optional count backwardp visiblyp no-cache)
+  "For all spans between BEG and END, execute FUN.
+FUN is a function of no args. It is executed with point at the
+beginning of the span. Buffer is *not* narrowed to the span. If
+COUNT is non-nil, jump at most that many times. If BACKWARDP is
+non-nil, map backwards. During the call of FUN, a dynamically
+bound variable *span* holds the current innermost span."
+  ;; Important! Never forget to save-excursion when calling
+  ;; map-overs-spans. Mapping can end different buffer and invalidate whatever
+  ;; caller that used your function.
+  (save-restriction
+    (widen)
+    (setq end (min end (point-max)))
+    (goto-char (if backwardp end beg))
+    (let* ((nr 1)
+           (*span* (pm-get-innermost-span (point) no-cache))
+           old-span
+           moved)
+      ;; if beg (end) coincide with span's end (beg) don't process previous (next) span
+      (if backwardp
+          (and (eq end (nth 1 *span*))
+               (setq moved t)
+               (not (bobp))
+               (forward-char -1))
+        (and (eq beg (nth 2 *span*))
+             (setq moved t)
+             (not (eobp))
+             (forward-char 1)))
+      (when moved
+        (setq *span* (pm-get-innermost-span (point) no-cache)))
+      (while (and (if backwardp
+                      (> (point) beg)
+                    (< (point) end))
+                  (or (null count)
+                      (< nr count)))
+        (let ((pm--select-buffer-visibly visiblyp))
+          (pm-select-buffer (car (last *span*)) *span*)) ;; object and span
+
+        ;; FUN might change buffer and invalidate our *span*. How can we
+        ;; intelligently check for this? After-change functions have not been
+        ;; run yet (or did they?). We can track buffer modification time
+        ;; explicitly (can we?)
+        (goto-char (nth 1 *span*))
+        (save-excursion
+          (funcall fun))
+
+        ;; enter next/previous chunk as head-tails don't include their boundaries
+        (if backwardp
+            (goto-char (max 1 (1- (nth 1 *span*))))
+          (goto-char (min (point-max) (1+ (nth 2 *span*)))))
+
+        (setq old-span *span*)
+        (setq *span* (pm-get-innermost-span (point) no-cache)
+              nr (1+ nr))
+
+        ;; Ensure progress and avoid infloop due to bad regexp or who knows
+        ;; what. Move char by char till we get higher/lower span. Cache is not
+        ;; used.
+        (while (and (not (eobp))
+                    (if backwardp
+                        (> (nth 2 *span*) (nth 1 old-span))
+                      (< (nth 1 *span*) (nth 2 old-span))))
+          (forward-char 1)
+          (setq *span* (pm-get-innermost-span (point) t)))))))
+
+(defun pm--reset-ppss-last (&optional span-start force)
+  "Reset `syntax-ppss-last' cache if it was recorded before SPAN-START.
+If SPAN-START is nil, use span at point. If force, reset
+regardless of the position `syntax-ppss-last' was recorder at."
+  ;; syntax-ppss has its own condition-case for this case, but that means
+  ;; throwing an error each time it calls parse-partial-sexp
+  (setq span-start (or span-start (car (pm-get-innermost-range))))
+  (when (or force
+            (and syntax-ppss-last
+                 (car syntax-ppss-last)
+                 ;; non-strict is intentional (occasionally ppss is screwed)
+                 (<= (car syntax-ppss-last) span-start)))
+    (setq syntax-ppss-last
+          (cons span-start (list 0 nil span-start nil nil nil 0)))))
+
+(defun pm-narrow-to-span (&optional span)
+  "Narrow to current chunk."
+  (interactive)
+  (unless (= (point-min) (point-max))
+    (let ((span (or span
+                    (pm-get-innermost-span))))
+      (let ((sbeg (nth 1 span))
+            (send (nth 2 span)))
+        (pm--reset-ppss-last sbeg t)
+        (narrow-to-region sbeg send)))))
+
+(defmacro pm-with-narrowed-to-span (span &rest body)
+  (declare (indent 1) (debug body))
+  `(save-restriction
+     (pm-narrow-to-span ,span)
+     ,@body))
+
+
+;;; UTILITIES
+(defvar polymode-display-output-file t
+  "When non-nil automatically display output file in emacs.
+This is temporary variable, it might be changed or removed in the
+near future.")
+
+(defun pm--display-file (ofile)
+  (when ofile
+   ;; errors might occur (most notably with open-with package errors are intentional)
+   ;; We need to catch those if we want to display multiple files like with Rmarkdown
+    (condition-case err
+        (let ((buff (get-file-buffer ofile)))
+          ;; silently kill and re-open
+          (when buff
+            (with-current-buffer buff
+              (revert-buffer t t)))
+          (when polymode-display-output-file
+            (if (string-match-p "html\\|htm$" ofile)
+                (browse-url ofile)
+              (display-buffer (find-file-noselect ofile 'nowarn)))))
+      (error (message "Error while displaying '%s': %s"
+                      (file-name-nondirectory ofile)
+                      (error-message-string err))))))
+
+(defun pm--symbol-name (str-or-symbol)
+  (if (symbolp str-or-symbol)
+      (symbol-name str-or-symbol)
+    str-or-symbol))
+
+(defun pm--get-mode-symbol-from-name (str &optional no-fallback)
+  "Guess and return mode function."
+  (let* ((str (pm--symbol-name
+               (or (cdr (assq (intern (pm--symbol-name str))
+                              polymode-mode-name-override-alist))
+                   str)))
+         (mname (if (string-match-p "-mode$" str)
+                    str
+                  (concat str "-mode"))))
+    (or (pm--get-existent-mode (intern mname) t)
+        (pm--get-existent-mode (intern (downcase mname))) no-fallback)))
+
+(defun pm--get-existent-mode (mode &optional no-fallback)
+  "Check if MODE symbol is defined and is a valid function.
+If so, return it, otherwise return `poly-fallback-mode' and issue
+a warning."
+  (cond ((fboundp mode) mode)
+        (no-fallback nil)
+        (t (message "Cannot find function `%s', using `poly-fallback-mode'" mode)
+           'poly-fallback-mode)))
+
+(defun pm--oref-with-parents (object slot)
+  "Merge slots SLOT from the OBJECT and all its parent instances."
+  (let (VALS)
+    (while object
+      (setq VALS (append (and (slot-boundp object slot) ; don't cascade
+                              (eieio-oref object slot))
+                         VALS)
+            object (and (slot-boundp object :parent-instance)
+                        (oref object :parent-instance))))
+    VALS))
+
+(defun pm--abrev-names (list abrev-regexp)
+  "Abbreviate names in LIST by replacing abrev-regexp with empty string."
+  (mapcar (lambda (nm)
+            (let ((str-nm (if (symbolp nm)
+                              (symbol-name nm)
+                            nm)))
+              (cons (replace-regexp-in-string abrev-regexp "" str-nm)
+                    str-nm)))
+          list))
+
+(defun pm--prop-put (key val &optional object)
+  (oset (or object pm/polymode) -props
+        (plist-put (oref (or object pm/polymode) -props) key val)))
+
+(defun pm--prop-get (key &optional object)
+  (plist-get (oref (or object pm/polymode) -props) key))
+
+(defun pm--comment-region (beg end)
+  ;; mark as syntactic comment
+  (when (> end 1)
+    (with-silent-modifications
+      (let ((beg (or beg (region-beginning)))
+            (end (or end (region-end))))
+        (let ((ch-beg (char-after beg))
+              (ch-end (char-before end)))
+          (add-text-properties beg (1+ beg)
+                               (list 'syntax-table (cons 11 ch-beg)
+                                     'rear-nonsticky t
+                                     'polymode-comment 'start))
+          (add-text-properties (1- end) end
+                               (list 'syntax-table (cons 12 ch-end)
+                                     'rear-nonsticky t
+                                     'polymode-comment 'end)))))))
+
+(defun pm--uncomment-region (beg end)
+  ;; Remove all syntax-table properties.
+  ;; fixme: this beggs for problems
+  (when (> end 1)
+    (with-silent-modifications
+      (let ((props '(syntax-table nil rear-nonsticky nil polymode-comment nil)))
+        (remove-text-properties (max beg (point-min)) (min end (point-max)) props)
+        ;; (remove-text-properties beg (1+ beg) props)
+        ;; (remove-text-properties end (1- end) props)
+        ))))
+
+(defun pm--synchronize-points (&rest ignore)
+  "Synchronize points in all buffers.
+IGNORE is there to allow this function in advises."
+  (when polymode-mode
+    (let ((pos (point))
+          (cbuff (current-buffer)))
+      (dolist (buff (oref pm/polymode -buffers))
+        (when (and (not (eq buff cbuff))
+                   (buffer-live-p buff))
+          (with-current-buffer buff
+            (goto-char pos)))))))
+
+(defun pm--completing-read (prompt collection &optional predicate require-match initial-input hist def inherit-input-method)
+  "Wrapper for `completing-read'.
+Takes care when collection is an alist of (name . meta-info). If
+so, asks for names, but returns meta-info for that name. Enforce
+require-match = t. Also takes care of adding the most relevant
+DEF from history."
+  (if (and (listp collection)
+           (listp (car collection)))
+      (let* ((candidates (mapcar #'car collection))
+             (thist (and hist
+                         (delq nil (mapcar (lambda (x) (car (member x candidates)))
+                                           (symbol-value hist)))))
+             (def (or def (car thist))))
+        (assoc (completing-read prompt candidates predicate t initial-input hist def inherit-input-method)
+               collection))
+    (completing-read prompt candidates predicate require-match initial-input hist def inherit-input-method)))
+
+
+;; Weaving and Exporting common utilities
+
+(defun pm--wrap-callback (processor slot ifile)
+  ;; replace processor :sentinel or :callback temporally in order to export-spec as a
+  ;; followup step or display the result
+  (let ((sentinel1 (eieio-oref processor slot))
+        (cur-dir default-directory)
+        (exporter (symbol-value (oref pm/polymode :exporter)))
+        (obuffer (current-buffer)))
+    (if pm--export-spec
+        (let ((espec pm--export-spec))
+          (lambda (&rest args)
+            (with-current-buffer obuffer
+              (let ((wfile (apply sentinel1 args))
+                    (pm--export-spec nil)
+                    (pm--input-not-real t))
+                ;; If no wfile, probably errors occurred. So we stop.
+                (when wfile
+                  (when (listp wfile)
+                    ;; In an unlikely situation weaver can generate multiple
+                    ;; files. Pick the first one.
+                    (setq wfile (car wfile)))
+                  (pm-export exporter (car espec) (cdr espec) wfile))))))
+      (lambda (&rest args)
+        (with-current-buffer obuffer
+          (let ((ofile (apply sentinel1 args)))
+            (when ofile
+              (let ((ofiles (if (listp ofile) ofile (list ofile))))
+                (dolist (f ofiles)
+                  (pm--display-file (expand-file-name f cur-dir)))))))))))
+
+(defun pm--file-mod-time (file)
+  (and (stringp file)
+       (file-exists-p file)
+       (nth 5 (file-attributes file))))
+
+
+(defvar-local pm--process-buffer nil)
+
+(defun pm--run-shell-command (command sentinel buff-name message)
+  "Run shell command interactively.
+Run command in a buffer (in comint-shell-mode) in order to be
+able to accept user interaction."
+  ;; simplified version of TeX-run-TeX
+  (require 'comint)
+  (let* ((buffer (get-buffer-create buff-name))
+         (process nil)
+         (command-buff (current-buffer))
+         (ofile pm--output-file)
+         ;; weave/export buffers are re-usable; need to transfer some vars
+         (dd default-directory)
+         ;; (command (shell-quote-argument command))
+         )
+    (with-current-buffer buffer
+      (setq-local default-directory dd)
+      (read-only-mode -1)
+      (erase-buffer)
+      (insert message)
+      (comint-exec buffer buff-name shell-file-name nil
+                   (list shell-command-switch command))
+      (setq process (get-buffer-process buffer))
+      (comint-mode)
+      (set-process-sentinel process sentinel)
+      (setq pm--process-buffer t)
+      (set-marker (process-mark process) (point-max))
+      ;; for communication with sentinel
+      (process-put process :output-file pm--output-file)
+      (process-put process :output-file-mod-time (pm--file-mod-time pm--output-file))
+      (process-put process :input-file pm--input-file)
+      (when polymode-display-process-buffers
+        (display-buffer buffer `(nil . ((inhibit-same-window . ,pop-up-windows)))))
+      nil)))
+
+(defun pm--make-shell-command-sentinel (action)
+  (lambda (process name)
+    "Sentinel built with `pm--make-shell-command-sentinel'."
+    (let ((buff (process-buffer process))
+          (status (process-exit-status process)))
+      (if (> status 0)
+          (progn
+            (message "Errors during %s; process exit status %d" action status)
+            (ding) (sit-for 1)
+            nil)
+        (with-current-buffer buff
+          (let ((ofile (process-get process :output-file)))
+            (cond
+             ;; 1. output-file guesser
+             ((functionp ofile) (funcall ofile))
+             ;; 2. string
+             (ofile
+              (let ((otime (process-get process :output-file-mod-time))
+                    (ntime (pm--file-mod-time ofile)))
+                (if (or (null ntime)
+                        (and otime
+                             (not (time-less-p otime ntime))))
+                    ;; mod time didn't change
+                    ;; tothink: shall we still return ofile for display?
+                    (progn
+                      (display-buffer (current-buffer))
+                      (message "Output file unchanged. Either input unchanged or errors during %s." action)
+                      (ding) (sit-for 1)
+                      ofile)
+                  ;; else, all is good, we return the file name
+                  ;; (display-buffer (current-buffer))
+                  (message "Done with %s" action)
+                  ofile)))
+             ;; 3. output file is not known; display process buffer
+             (t (display-buffer (current-buffer)) nil))))))))
+
+(fset 'pm-default-export-sentinel (pm--make-shell-command-sentinel "export"))
+(fset 'pm-default-shell-weave-sentinel (pm--make-shell-command-sentinel "weaving"))
+
+(defun pm--make-selector (specs elements)
+  (cond ((listp elements)
+         (let ((spec-alist (cl-mapcar #'cons specs elements)))
+           (lambda (selsym &rest ignore)
+             (cdr (assoc selsym spec-alist)))))
+        ((functionp elements) elements)
+        (t (error "elements argument must be either a list or a function"))))
+
+(defun pm--selector (processor type id)
+  (let ((spec (or (assoc id (eieio-oref processor type))
+                  (error "%s spec '%s' cannot be found in '%s'"
+                         (symbol-name type) id (eieio-object-name processor))))
+        (names (cond
+                ;; exporter slots
+                ((eq type :from) '(regexp doc command))
+                ((eq type :to) '(ext doc t-spec))
+                ;; weaver slot
+                ((eq type :from-to) '(regexp ext doc command))
+                (t (error "invalid type '%s'" type)))))
+    (pm--make-selector names (cdr spec))))
+
+(defun pm--selector-match (selector &optional file)
+  (or (funcall selector 'match file)
+      (string-match-p (funcall selector 'regexp)
+                      (or file buffer-file-name))))
+
+(defun pm--selectors (processor type)
+  (let ((ids (mapcar #'car (eieio-oref processor type))))
+    (mapcar (lambda (id) (cons id (pm--selector processor type id))) ids)))
+
+(defun pm--output-command.file (output-file-format sfrom &optional sto quote)
+  ;; !!Must be run in input buffer!!
+  (cl-flet ((squote (arg) (or (and (stringp arg)
+                                   (if quote (shell-quote-argument arg) arg))
+                              "")))
+    (let* ((base-ofile (or (funcall (or sto sfrom) 'output-file)
+                           (let ((ext (funcall (or sto sfrom) 'ext)))
+                             (when ext
+                               (concat (format output-file-format
+                                               (file-name-base buffer-file-name))
+                                       "." ext)))))
+           (ofile (and (stringp base-ofile)
+                       (expand-file-name base-ofile)))
+           (oname (and (stringp base-ofile)
+                       (file-name-base base-ofile)))
+           (t-spec (and sto (funcall sto 't-spec)))
+           (command-w-formats (or (and sto (funcall sto 'command))
+                                  (and (listp t-spec) (car t-spec))
+                                  (funcall sfrom 'command)))
+           (command (format-spec command-w-formats
+                                 (list (cons ?i (squote (file-name-nondirectory buffer-file-name)))
+                                       (cons ?I (squote buffer-file-name))
+                                       (cons ?o (squote base-ofile))
+                                       (cons ?O (squote ofile))
+                                       (cons ?b (squote oname))
+                                       (cons ?t (squote t-spec))))))
+      (cons command (or ofile base-ofile)))))
+
+(defun pm--process-internal (processor from to ifile &optional callback quote)
+  (let ((is-exporter (object-of-class-p processor 'pm-exporter)))
+    (if is-exporter
+        (unless (and from to)
+          (error "For exporter both FROM and TO must be supplied (from: %s, to: %s)" from to))
+      (unless from
+        ;; it represents :from-to slot
+        (error "For weaver FROM must be supplied (from: %s)" from)))
+    (let* ((sfrom (if is-exporter
+                      (pm--selector processor :from from)
+                    (pm--selector processor :from-to from)))
+           (sto (and is-exporter (pm--selector processor :to to)))
+           (ifile (or ifile buffer-file-name))
+           ;; fixme: nowarn is only right for inputs from weavers, you need to
+           ;; save otherwise
+           (ibuffer (if pm--input-not-real
+                        ;; for exporter input we silently re-fetch the file
+                        ;; even if it was modified
+                        (find-file-noselect ifile t)
+                      ;; if real user file, get it or fetch it
+                      (or (get-file-buffer ifile)
+                          (find-file-noselect ifile))))
+           (output-format (if is-exporter
+                              polymode-exporter-output-file-format
+                            polymode-weave-output-file-format)))
+      (with-current-buffer ibuffer
+        (save-buffer)
+        (let ((comm.ofile (pm--output-command.file output-format sfrom sto quote)))
+          (message "%s '%s' with '%s' ..." (if is-exporter "Exporting" "Weaving")
+                   (file-name-nondirectory ifile) (eieio-object-name processor))
+          (let* ((pm--output-file (cdr comm.ofile))
+                 (pm--input-file ifile)
+                 ;; skip weaving step if possible
+                 ;; :fixme this should not happen after weaver/exporter change
+                 ;; or after errors in previous exporter
+                 (omt (and polymode-skip-processing-when-unmodified
+                           (stringp pm--output-file)
+                           (pm--file-mod-time pm--output-file)))
+                 (imt (and omt (pm--file-mod-time pm--input-file)))
+                 (ofile (or (and imt (time-less-p imt omt) pm--output-file)
+                            (let ((fun (oref processor :function))
+                                  (args (delq nil (list callback from to))))
+                              (apply fun (car comm.ofile) args)))))
+            ;; ofile is non-nil in two cases:
+            ;;  -- synchronous back-ends (very uncommon)
+            ;;  -- when output is transitional (not real) and mod time of input < output
+            (when ofile
+              (if pm--export-spec
+                  ;; same logic as in pm--wrap-callback
+                  (let ((pm--input-not-real t)
+                        (espec pm--export-spec)
+                        (pm--export-spec nil))
+                    (when (listp ofile)
+                      (setq ofile (car ofile)))
+                    (pm-export (symbol-value (oref pm/polymode :exporter))
+                               (car espec) (cdr espec)
+                               ofile))
+                (pm--display-file ofile)))))))))
+
+(provide 'polymode-core)