daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-06-22 17:08:08 +02:00
parent 54e5633369
commit 16a0a6db93
558 changed files with 68349 additions and 26568 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
lisp/polymode/polymode-base.el
View File

@@ -51,7 +51,9 @@
(define-hostmode poly-js-hostmode :mode 'js-mode)
(define-obsolete-variable-alias 'pm-host/latex 'poly-latex-hostmode "v0.2")
(define-hostmode poly-latex-hostmode :mode 'latex-mode)
(define-hostmode poly-latex-hostmode
:mode 'LaTeX-mode
:fallback-mode 'latex-mode)
(define-obsolete-variable-alias 'pm-host/html 'poly-html-hostmode "v0.2")
(define-hostmode poly-html-hostmode
@@ -88,27 +90,27 @@
;;; ROOT POLYMODES
;; These are simple generic configuration objects. More specialized polymodes
;; should clone these.
;; should extend (aka clone) these.
(define-obsolete-variable-alias 'pm-poly/brew 'poly-brew-root-polymode "v0.2")
(defvar poly-brew-root-polymode
(pm-polymode :name "brew-root" :hostmode 'poly-text-hostmode)
"Brew root configuration.")
"Brew root polymode.")
(define-obsolete-variable-alias 'pm-poly/html 'poly-html-root-polymode "v0.2")
(defvar poly-html-root-polymode
(pm-polymode :name "html-root" :hostmode 'poly-html-hostmode)
"HTML root configuration.")
"HTML root polymode.")
(define-obsolete-variable-alias 'pm-poly/C++ 'poly-c++-root-polymode "v0.2")
(defvar poly-c++-root-polymode
(pm-polymode :name "c++-root" :hostmode 'poly-c++-hostmode)
"C++ root configuration.")
"C++ root polymode.")
(define-obsolete-variable-alias 'pm-poly/latex 'poly-latex-root-polymode "v0.2")
(defvar poly-latex-root-polymode
(pm-polymode :name "latex-root" :hostmode 'poly-latex-hostmode)
"LaTeX root configuration.")
"LaTeX root polymode.")
(defvar poly-js-root-polymode
(pm-polymode :name "js-root" :hostmode 'poly-js-hostmode)

19
lisp/polymode/polymode-classes.el
View File

@@ -218,9 +218,9 @@ instantiated from this class or a subclass of this class.")
:documentation
"Emacs major mode for the chunk's body.
If :mode slot is nil (anonymous chunkmodes), use the value of
`polymode-default-inner-mode' is when set, or use the value of
`polymode-default-inner-mode' when set, or use the value of
the slot :fallback-mode. A special value 'host means to use the
host mode (useful auto-chunkmodes only).")
host mode (useful for `pm-inner-auto-chunkmode' only).")
(fallback-mode
:initarg :fallback-mode
:initform 'poly-fallback-mode
@@ -335,11 +335,12 @@ is of this chunkmode.")
:type symbol
:custom symbol
:documentation
"Major mode to keep in when polymode switches implementation buffers.
When a special symbol 'host, keep in hostmode. The buffer with
this major mode must be installed by one of the innermodes or the
hostmode. If multiple innermodes installed buffers of this mode,
the first buffer is used.")
"Major mode to keep the chunk when the point is inside the chunk.
When a special symbol 'host, keep in hostmode. This is useful when you
want the inner mode to be responsible for font-locking but the host mode
for the edditing capabilities. The buffer with this major mode must be
installed by one of the innermodes or the hostmode. If multiple
innermodes installed buffers of this mode, the first buffer is used.")
(-buffer
:type (or null buffer)
@@ -418,8 +419,8 @@ take either values 1 (forwards search) or -1 (backward search)
and behave similarly to how search is performed by
`re-search-forward' function. This function must return either
nil (no match) or a (cons BEG END) representing the head span.
See the code of `pm-fun-matcher' for how REGEXP and (REGEXP .
SUB-MATCH) are converted to a function internally..")
See `pm-fun-matcher' for how polymode internally converts a REGEXP or
(REGEXP . SUB-MATCH) into such a function.")
(tail-matcher
:initarg :tail-matcher
:type (or string cons function)

113
lisp/polymode/polymode-compat.el
View File

@@ -3,7 +3,6 @@
;; Author: Vitalie Spinu
;; Maintainer: Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Version: 0.1
;; URL: https://github.com/polymode/polymode
;; Keywords: emacs
;;
@@ -72,8 +71,6 @@ Elements of ALIST that are not conses are ignored."
;;; Various Wrappers for Around Advice
(defvar *span* nil)
;; advice doesn't provide named symbols. So we need to define specialized
;; wrappers for some key functions (unfinished)
(defmacro pm-define-wrapp-protected (fun)
@@ -215,8 +212,7 @@ are passed to ORIG-FUN."
;; REPLACE:
;; before-change:(obeg,oend)=(50,56)
;; lsp-on-change:(nbeg,nend,olen)=(50,60,6)
(defun pm--lsp-text-document-content-change-event (beg end len)
(defun pm--lsp-buffer-content-document-content-change-event (beg end len)
"Make a TextDocumentContentChangeEvent body for BEG to END, of length LEN."
(if (zerop len)
;; insertion
@@ -228,7 +224,6 @@ are passed to ORIG-FUN."
(pm--lsp-change-event beg end-pos text))
(pm--lsp-full-change-event))))
(defvar-local pm--lsp-before-change-end-position nil)
(defun pm--lsp-position (pos)
(save-restriction
(widen)
@@ -248,42 +243,46 @@ are passed to ORIG-FUN."
:text text))
(defun pm--lsp-full-change-event ()
(list :text (pm--lsp-text)))
(list :text (pm--lsp-buffer-content)))
(defun pm--lsp-text (&optional beg end)
(save-restriction
(widen)
(setq beg (or beg (point-min)))
(setq end (or end (point-max)))
(let ((cmode major-mode)
(end-eol (save-excursion (goto-char end)
(point-at-eol)))
line-acc acc)
(pm-map-over-modes
(lambda (sbeg send)
(let ((beg1 (max sbeg beg))
(end1 (min send end))
(rem))
(if (eq cmode major-mode)
(progn
(when (eq sbeg beg1)
;; first line of mode; use line-acc
(setq acc (append line-acc acc))
(setq line-acc nil))
;; if cur-mode follows after end on same line, accumulate the
;; last line but not the actual text
(when (< beg1 end)
(push (buffer-substring-no-properties beg1 end1) acc)))
(goto-char beg1)
(if (<= end1 (point-at-eol))
(when (< beg1 end1) ; don't accumulate on last line
(push (make-string (- end1 beg1) ? ) line-acc))
(while (< (point-at-eol) end1)
(push "\n" acc)
(forward-line 1))
(setq line-acc (list (make-string (- end1 (point)) ? )))))))
beg end-eol)
(apply #'concat (reverse acc)))))
(defun pm--lsp-buffer-content (&optional beg end)
"Get text between BEG and END cleaned from non-current mode content.
The text from non-current mode is replaced with whitespaces, thus
preserving locations arriving from LSP intact."
(pm-with-synchronized-points
(save-excursion
(save-restriction
(widen)
(setq beg (or beg (point-min)))
(setq end (or end (point-max)))
(let ((cmode major-mode)
(end-eol (save-excursion (goto-char end)
(line-end-position)))
line-acc acc)
(pm-map-over-modes
(lambda (sbeg send)
(let ((beg1 (max sbeg beg))
(end1 (min send end)))
(if (eq cmode major-mode)
(progn
(when (eq sbeg beg1)
;; first line of mode; use line-acc
(setq acc (append line-acc acc))
(setq line-acc nil))
;; if cur-mode follows after end on same line,
;; accumulate the last line but not the actual text
(when (< beg1 end)
(push (buffer-substring-no-properties beg1 end1) acc)))
(goto-char beg1)
(if (<= end1 (line-end-position))
(when (< beg1 end1) ; don't accumulate on last line
(push (make-string (- end1 beg1) ? ) line-acc))
(while (< (line-end-position) end1)
(push "\n" acc)
(forward-line 1))
(setq line-acc (list (make-string (- end1 (point)) ? )))))))
beg end-eol)
(apply #'concat (reverse acc)))))))
;; We cannot compute original change location when modifications are complex
;; (aka multiple changes are combined). In those cases we send an entire
@@ -294,18 +293,20 @@ are passed to ORIG-FUN."
(and (eq beg (car bcr))
(eq len (- (cdr bcr) (car bcr))))))
;; advises
(defun polymode-lsp-buffer-content (orig-fun)
"In polymode buffers, replace other modes' content with whitespaces.
Use as around advice for lsp--buffer-content."
(if (and polymode-mode pm/polymode)
(pm--lsp-text)
(pm--lsp-buffer-content)
(funcall orig-fun)))
(defun polymode-lsp-change-event (orig-fun beg end len)
(if (and polymode-mode pm/polymode)
(pm--lsp-text-document-content-change-event beg end len)
(pm--lsp-buffer-content-document-content-change-event beg end len)
(funcall orig-fun beg end len)))
(defvar-local polymode-lsp-integration t)
(defvar-local polymode-lsp-integration t
"Non-nil if lsp polymode integration should be enabled for this buffer.")
(with-eval-after-load "lsp-mode"
(when polymode-lsp-integration
@@ -319,9 +320,6 @@ are passed to ORIG-FUN."
(pm-around-advice 'lsp--buffer-content #'polymode-lsp-buffer-content)
(pm-around-advice 'lsp--text-document-content-change-event #'polymode-lsp-change-event)))
;; (advice-remove 'lsp--buffer-content #'polymode-lsp-buffer-content)
;; (advice-remove 'lsp--text-document-content-change-event #'polymode-lsp-change-event)
;;; Flyspel
(defun pm--flyspel-dont-highlight-in-chunkmodes (beg end _poss)
@@ -428,32 +426,29 @@ changes."
;;; DESKTOP SAVE #194 #240
;; NB: desktop-save will not save indirect buffer.
;; For base buffer, if it's hidden as per #34, we will save it unhide by removing left whitespaces.
;; NB: We advice desktop-save functionality to not save indirect buffers and for base buffers,
;; save the buffers with un-hidden name.
(defun polymode-fix-desktop-buffer-info (fn buffer)
"Unhide poly-mode base buffer which is hidden as per #34.
This is done by modifying `uniquify-buffer-base-name' to `pm--core-buffer-name'."
"Unhide poly-mode base buffer which is hidden by removing
the leading spaces from the name."
(with-current-buffer buffer
(let ((out (funcall fn buffer)))
(when (and polymode-mode
(not (buffer-base-buffer))
(not (car out)))
(setf (car out) pm--core-buffer-name))
(setf (car out) (replace-regexp-in-string "^ +" "" (buffer-name buffer))))
out)))
(declare-function desktop-buffer-info "desktop")
(with-eval-after-load "desktop"
(advice-add #'desktop-buffer-info :around #'polymode-fix-desktop-buffer-info))
(defun polymode-fix-desktop-save-buffer-p (_ bufname &rest _args)
"Dont save polymode buffers which are indirect buffers."
(with-current-buffer bufname
(not (and polymode-mode
(buffer-base-buffer)))))
(not (and polymode-mode (buffer-base-buffer)))))
(declare-function desktop-buffer-info "desktop")
(declare-function desktop-save-buffer-p "desktop")
(with-eval-after-load "desktop"
(advice-add #'desktop-buffer-info :around #'polymode-fix-desktop-buffer-info)
(advice-add #'desktop-save-buffer-p :before-while #'polymode-fix-desktop-save-buffer-p))

302
lisp/polymode/polymode-core.el
View File

@@ -37,8 +37,11 @@
(require 'cl-lib)
(require 'derived))
;;; ESSENTIAL DECLARATIONS
;; fixme: rename into pm-active-span or something similar
(defvar *span* nil)
(defvar-local pm/polymode nil)
(put 'pm/polymode 'permanent-local t)
@@ -82,6 +85,23 @@
(with-no-warnings
(eieio-object-name-string obj)))
;; CORE EMACS COMPATS
;;; emacs 30
(unless (fboundp 'major-mode-remap)
(defvar major-mode-remap-alist nil)
(defvar major-mode-remap-defaults nil)
(defalias 'major-mode-remap
(lambda (mode)
"Return the function to use to enable MODE."
(or (cdr (or (assq mode major-mode-remap-alist)
(assq mode major-mode-remap-defaults)))
mode))))
;; SHIELDS
(defvar pm-allow-after-change-hook t)
@@ -104,14 +124,22 @@
(defvar pm-initialization-in-progress nil)
(defvar pm-hide-implementation-buffers t)
(defvar-local pm--core-buffer-name nil)
(defvar-local pm--base-buffer-name nil
"Local name of the base buffer in the base buffer.
Currently, we only use it to track renames of the buffer.")
(defun pm--hidden-buffer-name ()
(generate-new-buffer-name (concat " " pm--core-buffer-name)))
(defun pm--visible-buffer-name ()
(generate-new-buffer-name
(replace-regexp-in-string "^ +" "" pm--core-buffer-name)))
(defun pm--buffer-name (&optional hidden)
(let ((name (if-let* ((bbuf (buffer-base-buffer)))
(let ((postfix (replace-regexp-in-string "poly-\\|-mode" "" (symbol-name major-mode)))
(base-name (buffer-local-value 'pm--base-buffer-name bbuf)))
(format "%s[%s]" (replace-regexp-in-string "^ " "" base-name)
(or (cdr (assoc postfix polymode-mode-abbrev-aliases))
postfix)))
pm--base-buffer-name)))
(when hidden
(setq name (concat " " name)))
(generate-new-buffer-name name)))
@@ -186,9 +214,9 @@ 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-aliases '(julia . ess-julia))
(add-to-list \\='polymode-mode-name-aliases \\='(julia . ess-julia))
will cause installation of `ess-julia-mode' in markdown ```julia chunks."
will cause installation of `ess-julia-mode' in markdown julia chunks."
:group 'polymode
:type 'alist)
@@ -229,6 +257,7 @@ The hook is run in chunkmode's body buffer from `pm-initialze'
objects provides same functionality for narrower scope. See also
`polymode-init-host-hook'.")
;;; Mode Macros
@@ -641,12 +670,12 @@ forward."
(block-col (if (< cur-indent cur-col)
cur-indent
(1- cur-indent)))
(end (point-at-eol)))
(end (line-end-position)))
(forward-line 1)
(while (and (not (eobp))
(or (looking-at-p "[ \t]*$")
(and (> (current-indentation) block-col)
(setq end (point-at-eol)))))
(setq end (line-end-position)))))
(forward-line 1))
;; end at bol for the sake of indentation
(setq end (min (point-max) (1+ end)))
@@ -866,7 +895,7 @@ forward spans from pos."
(cons (point-max) (point-max)))))
(when can-overlap
(goto-char (cdr head))
(when-let ((hbeg (car (funcall head-matcher 1))))
(when-let* ((hbeg (car (funcall head-matcher 1))))
(when (< hbeg (car tail))
(setq tail (cons hbeg hbeg)))))
(list (car head) (cdr head) (car tail) (cdr tail))))))))
@@ -918,7 +947,7 @@ TYPE is either a symbol or a list of symbols of span types."
(unless pm-initialization-in-progress
(when global-hook
(run-hooks global-hook))
(pm--run-hooks object :init-functions (or type 'host))))
(pm--run-hooks object 'init-functions (or type 'host))))
(defun pm--collect-parent-slots (object slot &optional do-when inclusive)
"Descend into parents of OBJECT and return a list of SLOT values.
@@ -932,7 +961,7 @@ of the first object for which DO-WHEN failed."
(failed nil))
(while inst
(if (not (slot-boundp inst slot))
(setq inst (and (slot-boundp inst :parent-instance)
(setq inst (and (slot-boundp inst 'parent-instance)
(eieio-oref inst 'parent-instance)))
(push (eieio-oref inst slot) vals)
(setq inst (and
@@ -942,7 +971,7 @@ of the first object for which DO-WHEN failed."
(or (funcall do-when inst)
(and inclusive
(setq failed t)))))
(slot-boundp inst :parent-instance)
(slot-boundp inst 'parent-instance)
(eieio-oref inst 'parent-instance)))))
vals))
@@ -1048,7 +1077,7 @@ switch."
((eq mode 'host) (pm-base-buffer))
(mode (or (pm-get-buffer-of-mode mode)
;; not throwing because in auto-modes mode might not
;; be installed yet and there is no way install it
;; be installed yet and there is no way to install it
;; from here
buffer))))))
;; no further action if BUFFER is already the current buffer
@@ -1056,10 +1085,12 @@ switch."
(when (and own visibly)
(run-hook-with-args 'polymode-before-switch-buffer-hook
cbuf buffer))
(pm--move-vars polymode-move-these-vars-from-base-buffer
(pm-base-buffer) buffer)
(pm--move-vars polymode-move-these-vars-from-old-buffer
cbuf buffer)
(pm--move-vars polymode-move-these-vars-from-base-buffer (pm-base-buffer) buffer)
(pm--move-vars polymode-move-these-vars-from-old-buffer cbuf buffer)
;; synchronize again just in case
(pm--synchronize-points cbuf)
(if visibly
;; Slow, visual selection. Don't perform in foreign indirect buffers.
(when own
@@ -1078,7 +1109,7 @@ switch."
(hlf header-line-format))
(when pm-hide-implementation-buffers
(rename-buffer (pm--hidden-buffer-name)))
(rename-buffer (pm--buffer-name 'hidden)))
(setq pm/current nil)
@@ -1089,8 +1120,16 @@ switch."
(pm--move-overlays old-buffer new-buffer)
(switch-to-buffer new-buffer)
(let ((dedicated-flag (window-dedicated-p)))
(when dedicated-flag
(set-window-dedicated-p nil nil))
(set-buffer new-buffer)
(set-window-buffer nil new-buffer 'keep-margins)
(when dedicated-flag
(set-window-dedicated-p nil dedicated-flag)))
(bury-buffer-internal old-buffer)
;; remove old-buffer form window-prev-buffers
(set-window-prev-buffers nil (assq-delete-all old-buffer (window-prev-buffers nil)))
;; if header line is active in some modes, make it active everywhere
@@ -1100,14 +1139,13 @@ switch."
(setq pm/current t)
;; fixme: what is the right way to do this ... activate-mark-hook?
(set-mark mkt)
(if (not ractive)
(deactivate-mark)
(set-mark mkt)
(activate-mark))
(when pm-hide-implementation-buffers
(rename-buffer (pm--visible-buffer-name)))
(rename-buffer (pm--buffer-name)))
;; avoid display jumps
(goto-char point)
@@ -1115,16 +1153,62 @@ switch."
(set-window-start (get-buffer-window new-buffer t) window-start))
(run-hook-with-args 'polymode-after-switch-buffer-hook old-buffer new-buffer)
(pm--run-hooks pm/polymode :switch-buffer-functions old-buffer new-buffer)
(pm--run-hooks pm/chunkmode :switch-buffer-functions old-buffer new-buffer)))
(pm--run-hooks pm/polymode 'switch-buffer-functions old-buffer new-buffer)
(pm--run-hooks pm/chunkmode 'switch-buffer-functions old-buffer new-buffer)))
(defvar polymode-copy-overlays-with-these-properties-from-old-buffer '(invisible)
"Overlays with these non-nil properties should be copied instead of moved.
The overlay is matched if `pm--overlay-match-p' returns non-nil with
any of the properties in the list.")
(defvar polymode-ignore-overlays-with-these-properties
'(linum-str yas--snippet (face region show-paren-match hl-line))
"Overlays with these properties should be left untouched when switching polymode buffers.
The overlay is matched if `pm--overlay-match-p' returns non-nil with any
of the properties in the list.")
(defun pm--overlay-match-p (overlay prop)
"Return non-nil if the overlay's properties match PROP.
When PROP is a symbol, return non-nil if the overlay contains that property
and its value is non-nil. When PROP is a list, return non-nil if the value
of the overlay's property (car PROP) is one of the (cdr PROP).
"
(if (symbolp prop)
(overlay-get overlay prop)
(memq (overlay-get overlay (car prop)) (cdr prop))))
(defun pm--move-overlays (from-buffer to-buffer)
"Delete all overlays in TO-BUFFER, then copy FROM-BUFFER overlays to it."
;; Some overlays need to be copied to avoid changing the display in other windows
;; which display same polymode buffer
;; #348 for an example where overaly with invisible property should be copied
;; #350 for examples where overlays should be moved (most of them)
;; Ensure that the overlays which we will copy are not already in the to-buffer. This
;; is a rough brush, but there is no way currently to identify the overlays more
;; precisely, and it's probably not worth the extra effort.
(with-current-buffer to-buffer
(mapc (lambda (o)
(when
(cl-some (lambda (p) (pm--overlay-match-p o p))
polymode-copy-overlays-with-these-properties-from-old-buffer)
(delete-overlay o)))
(overlays-in 1 (1+ (buffer-size)))))
(with-current-buffer from-buffer
(mapc (lambda (o)
(unless (or (overlay-get o 'linum-str)
(overlay-get o 'yas--snippet))
(move-overlay o (overlay-start o) (overlay-end o) to-buffer)))
(overlays-in 1 (1+ (buffer-size))))))
(unless (cl-some (lambda (p) (pm--overlay-match-p o p))
polymode-ignore-overlays-with-these-properties)
(if (cl-some (lambda (p) (pm--overlay-match-p o p))
polymode-copy-overlays-with-these-properties-from-old-buffer)
(let ((o-copy (copy-overlay o))
(start (overlay-start o))
(end (overlay-end o)))
(move-overlay o-copy start end to-buffer))
(move-overlay o (overlay-start o) (overlay-end o) to-buffer))))
(overlays-in 1 (1+ (buffer-size)))))
)
(defun pm--move-vars (vars from-buffer &optional to-buffer)
(let ((to-buffer (or to-buffer (current-buffer))))
@@ -1198,7 +1282,6 @@ spans. Two adjacent spans might have same major mode, thus
(widen)
(let* ((hostmode (eieio-oref pm/polymode '-hostmode))
(pos beg)
(ttype 'dummy)
(span (pm-innermost-span beg))
(nspan span)
(ttype (pm-true-span-type span))
@@ -1395,17 +1478,22 @@ Placed with high priority in `after-change-functions' hook."
;; (remove-hook 'after-change-functions 'jit-lock-after-change t))
))))
(defun pm--run-other-hooks (allow syms hook &rest args)
(when (and allow polymode-mode pm/polymode)
(dolist (sym syms)
(defun pm--run-hooks-in-other-buffers (function-names hook-name &rest args)
"Run each function in FUNCTION-NAMES in other polymode buffers.
But, only if it is part of the hook HOOK-NAME. Each function is called
witih arguments ARGS."
(when (and polymode-mode pm/polymode)
(let ((cbuf (current-buffer)))
(dolist (buf (eieio-oref pm/polymode '-buffers))
(when (buffer-live-p buf)
(unless (eq buf (current-buffer))
(unless (eq buf cbuf)
(with-current-buffer buf
(when (memq sym (symbol-value hook))
(if args
(apply sym args)
(funcall sym))))))))))
(let ((hooks (symbol-value hook-name)))
(dolist (sym function-names)
(when (memq sym hooks)
(if args
(apply sym args)
(funcall sym))))))))))))
;; BUFFER SAVE
;; TOTHINK: add auto-save-hook?
@@ -1423,17 +1511,28 @@ declared in the base buffer is triggered.")
"Run after-save-hooks in indirect buffers.
Only those in `polymode-run-these-after-save-functions-in-other-buffers'
are triggered if present."
(pm--run-other-hooks t
polymode-run-these-before-save-functions-in-other-buffers
'after-save-hook))
(pm--run-hooks-in-other-buffers
polymode-run-these-before-save-functions-in-other-buffers
'after-save-hook))
(defun polymode-after-save ()
"Run after-save-hooks in indirect buffers.
Only those in `polymode-run-these-after-save-functions-in-other-buffers'
are triggered if present."
(pm--run-other-hooks t
polymode-run-these-after-save-functions-in-other-buffers
'after-save-hook))
(let ((new-name (replace-regexp-in-string "^ +" "" (buffer-name))))
(unless (equal new-name pm--base-buffer-name)
(let ((cbuf (current-buffer)))
;; Ensure we are in the base-buffer
(cl-assert (eq (buffer-base-buffer) nil))
(setq pm--base-buffer-name new-name)
;; Rename indirect buffers (#346)
(dolist (buf (eieio-oref pm/polymode '-buffers))
(unless (eq buf cbuf)
(with-current-buffer buf
(rename-buffer (pm--buffer-name (not (get-buffer-window buf 'visible))))))))))
(pm--run-hooks-in-other-buffers
polymode-run-these-after-save-functions-in-other-buffers
'after-save-hook))
;; change hooks
@@ -1442,30 +1541,36 @@ are triggered if present."
(defvar polymode-run-these-after-change-functions-in-other-buffers nil
"After-change functions to run in all other buffers.")
;; FIXME: LSP specific; move this to compat somehow
(declare-function pm--lsp-position "polymode-compat")
(defvar-local pm--lsp-before-change-end-position nil)
(defun polymode-before-change (beg end)
"Polymode before-change fixes.
Run `polymode-run-these-before-change-functions-in-other-buffers'.
Placed with low priority in `before-change-functions' hook."
(pm--prop-put :before-change-range (cons beg end))
;; FIXME: LSP specific move this out somehow
(when (boundp 'lsp-mode)
(dolist (buf (eieio-oref pm/polymode '-buffers))
(with-current-buffer buf
(when lsp-mode
(setq pm--lsp-before-change-end-position (pm--lsp-position end))))))
(pm--run-other-hooks pm-allow-before-change-hook
polymode-run-these-before-change-functions-in-other-buffers
'before-change-functions
beg end))
(when pm-allow-before-change-hook
(pm--run-hooks-in-other-buffers
polymode-run-these-before-change-functions-in-other-buffers
'before-change-functions
beg end)))
(defun polymode-after-change (beg end len)
"Polymode after-change fixes.
Run `polymode-run-these-after-change-functions-in-other-buffers'.
Placed with low priority in `after-change-functions' hook."
(pm--run-other-hooks pm-allow-after-change-hook
polymode-run-these-after-change-functions-in-other-buffers
'after-change-functions
beg end len))
;; ensure points are synchronized (after-change runs BEFORE post-command-hook)
(when pm-allow-after-change-hook
(pm--run-hooks-in-other-buffers
polymode-run-these-after-change-functions-in-other-buffers
'after-change-functions
beg end len)))
(defvar polymode-run-these-pre-commands-in-other-buffers nil
"These commands, if present in `pre-command-hook', are run in other bufers.")
@@ -1477,13 +1582,13 @@ Placed with low priority in `after-change-functions' hook."
Currently synchronize points and runs
`polymode-run-these-pre-commands-in-other-buffers' if any. Runs in
local `pre-command-hook' with very high priority."
(pm--synchronize-points (current-buffer))
(condition-case err
(pm--run-other-hooks pm-allow-pre-command-hook
polymode-run-these-pre-commands-in-other-buffers
'pre-command-hook)
(error (message "error polymode-pre-command run other hooks: (%s) %s"
(point) (error-message-string err)))))
(when pm-allow-pre-command-hook
(condition-case err
(pm--run-hooks-in-other-buffers
polymode-run-these-pre-commands-in-other-buffers
'pre-command-hook)
(error (message "error polymode-pre-command run other hooks: (%s) %s"
(point) (error-message-string err))))))
(defun polymode-post-command ()
"Select the buffer relevant buffer and run post-commands in other buffers.
@@ -1503,9 +1608,10 @@ appropriate. This function is placed into local
(condition-case err
(if (eq cbuf (current-buffer))
;; 1. same buffer, run hooks in other buffers
(pm--run-other-hooks pm-allow-post-command-hook
polymode-run-these-post-commands-in-other-buffers
'post-command-hook)
(when pm-allow-post-command-hook
(pm--run-hooks-in-other-buffers
polymode-run-these-post-commands-in-other-buffers
'post-command-hook))
;; 2. Run all hooks in this (newly switched to) buffer
(run-hooks 'post-command-hook))
(error (message "error in polymode-post-command run other hooks: (%s) %s"
@@ -1916,11 +2022,12 @@ Return FALLBACK if non-nil, otherwise the value of
(fboundp polymode-default-inner-mode))
polymode-default-inner-mode)
(when (or (eq fallback 'host)
(fboundp fallback))
(and (fboundp fallback)
(functionp fallback)))
fallback)
'poly-fallback-mode))
;; proper mode symbol
((and (symbolp name) (fboundp name) name))
((and (symbolp name) (and (fboundp name) (functionp name)) name))
;; compute from name
((let* ((str (pm--symbol-name
(or (cdr (assq (intern (pm--symbol-name name))
@@ -1929,28 +2036,30 @@ Return FALLBACK if non-nil, otherwise the value of
(mname (if (string-match-p "-mode$" str)
str
(concat str "-mode"))))
(or
;; direct search
(let ((mode (intern mname)))
(when (fboundp mode)
mode))
;; downcase
(let ((mode (intern (downcase mname))))
(when (fboundp mode)
mode))
;; auto-mode alist
(let ((dummy-file (concat "a." str)))
(cl-loop for (k . v) in auto-mode-alist
if (and (string-match-p k dummy-file)
(not (string-match-p "^poly-" (symbol-name v))))
return v))
(when (or (eq polymode-default-inner-mode 'host)
(fboundp polymode-default-inner-mode))
polymode-default-inner-mode)
(when (or (eq fallback 'host)
(fboundp fallback))
fallback)
'poly-fallback-mode))))))
(major-mode-remap
(or
;; direct search
(let ((mode (intern mname)))
(when (and (fboundp mode) (functionp mode))
mode))
;; downcase
(let ((mode (intern (downcase mname))))
(when (and (fboundp mode) (functionp mode))
mode))
;; auto-mode alist
(let ((dummy-file (concat "a." str)))
(cl-loop for (k . v) in auto-mode-alist
if (and (string-match-p k dummy-file)
(not (string-match-p "^poly-" (symbol-name v))))
return v))
(when (or (eq polymode-default-inner-mode 'host)
(and (fboundp polymode-default-inner-mode)
(functionp polymode-default-inner-mode)))
polymode-default-inner-mode)
(when (or (eq fallback 'host)
(and (fboundp fallback) (functionp fallback)))
fallback)
'poly-fallback-mode)))))))
(defun pm--oref-with-parents (object slot)
"Merge slots SLOT from the OBJECT and all its parent instances."
@@ -1959,7 +2068,7 @@ Return FALLBACK if non-nil, otherwise the value of
(setq VALS (append (and (slot-boundp object slot) ; don't cascade
(eieio-oref object slot))
VALS)
object (and (slot-boundp object :parent-instance)
object (and (slot-boundp object 'parent-instance)
(eieio-oref object 'parent-instance))))
VALS))
@@ -2032,18 +2141,21 @@ Elements of LIST can be either strings or symbols."
(when (and polymode-mode
(buffer-live-p buffer))
(let* ((bufs (eieio-oref pm/polymode '-buffers))
;; (buffer (or buffer
;; (cl-loop for b in bufs
;; if (and (buffer-live-p b)
;; (buffer-local-value 'pm/current b))
;; return b)
;; (current-buffer)))
(pos (with-current-buffer buffer (point))))
(dolist (b bufs)
(when (buffer-live-p b)
(with-current-buffer b
(goto-char pos)))))))
(defmacro pm-with-synchronized-points (&rest body)
"Run BODY and ensure the points in all polymode buffers are
synchronized before and after BODY."
(declare (indent 0) (debug (body)))
(pm--synchronize-points)
`(prog1
,@body
(pm--synchronize-points)))
(defun pm--completing-read (prompt collection &optional predicate require-match
initial-input hist def inherit-input-method)
;; Wrapper for `completing-read'.

6
lisp/polymode/polymode-debug.el
View File

@@ -104,9 +104,7 @@ Key bindings:
(pm-base-buffer) (with-current-buffer (pm-base-buffer) (point))
(buffer-name) (point)
(get-buffer-window (pm-base-buffer))
(with-current-buffer (pm-base-buffer) (window-point))
;; FIXME: This arg is not used.
(window-point))))
(with-current-buffer (pm-base-buffer) (window-point)))))
;; (defun pm-debug-beore-change (&rest r)
;; (pm--debug-report-point "|before|" this-command))
@@ -420,6 +418,8 @@ currently traced functions."
(setq args "[...]"))
(funcall orig-fn fn level args context)))
(declare-function trace-entry-message "ext:")
(declare-function trace-exit-message "ext:")
(advice-add #'trace-entry-message :around #'pm-trace--fix-args-for-tracing)
(advice-add #'trace-exit-message :around #'pm-trace--fix-args-for-tracing)
;; (advice-remove #'trace-entry-message #'pm-trace--fix-args-for-tracing)

10
lisp/polymode/polymode-export.el
View File

@@ -351,7 +351,7 @@ If NO-ASK-IF-1 is non-nil, don't ask if there is only one exporter."
(interactive)
(unless pm/polymode
(error "No pm/polymode object found. Not in polymode buffer?"))
(let* ((weavers (delete-dups (pm--oref-with-parents pm/polymode :weavers)))
(let* ((weavers (delete-dups (pm--oref-with-parents pm/polymode 'weavers)))
(exporters (pm--abrev-names
"pm-exporter/\\|-exporter"
(cl-delete-if-not
@@ -368,7 +368,7 @@ If NO-ASK-IF-1 is non-nil, don't ask if there is only one exporter."
when (pm--selector-match el (concat "dummy." (nth 2 w)))
return t))
return t)))
(delete-dups (pm--oref-with-parents pm/polymode :exporters)))))
(delete-dups (pm--oref-with-parents pm/polymode 'exporters)))))
(sel (if exporters
(if (and no-ask-if-1 (= (length exporters) 1))
(car exporters)
@@ -378,7 +378,7 @@ If NO-ASK-IF-1 is non-nil, don't ask if there is only one exporter."
(setq pm--exporter-hist (delete-dups pm--exporter-hist))
(setq-local pm--export:from-last nil)
(setq-local pm--export:to-last nil)
(oset pm/polymode :exporter out)
(oset pm/polymode exporter out)
out))
(defmacro polymode-register-exporter (exporter default &rest configs)
@@ -386,8 +386,8 @@ If NO-ASK-IF-1 is non-nil, don't ask if there is only one exporter."
When DEFAULT is non-nil, also make EXPORTER the default exporter
for each polymode in CONFIGS."
`(dolist (pm ',configs)
(object-add-to-list (symbol-value pm) :exporters ',exporter)
(when ,default (oset (symbol-value pm) :exporter ',exporter))))
(object-add-to-list (symbol-value pm) 'exporters ',exporter)
(when ,default (oset (symbol-value pm) exporter ',exporter))))
;;; GLOBAL EXPORTERS

38
lisp/polymode/polymode-methods.el
View File

@@ -63,13 +63,13 @@ Ran by the polymode mode function."
;; Set if nil! This allows unspecified host chunkmodes to be used in
;; minor modes.
(host-mode (or (eieio-oref hostmode 'mode)
(oset hostmode :mode major-mode))))
(oset hostmode mode major-mode))))
;; FIXME: mode hooks and local var hacking happens here. Need to move it
;; to the end.
(pm--mode-setup host-mode)
(oset hostmode -buffer (current-buffer))
(oset config -hostmode hostmode)
(setq pm--core-buffer-name (buffer-name)
(setq pm--base-buffer-name (buffer-name)
pm/polymode config
pm/chunkmode hostmode
pm/current t
@@ -82,17 +82,13 @@ Ran by the polymode mode function."
;; (run-mode-hooks) ;; FIXME
))
(cl-defmethod pm-initialize ((chunkmode pm-inner-chunkmode) &optional type mode)
"Initialization of the innermodes' (indirect) buffers."
;; run in chunkmode indirect buffer
(setq mode (or mode (pm--get-innermode-mode chunkmode type)))
(let* ((pm-initialization-in-progress t)
(post-fix (replace-regexp-in-string "poly-\\|-mode" "" (symbol-name mode)))
(core-name (format "%s[%s]" (buffer-name (pm-base-buffer))
(or (cdr (assoc post-fix polymode-mode-abbrev-aliases))
post-fix)))
(new-name (generate-new-buffer-name core-name)))
(rename-buffer new-name)
(let* ((pm-initialization-in-progress t))
(rename-buffer (pm--buffer-name))
;; FIXME: Mode hooks and local var hacking happens here. Need to move it to
;; the end. But then font-lock is not activated and buffers not installed
;; correctly.
@@ -102,8 +98,7 @@ Ran by the polymode mode function."
(pm--move-vars '(pm/polymode buffer-file-coding-system) (pm-base-buffer))
;; FIXME: This breaks if different chunkmodes use same-mode buffer. Even for
;; head/tail the value of pm/type will be wrong for tail
(setq pm--core-buffer-name core-name
pm/chunkmode chunkmode
(setq pm/chunkmode chunkmode
pm/type (pm-true-span-type chunkmode type))
;; FIXME: should not be here?
(vc-refresh-state)
@@ -115,7 +110,7 @@ Ran by the polymode mode function."
;; If this rename happens before the mode setup font-lock doesn't work in
;; inner buffers.
(when pm-hide-implementation-buffers
(rename-buffer (generate-new-buffer-name (concat " " pm--core-buffer-name)))))
(rename-buffer (pm--buffer-name 'hidden))))
(pm--run-init-hooks chunkmode type 'polymode-init-inner-hook)
;; Call polymode mode for the sake of the keymap and hook. Same minor mode
;; which runs in the host buffer but without recursive call to `pm-initialize'.
@@ -403,7 +398,7 @@ TAIL-BEG TAIL-END).")
(when (stringp matcher)
(setq matcher (cons matcher 0)))
(cond ((consp matcher)
(re-search-forward (car matcher) (point-at-eol) t)
(re-search-forward (car matcher) (line-end-position) t)
(match-string-no-properties (cdr matcher)))
((functionp matcher)
(funcall matcher)))))
@@ -477,7 +472,7 @@ TAIL-BEG TAIL-END).")
(defun pm--indent-line-raw (span)
(pm--indent-raw span 'pm--indent-line-function-original)
(pm--reindent-with+-indent span (point-at-bol) (point-at-eol)))
(pm--reindent-with+-indent span (line-beginning-position) (line-end-position)))
(defun pm--indent-region-raw (span beg end)
(pm--indent-raw span 'pm--indent-region-function-original beg end)
@@ -499,7 +494,6 @@ Function used for `indent-region-function'."
(let* ((end-span (copy-marker (nth 2 span)))
(end1 (min end end-span)))
(goto-char beg)
;; (pm-switch-to-buffer)
;; indent first line separately
(pm-indent-line (nth 3 span) span)
(beginning-of-line 2)
@@ -530,7 +524,7 @@ the chunkmode.")
(delta))
(back-to-indentation)
(setq delta (- pos (point)))
(let* ((bol (point-at-bol))
(let* ((bol (line-beginning-position))
(span (or span (pm-innermost-span)))
(prev-span-pos)
(first-line (save-excursion
@@ -603,14 +597,14 @@ to indent."
;; empty line
((looking-at-p "[ \t]*$") 0)
;; inner span starts at bol; honor +-indent cookie
((= (point) (point-at-bol))
((= (point) (line-beginning-position))
(pm--+-indent-offset-on-this-line span))
;; code after header
(t
(end-of-line)
(skip-chars-forward "\t\n")
(pm--indent-line-raw span)
(- (point) (point-at-bol))))))))
(- (point) (line-beginning-position))))))))
(indent-line-to
;; indent with respect to header line
(+ delta (pm--head-indent span)))))))))
@@ -628,13 +622,13 @@ to indent."
(when (not (bolp)) ; for spans which don't start at bol, first line is next line
(forward-line 1))
(skip-chars-forward " \t\n\r")
(when (< (point-at-eol) pos)
(when (< (line-end-position) pos)
;; not on first line -> compute indent of the first line
(goto-char (nth 1 span))
(skip-chars-forward " \t\n\r")
(back-to-indentation)
(when (< (point-at-eol) pos)
(- (point) (point-at-bol)))))))
(when (< (line-end-position) pos)
(- (point) (line-beginning-position)))))))
;; SPAN is a body span; do nothing if narrowed to body
(defun pm--head-indent (&optional span)
@@ -658,7 +652,7 @@ to indent."
(current-column)))))
(defun pm--+-indent-offset-on-this-line (span)
(if (re-search-forward "\\([+-]\\)indent" (point-at-eol) t)
(if (re-search-forward "\\([+-]\\)indent" (line-end-position) t)
(let ((basic-offset (pm--oref-value (nth 3 span) 'indent-offset)))
(if (string= (match-string 1) "-")
(- basic-offset)

19
lisp/polymode/polymode-pkg.el
View File

@@ -1,12 +1,9 @@
(define-package "polymode" "20230317.1218" "Extensible framework for multiple major modes"
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "polymode" "20250617.1033"
"Extensible framework for multiple major modes."
'((emacs "25"))
:commit "ca060e081a1f849a880732670dc15370ac987b89" :maintainers
'(("Vitalie Spinu" . "spinuvit@gmail.com"))
:maintainer
'("Vitalie Spinu" . "spinuvit@gmail.com")
:keywords
'("languages" "multi-modes" "processes")
:url "https://github.com/polymode/polymode")
;; Local Variables:
;; no-byte-compile: t
;; End:
:url "https://github.com/polymode/polymode"
:commit "25ba9463a443f0e904147138f226284e437248d3"
:revdesc "25ba9463a443"
:keywords '("languages" "multi-modes" "processes")
:maintainers '(("Vitalie Spinu" . "spinuvit@gmail.com")))

28
lisp/polymode/polymode-test-utils.el
View File

@@ -54,6 +54,10 @@ Look into tests/input directory then in samples directory."
if (file-exists-p f) return f)
(error "No file with name '%s' found in '%s'" name default-directory))))
(defun pm-test-running-on-github-p ()
(string= (downcase (or (getenv "GITHUB_ACTIONS") "false")) "true"))
(defun pm-test-matcher (string span-alist matcher &optional dry-run)
(with-temp-buffer
(insert string)
@@ -82,8 +86,8 @@ Look into tests/input directory then in samples directory."
(message ")"))
nil)))
(defmacro pm-test-run-on-string (mode string &rest body)
"Run BODY in a temporary buffer containing STRING in MODE.
(defmacro pm-test-run-on-string (mode string position &rest body)
"Run BODY in a temporary buffer containing STRING in MODE at POSITION.
MODE is a quoted symbol."
(declare (indent 1) (debug (form form body)))
`(let ((*buf* "*pm-test-string-buffer*"))
@@ -98,7 +102,7 @@ MODE is a quoted symbol."
(and (bound-and-true-p syntax-propertize-function)
(not (local-variable-p 'parse-sexp-lookup-properties))
(setq-local parse-sexp-lookup-properties t))
(goto-char (point-min))
(funcall-interactively 'goto-char ,position)
(let ((poly-lock-allow-background-adjustment nil))
(when polymode-mode
;; font-lock not activated in batch mode
@@ -111,7 +115,7 @@ MODE is a quoted symbol."
(defun pm-test-spans (mode string)
(declare (indent 1))
(pm-test-run-on-string mode
string
string 1
(pm-map-over-spans
(lambda (span)
(let ((range0 (pm-span-to-range span)))
@@ -190,7 +194,7 @@ MODE is a quoted symbol."
(smode major-mode)
(stext (buffer-substring-no-properties sbeg send))
;; other buffer
(ref-buf (pm-test-run-on-string smode stext))
(ref-buf (pm-test-run-on-string smode stext 1))
(ref-pos 1))
(when pm-verbose
(message "---- testing %s ----" (pm-format-span span t)))
@@ -243,10 +247,10 @@ MODE is a quoted symbol."
:pos pos
:ref-pos ref-pos
:line (progn (goto-char pos)
(buffer-substring-no-properties (point-at-bol) (point-at-eol)))
(buffer-substring-no-properties (line-beginning-position) (line-end-position)))
:ref-line (with-current-buffer ref-buf
(goto-char ref-pos)
(buffer-substring-no-properties (point-at-bol) (point-at-eol)))
(buffer-substring-no-properties (line-beginning-position) (line-end-position)))
:mode smode))))
;; for the interactive convenience
(switch-to-buffer (current-buffer))
@@ -371,7 +375,7 @@ points."
(goto-char (point-min))
(set-buffer-modified-p nil)
(while (not (eobp))
(let ((orig-line (buffer-substring-no-properties (point-at-eol) (point-at-bol))))
(let ((orig-line (buffer-substring-no-properties (line-end-position) (line-beginning-position))))
(unless (string-match-p "no-indent-test" orig-line)
(undo-boundary)
;; (pm-switch-to-buffer)
@@ -379,12 +383,12 @@ points."
;; (line-number-at-pos) (point) (current-buffer)
;; (syntax-ppss) syntax-propertize--done)
(pm-indent-line-dispatcher)
(unless (equal orig-line (buffer-substring-no-properties (point-at-eol) (point-at-bol)))
(unless (equal orig-line (buffer-substring-no-properties (line-end-position) (line-beginning-position)))
(undo-boundary)
(pm-switch-to-buffer (point))
(ert-fail (list :pos (point) :line (line-number-at-pos)
:mode major-mode
:indent-line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))))
:indent-line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))))))
(forward-line 1))
(let (points1 points2)
(pm-map-over-spans (lambda (span) (push (/ (+ (nth 1 span) (nth 2 span)) 2) points1)))
@@ -436,10 +440,10 @@ points."
:ref (with-temp-buffer
(insert right)
(goto-char pos)
(buffer-substring-no-properties (point-at-bol) (point-at-eol)))
(buffer-substring-no-properties (line-beginning-position) (line-end-position)))
:new (progn
(goto-char pos)
(buffer-substring-no-properties (point-at-bol) (point-at-eol)))))))))))
(buffer-substring-no-properties (line-beginning-position) (line-end-position)))))))))))
(defmacro pm-test-map-over-modes (mode file)
`(pm-test-run-on-file ,mode ,file

8
lisp/polymode/polymode-weave.el
View File

@@ -258,8 +258,8 @@ specification."
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))))
(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."
@@ -268,12 +268,12 @@ each polymode in CONFIGS."
(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))))
(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)
(oset pm/polymode weaver out)
out))
(provide 'polymode-weave)

49
lisp/polymode/polymode.el
View File

@@ -3,7 +3,8 @@
;; Author: Vitalie Spinu
;; Maintainer: Vitalie Spinu <spinuvit@gmail.com>
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Version: 0.2.2
;; Package-Version: 20250617.1033
;; Package-Revision: 25ba9463a443
;; Package-Requires: ((emacs "25"))
;; URL: https://github.com/polymode/polymode
;; Keywords: languages, multi-modes, processes
@@ -46,10 +47,17 @@
(require 'easymenu)
(require 'derived)
(defvar polymode-prefix-key nil
"[Obsoleted] Prefix key for the polymode mode keymap.
Not effective after loading the polymode library.")
(make-obsolete-variable 'polymode-prefix-key "Unbind in `polymode-mode-map'" "v0.1.6")
(defvar polymode-prefix-key "\M-n"
"Default prefix key in `polymode-minor-mode-map'.
Not effective after loading the polymode library.
Instead of setting this key you can programatically bind it directly
in `polymode-minor-mode-map` keymap:
(define-key polymode-minor-mode-map (kbd \"M-n\") nil)
;unbind the default M-n prefix
(define-key polymode-minor-mode-map (kbd \"C-c n\") polymode-map)
")
(defvar polymode-map
(let ((map (define-prefix-command 'polymode-map)))
@@ -63,23 +71,25 @@ Not effective after loading the polymode library.")
;; chunk manipulation
(define-key map "\M-k" #'polymode-kill-chunk)
(define-key map "\M-m" #'polymode-mark-or-extend-chunk)
(define-key map "\M-w" #'polymode-kill-ring-save-chunk)
(define-key map "\C-t" #'polymode-toggle-chunk-narrowing)
;; backends
(define-key map "e" #'polymode-export)
(define-key map "E" #'polymode-set-exporter)
(define-key map "w" #'polymode-weave)
(define-key map "W" #'polymode-set-weaver)
(define-key map "t" #'polymode-tangle)
(define-key map "T" #'polymode-set-tangler)
;; (define-key map "t" #'polymode-tangle)
;; (define-key map "T" #'polymode-set-tangler)
(define-key map "$" #'polymode-show-process-buffer)
map)
"Polymode prefix map.
Lives on `polymode-prefix-key' in polymode buffers.")
By default, lives on `polymode-prefix-key' in polymode buffers.")
(defvaralias 'polymode-mode-map 'polymode-minor-mode-map)
(defvar polymode-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (or polymode-prefix-key "\M-n") 'polymode-map)
(when polymode-prefix-key
(define-key map polymode-prefix-key 'polymode-map))
map)
"The minor mode keymap which is inherited by all polymodes.")
@@ -236,6 +246,23 @@ Return the number of chunks of the same type moved over."
(pm-span-to-range span)
(pm-chunk-range (1- (nth 1 span))))))))
(defun polymode-kill-ring-save-chunk ()
"Copy current chunk into the kill-ring.
When in the head of chunk, copy the chunk including the head and tail,
otherwise only the body span.
When called interactively, highlight the copie region for `copy-region-blink-delay'."
(interactive)
(let ((span (pm-innermost-span)))
(let ((range (if (memq (car span) '(nil body))
(pm-span-to-range span)
(pm-chunk-range))))
(copy-region-as-kill (car range) (cdr range))
(when (called-interactively-p 'interactive)
(let ((overlay (make-overlay (car range) (cdr range))))
(overlay-put overlay 'face 'highlight)
(run-with-timer copy-region-blink-delay nil
(lambda () (delete-overlay overlay))))))))
(defun polymode-mark-or-extend-chunk ()
"DWIM command to repeatedly mark chunk or extend region.
When no region is active, mark the current span if in body of a
@@ -435,7 +462,7 @@ non-nil, don't throw if `polymode-eval-region-function' is nil."
(pi parent-conf)
(parent-map))
(while pi
(let ((map (and (slot-boundp pi :keylist)
(let ((map (and (slot-boundp pi 'keylist)
(eieio-oref pi 'keylist))))
(when map
(if (and (symbolp map)
@@ -445,7 +472,7 @@ non-nil, don't throw if `polymode-eval-region-function' is nil."
(setq parent-map map
pi nil)
;; list, descend to next parent and append the key list to keylist
(setq pi (and (slot-boundp pi :parent-instance)
(setq pi (and (slot-boundp pi 'parent-instance)
(eieio-oref pi 'parent-instance))
keylist (append map keylist))))))
(when (and parent-map (symbolp parent-map))