pkg update and first config fix

org-brain not working, add org-roam
This commit is contained in:
2022-12-19 23:02:34 +01:00
parent 02b3e07185
commit 82f05baffe
885 changed files with 356098 additions and 36993 deletions

View File

@@ -1,6 +1,6 @@
;;; poly-lock.el --- Font lock sub-system for polymode -*- lexical-binding: t -*-
;;
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;
@@ -78,11 +78,11 @@
(defvar poly-lock-defer-after-change t)
(defvar-local poly-lock-mode nil)
(eval-when-compile
(eval-and-compile
(defmacro with-buffer-prepared-for-poly-lock (&rest body)
"Execute BODY in current buffer, overriding several variables.
Preserves the `buffer-modified-p' state of the current buffer."
(declare (debug t))
(declare (debug (body)) (indent 1))
`(let ((inhibit-point-motion-hooks t))
(with-silent-modifications
,@body))))
@@ -121,14 +121,14 @@ switched on."
;; register extra functionality. [Unfortunately `jit-lock-register'
;; calls `jit-lock-mode' which we don't want. Hence the advice. TOTHINK:
;; Simply add-hook to `jit-lock-functions'?]
(jit-lock-register 'font-lock-fontify-region)
(jit-lock-register #'font-lock-fontify-region)
;; don't allow other functions
(setq-local fontification-functions '(poly-lock-function))
(setq-local font-lock-flush-function 'poly-lock-flush)
(setq-local font-lock-fontify-buffer-function 'poly-lock-flush)
(setq-local font-lock-ensure-function 'poly-lock-fontify-now)
(setq-local font-lock-flush-function #'poly-lock-flush)
(setq-local font-lock-fontify-buffer-function #'poly-lock-flush)
(setq-local font-lock-ensure-function #'poly-lock-fontify-now)
;; There are some more, jit-lock doesn't change those, neither do we:
;; font-lock-unfontify-region-function (defaults to font-lock-default-unfontify-region)
@@ -144,19 +144,19 @@ switched on."
(font-lock-default-function arg)
;; Must happen after call to `font-lock-default-function'
(remove-hook 'after-change-functions 'font-lock-after-change-function t)
(remove-hook 'after-change-functions 'jit-lock-after-change t)
(add-hook 'after-change-functions 'poly-lock-after-change nil t)
(remove-hook 'after-change-functions #'font-lock-after-change-function t)
(remove-hook 'after-change-functions #'jit-lock-after-change t)
(add-hook 'after-change-functions #'poly-lock-after-change nil t)
;; Reusing jit-lock var becuase modes populate it directly. We are using
;; this in `poly-lock-after-change' below. Taken from `jit-lock
;; initialization.
(add-hook 'jit-lock-after-change-extend-region-functions
'font-lock-extend-jit-lock-region-after-change
#'font-lock-extend-jit-lock-region-after-change
nil t))
(remove-hook 'after-change-functions 'poly-lock-after-change t)
(remove-hook 'fontification-functions 'poly-lock-function t))
(remove-hook 'after-change-functions #'poly-lock-after-change t)
(remove-hook 'fontification-functions #'poly-lock-function t))
(current-buffer))
(defvar poly-lock-chunk-size 2500
@@ -178,11 +178,13 @@ scope as `jit-lock-function'."
(with-buffer-prepared-for-poly-lock
(put-text-property start (point-max) 'fontified t)))))
(defun poly-lock-fontify-now (beg end &optional _verbose)
(defun poly-lock-fontify-now (&optional beg end _verbose)
"Polymode main fontification function.
Fontifies chunk-by chunk within the region BEG END."
(unless (or poly-lock-fontification-in-progress
pm-initialization-in-progress)
(setq beg (or beg (point-min))
end (or end (point-max)))
(let* ((font-lock-dont-widen t)
;; For now we fontify entire chunks at once. This simplicity is
;; warranted in multi-mode use cases.
@@ -281,7 +283,7 @@ Fontifies chunk-by chunk within the region BEG END."
(defun poly-lock-flush (&optional beg end)
"Force refontification of the region BEG..END.
This function is placed in `font-lock-flush-function''"
This function is placed in `font-lock-flush-function'."
(unless poly-lock-fontification-in-progress
(let ((beg (or beg (point-min)))
(end (or end (point-max))))
@@ -490,7 +492,7 @@ Assumes widen buffer. Sets `jit-lock-start' and `jit-lock-end'."
(put-text-property jit-lock-start jit-lock-end 'fontified nil))))))))))
(defun poly-lock-after-change (beg end old-len)
"Mark changed region with 'fontified nil.
"Mark changed region with `fontified' nil.
Extend the region to spans which need to be updated. BEG, END and
OLD-LEN are as in `after-change-functions'. When
`poly-lock-defer-after-change' is non-nil (the default), run fontification"
@@ -544,7 +546,7 @@ OLD-LEN are as in `after-change-functions'. When
(declare-function pm-get-adjust-face "polymode-methods")
(defvar poly-lock--extra-span-props (when (fboundp 'set-face-extend) (list :extend t)))
(defun poly-lock-adjust-span-face (span)
"Adjust 'face property of SPAN..
"Adjust `face' property of SPAN..
How adjustment is made is defined in :adjust-face slot of the
SPAN's chunkmode."
(interactive "r")

View File

@@ -1,6 +1,6 @@
;;; polymode-base.el --- Root Host and Polymode Configuration Objects -*- lexical-binding: t -*-
;;
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;

View File

@@ -1,6 +1,6 @@
;;; polymode-classes.el --- Core polymode classes -*- lexical-binding: t -*-
;;
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;
@@ -295,7 +295,7 @@ the trailing white spaces if any.")
(adjust-face
:initarg :adjust-face
:initform nil
:type (or number face list)
:type (or number symbol list)
:custom (choice number face sexp)
:documentation
"Fontification adjustment for the body of the chunk.
@@ -412,29 +412,30 @@ If set to 'host or 'body use host or body's mode respectively.")
:type (or string cons function)
:custom (choice string (cons string integer) function)
:documentation
"A regexp, a cons (REGEXP . SUB-MATCH) or a function.
"A REGEXP, a cons (REGEXP . SUB-MATCH) or a function.
When a function, the matcher must accept one argument that can
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 span of the
head or tail respectively. See the code of `pm-fun-matcher' for a
simple example.")
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..")
(tail-matcher
:initarg :tail-matcher
:type (or string cons function)
:custom (choice string (cons string integer) function)
:documentation
"A regexp, a cons (REGEXP . SUB-MATCH) or a function.
Like :head-matcher but for the chunk's tail. Currently, it is
always called with the point at the end of the matched head and
with the positive argument (aka match forward).")
Like :head-matcher but for the chunk's tail. Unlike
:head-matcher, it is always called with the point at the end of
the matched head and with the positive argument (aka match
forward). See `pm-forward-sexp-tail-matcher' for an example.")
(adjust-face
:initform 2)
(head-adjust-face
:initarg :head-adjust-face
:initform 'bold
:type (or number face list)
:type (or number symbol list)
:custom (choice number face sexp)
:documentation
"Head's face adjustment.
@@ -442,7 +443,7 @@ Can be a number, a list of properties or a face.")
(tail-adjust-face
:initarg :tail-adjust-face
:initform nil
:type (or null number face list)
:type (or null number symbol list)
:custom (choice (const :tag "From Head" nil)
number face sexp)
:documentation

View File

@@ -2,7 +2,7 @@
;;
;; Author: Vitalie Spinu
;; Maintainer: Vitalie Spinu
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Version: 0.1
;; URL: https://github.com/polymode/polymode
;; Keywords: emacs
@@ -181,12 +181,154 @@ are passed to ORIG-FUN."
(pm-apply-protected orig-fun args))
(apply orig-fun args)))
;;; LSP (lsp-mode and eglot)
;;
;; Emacs modifications `after-change-functions' to LSP insertions
;; https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textDocument_didChange
;;
;; INSERT: (50 56 0) means insert 6 chars starting at pos 50
;; {"range": {"start": {"line": 1, "character": 0},
;; "end" : {"line": 1, "character": 0}},
;; "text": "insert"}
;;
;; DELETE: (50 50 6) means delete 6 chars starting at pos 50
;; {"range": {"start": {"line": 1, "character": 0},
;; "end" : {"line": 1, "character": 6}},
;; "text": ""}
;;
;; REPLACE: (50 60 6) means delete 6 chars starting at pos 50, and replace
;; them with 10 chars
;; {"range": {"start": {"line": 1, "character": 0},
;; "end" : {"line": 1, "character": 6}},
;; "text": "new-insert"}
;;
;; INSERT:
;; before-change:(obeg,oend)=(50,50)
;; after-change:(nbeg,nend,olen)=(50,56,0)
;;
;; DELETE:
;; before-change:(obeg,oend)=(50,56)
;; after-change:(nbeg,nend,len)=(50,50,6)
;;
;; 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)
"Make a TextDocumentContentChangeEvent body for BEG to END, of length LEN."
(if (zerop len)
;; insertion
(pm--lsp-change-event beg end (buffer-substring-no-properties beg end))
(if (pm--lsp-simple-change-p beg len)
(let ((end-pos pm--lsp-before-change-end-position)
(text (buffer-substring-no-properties beg end)))
;; if beg == end deletion, otherwise replacement
(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)
(save-excursion
(goto-char pos)
(let ((char (if (eq pm/chunkmode (nth 3 (pm-innermost-span pos)))
(- (point) (line-beginning-position))
0)))
(list :line (1- (line-number-at-pos pos))
:character char)))))
(defun pm--lsp-change-event (beg end text)
(list
:range (list
:start (if (listp beg) beg (pm--lsp-position beg))
:end (if (listp end) end (pm--lsp-position end)))
:text text))
(defun pm--lsp-full-change-event ()
(list :text (pm--lsp-text)))
(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)))))
;; We cannot compute original change location when modifications are complex
;; (aka multiple changes are combined). In those cases we send an entire
;; document.
(defun pm--lsp-simple-change-p (beg len)
"Non-nil if the after change BEG and LEN match before change range."
(let ((bcr (pm--prop-get :before-change-range)))
(and (eq beg (car bcr))
(eq len (- (cdr bcr) (car bcr))))))
;; advises
(defun polymode-lsp-buffer-content (orig-fun)
(if (and polymode-mode pm/polymode)
(pm--lsp-text)
(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)
(funcall orig-fun beg end len)))
(defvar-local polymode-lsp-integration t)
(with-eval-after-load "lsp-mode"
(when polymode-lsp-integration
(add-to-list 'polymode-run-these-after-change-functions-in-other-buffers 'lsp-on-change)
;; (add-to-list 'polymode-run-these-before-change-functions-in-other-buffers 'lsp-before-change)
;; FIXME: add auto-save?
(add-to-list 'polymode-run-these-before-save-functions-in-other-buffers 'lsp--before-save)
(dolist (sym '(lsp-lens--after-save lsp-on-save))
(add-to-list 'polymode-run-these-after-save-functions-in-other-buffers sym))
;; (add-to-list 'polymode-move-these-minor-modes-from-old-buffer 'lsp-headerline-breadcrumb-mode)
(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)
(or (car (get-text-property beg :pm-span))
(car (get-text-property end :pm-span))))
(add-hook 'flyspell-incorrect-hook
#'pm--flyspel-dont-highlight-in-chunkmodes nil t)
;;; C/C++/Java
(pm-around-advice 'c-before-context-fl-expand-region #'pm-override-output-cons)
@@ -333,8 +475,8 @@ This is done by modifying `uniquify-buffer-base-name' to `pm--core-buffer-name'.
(null buffer-undo-tree))
(setq buffer-undo-tree (make-undo-tree))))
(eval-after-load 'undo-tree
'(add-hook 'polymode-init-inner-hook 'polymode-init-undo-tree-maybe))
(with-eval-after-load 'undo-tree
(add-hook 'polymode-init-inner-hook #'polymode-init-undo-tree-maybe))
;;; EVIL
@@ -348,8 +490,8 @@ This is done by modifying `uniquify-buffer-base-name' to `pm--core-buffer-name'.
(with-current-buffer new-buffer
(evil-change-state old-state))))))
(eval-after-load 'evil-core
'(add-hook 'polymode-after-switch-buffer-hook 'polymode-switch-buffer-keep-evil-state-maybe))
(with-eval-after-load 'evil-core
(add-hook 'polymode-after-switch-buffer-hook #'polymode-switch-buffer-keep-evil-state-maybe))
;;; HL line
@@ -365,8 +507,8 @@ This is done by modifying `uniquify-buffer-base-name' to `pm--core-buffer-name'.
(hl-line-unhighlight))
(when global-hl-line-mode
(global-hl-line-unhighlight))))
(eval-after-load 'hl-line
'(add-hook 'polymode-after-switch-buffer-hook 'polymode-switch-buffer-hl-unhighlight))
(with-eval-after-load 'hl-line
(add-hook 'polymode-after-switch-buffer-hook #'polymode-switch-buffer-hl-unhighlight))
;;; YAS

View File

@@ -1,6 +1,6 @@
;; polymode-core.el --- Core initialization and utilities for polymode -*- lexical-binding: t -*-
;;
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;
@@ -85,7 +85,9 @@
;; SHIELDS
(defvar pm-allow-after-change-hook t)
(defvar pm-allow-before-change-hook t)
(defvar pm-allow-pre-command-hook t)
(defvar pm-allow-post-command-hook t)
(defun polymode-disable-post-command ()
(when polymode-mode
@@ -119,9 +121,9 @@
(defvar-local polymode-default-inner-mode nil
"Inner mode for chunks with unspecified modes.
Intended to be used as local variable in polymode buffers. A
special value 'host means use the host mode.")
special value `host' means use the host mode.")
;;;###autoload
(put 'polymode-default-inner-mode 'safe-local-variable 'symbolp)
(put 'polymode-default-inner-mode 'safe-local-variable #'symbolp)
(defgroup polymode nil
"Object oriented framework for multiple modes based on indirect buffers"
@@ -194,7 +196,7 @@ will cause installation of `ess-julia-mode' in markdown ```julia chunks."
"An alist of abbreviation mappings from mode names to their abbreviations.
Used to compute mode post-fixes in buffer names. Example:
(add-to-list 'polymode-mode-abbrevs-aliases '(\"ess-r\" . \"R\"))")
(add-to-list \\='polymode-mode-abbrevs-aliases \\='(\"ess-r\" . \"R\"))")
(defvar polymode-before-switch-buffer-hook nil
"Hook run just before switching to a different polymode buffer.
@@ -280,7 +282,7 @@ from. If missing, the optional documentation string DOC is
generated automatically. KEY-ARGS is a list of key-value pairs.
See the documentation of the class `pm-host-chunkmode' for
possible values."
(declare (doc-string 3))
(declare (doc-string 3) (indent defun))
(polymode--define-chunkmode 'pm-host-chunkmode name parent doc key-args))
;;;###autoload
@@ -291,7 +293,7 @@ from. If missing the optional documentation string DOC is
generated automatically. KEY-ARGS is a list of key-value pairs.
See the documentation of the class `pm-inner-chunkmode' for
possible values."
(declare (doc-string 3))
(declare (doc-string 3) (indent defun))
(polymode--define-chunkmode 'pm-inner-chunkmode name parent doc key-args))
;;;###autoload
@@ -302,7 +304,7 @@ derived (cloned) from. If missing the optional documentation
string DOC is generated automatically. KEY-ARGS is a list of
key-value pairs. See the documentation of the class
`pm-inner-auto-chunkmode' for possible values."
(declare (doc-string 3))
(declare (doc-string 3) (indent defun))
(polymode--define-chunkmode 'pm-inner-auto-chunkmode name parent doc key-args))
@@ -386,15 +388,18 @@ case TYPE is ignored."
(t 'tail)))
(t (error "Type must be one of nil, 'host, 'head, 'tail or 'body")))))))
(defvar pm-use-cache t)
(defun pm-cache-span (span)
;; cache span
(unless pm-initialization-in-progress
(with-silent-modifications
;; (message "caching: %s %s" (car span) (pm-span-to-range span))
(let ((sbeg (nth 1 span))
(send (nth 2 span)))
(put-text-property sbeg send :pm-span span)
(put-text-property sbeg send :pm-mode (pm-span-mode span))))))
(when pm-use-cache
(unless pm-initialization-in-progress
(with-silent-modifications
;; (message "caching: %s %s" (car span) (pm-span-to-range span))
(let ((sbeg (nth 1 span))
(send (nth 2 span)))
(put-text-property sbeg send :pm-span span)
(put-text-property sbeg send :pm-mode (pm-span-mode span)))))))
(defun pm-flush-span-cache (beg end &optional buffer)
(with-silent-modifications
@@ -443,16 +448,29 @@ the front)."
(let ((allow-nested (eieio-oref (nth 3 span) 'allow-nested))
(is-host (null (car span))))
(cond
;; 1. nil means host and it can be an intersection of spans returned
;; by two neighboring inner chunkmodes. When `allow-nested` is
;; 'always the innermode essentially behaves like the host-mode.
;; 1. nil means host and it can be an intersection of spans returned by
;; two neighboring inner chunkmodes. When `allow-nested` is 'always the
;; innermode behaves like the host-mode (i.e. nest other spans regardless
;; of :can-nest slot)
((or is-host (eq allow-nested 'always))
;; when span is already an inner span, new host spans are irrelevant
(unless (car thespan)
(if (car thespan)
;; 1) inner thespan:
;; a) inner span [thespan ..|.. [span ...] ...]
;; b) outer span [thespan ..|..] ... [span ...]
;; c) host-like span [span ... [thespan ..|..] ]
(setq thespan
(list (car thespan)
(max (nth 1 span) (nth 1 thespan))
(min (nth 2 span) (nth 2 thespan))
(nth 3 thespan)))
;; 2) host thespan
;; a) hosts span [thespan ...] ..|.. [span ..]
;; b) host-like span [span ..|.. [thespan ...] ..]
(setq thespan
(list (unless is-host (car span))
(list (car span)
(max (nth 1 span) (nth 1 thespan))
(min (nth 2 span) (nth 2 thespan))
;; first host span has precedence for clarity
(nth 3 (if is-host thespan span))))))
;; 2. Inner span
((and (>= (nth 1 span) (nth 1 thespan))
@@ -556,7 +574,7 @@ the front)."
(not (eq span (get-text-property (1- beg) :pm-span)))))
(pm--chop-span (copy-sequence span) omin omax))))))))
(define-obsolete-function-alias 'pm-get-innermost-span 'pm-innermost-span "2018-08")
(define-obsolete-function-alias 'pm-get-innermost-span #'pm-innermost-span "2018-08")
(defun pm-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
@@ -568,14 +586,14 @@ defaults to point. Guarantied to return a non-empty span."
:point-min (point-min)
:point-max (point-max))))
(save-match-data
(or (unless no-cache
(or (when (and pm-use-cache (not no-cache))
(pm--cached-span pos))
(pm--innermost-span pm/polymode pos))))
(defun pm-span-to-range (span)
(and span (cons (nth 1 span) (nth 2 span))))
(define-obsolete-function-alias 'pm-get-innermost-range 'pm-innermost-range "2018-08")
(define-obsolete-function-alias 'pm-get-innermost-range #'pm-innermost-range "2018-08")
(defun pm-innermost-range (&optional pos no-cache)
(pm-span-to-range (pm-innermost-span pos no-cache)))
@@ -600,6 +618,18 @@ MATCHER is one of the forms accepted by \=`pm-inner-chunkmode''s
(match-end (cdr matcher))))))
(t (error "Head and tail matchers must be either regexp strings, cons cells or functions"))))
(defun pm-forward-sexp-tail-matcher (_arg)
"A simple tail matcher for a common closing-sexp character.
Use this matcher if an inner mode is delimited by a closing
construct like ${...}, xyz[...], html! {...} etc. In order to
match the tail `forward-sexp' is matched from HEAD-END - 1
position. ARG is ignored - always match forward."
(when (> (point) 0)
(backward-char 1)
(ignore-errors
(forward-sexp 1)
(cons (1- (point)) (point)))))
(defun pm-same-indent-tail-matcher (_arg)
"Get the end position of block with the higher indent than the current column.
Used as tail matcher for blocks identified by same indent. See
@@ -942,7 +972,7 @@ Parents' hooks are run first."
outline-level
polymode-default-inner-mode
tab-width)
"Variables transferred from base buffer on buffer switch.")
"Variables transferred from base buffer on switch to inner mode buffer.")
(define-obsolete-variable-alias 'pm-move-vars-from-old-buffer 'polymode-move-these-vars-from-old-buffer "v0.1.6")
(defvar polymode-move-these-vars-from-old-buffer
@@ -957,6 +987,8 @@ Parents' hooks are run first."
face-remapping-alist
isearch-mode ; this seems to be enough to avoid isearch glitching
line-move-visual
left-margin-width
right-margin-width
overwrite-mode
selective-display
text-scale-mode
@@ -971,17 +1003,17 @@ Parents' hooks are run first."
;; and executes it for all cursors in a post-command-hook so we
;; need to transfer in case the buffer was switched.
mc--this-command)
"Variables transferred from old buffer on buffer switch.")
"Variables transferred from old buffer to new buffer on buffer switch.")
(defvar polymode-move-these-minor-modes-from-base-buffer nil
"List of minor modes to move from base buffer.")
"Minor modes to move from base buffer on buffer switch.")
(defvar polymode-move-these-minor-modes-from-old-buffer
'(linum-mode
visual-line-mode
visual-fill-column-mode
writeroom-mode
multiple-cursors-mode)
"List of minor modes to move from the old buffer.")
"Minor modes to move from the old buffer during buffer switch.")
(defun pm-own-buffer-p (&optional buffer)
"Return t if BUFFER is owned by polymode.
@@ -1018,7 +1050,6 @@ switch."
;; be installed yet and there is no way install it
;; from here
buffer))))))
;; (message "setting buffer %d-%d [%s]" (nth 1 span) (nth 2 span) cbuf)
;; no further action if BUFFER is already the current buffer
(unless (eq buffer cbuf)
(when (and own visibly)
@@ -1042,7 +1073,8 @@ switch."
(window-start (window-start))
(visible (pos-visible-in-window-p))
(ractive (region-active-p))
(mkt (mark t)))
(mkt (mark t))
(hlf header-line-format))
(when pm-hide-implementation-buffers
(rename-buffer (pm--hidden-buffer-name)))
@@ -1060,6 +1092,11 @@ switch."
(bury-buffer-internal old-buffer)
(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
(unless header-line-format
(when hlf
(setq header-line-format '(""))))
(setq pm/current t)
;; fixme: what is the right way to do this ... activate-mark-hook?
@@ -1138,74 +1175,106 @@ transport) are performed."
pos-or-span)))
(pm-select-buffer span 'visibly)))
;; NB: save-excursion saves window-point only when current buffer is the
;; selected buffer. Thus when we iterate from a non-window buffer, and within
;; some of the iterations are performed in selected-buffer the point is moved
;; which might results in undesirable consequences (#295). Thus `save-excursion`
;; must be applied on each iteration.
;; TOTHINK: This function is used for font-lock, and thus we cannot rely on
;; cached spans. For other use-cases relying on cached spans would be faster.
;; Without cache `pm-get-span' is less efficient than this function which is
;; essentially a forward search of spans.
(defun pm-map-over-modes (fn beg end)
"Apply function FN for each major mode between BEG and END.
FN is a function of two arguments mode-beg and mode-end. This is
different from `pm-map-over-spans' which maps over polymode
spans. Two adjacent spans might have same major mode, thus
`pm-map-over-modes' will iterate over same or bigger regions than
`pm-map-over-spans'."
(when (< beg end)
(save-restriction
(widen)
(let* ((hostmode (eieio-oref pm/polymode '-hostmode))
(pos beg)
(ttype 'dummy)
span nspan nttype)
(when (< (point-min) beg)
(setq span (pm-innermost-span beg)
beg (nth 1 span)
pos (nth 2 span)
ttype (pm-true-span-type span))
(while (and (memq (car span) '(head body))
(< pos end))
(setq nspan (pm-innermost-span (nth 2 span))
nttype (pm-true-span-type nspan))
(if (eq ttype nttype)
(setq pos (nth 2 nspan))
(with-current-buffer (pm-span-buffer span)
(funcall fn beg pos))
(setq beg (nth 1 nspan)
pos (nth 2 nspan)))
(setq span nspan
ttype nttype)))
(span (pm-innermost-span beg))
(nspan span)
(ttype (pm-true-span-type span))
(nttype ttype))
;; 1. Use pm-innermost-span to get to the first tail. From there on rely
;; on `pm-next-chunk' for efficiency.
(setq beg (nth 1 span)
pos (nth 2 span))
(while (and (< pos end)
(memq (car span) '(head body)))
(while (and (< pos end)
(eq ttype nttype))
(setq pos (nth 2 nspan)
nspan (pm-innermost-span pos)
nttype (pm-true-span-type nspan)))
(with-current-buffer (pm-span-buffer span)
(funcall fn beg pos))
(setq span nspan
ttype nttype
beg (nth 1 nspan)
pos (nth 2 nspan)))
;; 2. Forward chunk search
(when (< pos end)
(let ((ichunks (cl-loop for im in (eieio-oref pm/polymode '-innermodes)
;; Extended chunks: car is the original innermode. Cannot use
;; autochunk modes (i.e. markdwon fortran-inner-mode) in calls to
;; pm-next-chunk. It would return fortran chunks.
(let ((echunks (cl-loop for im in (eieio-oref pm/polymode '-innermodes)
collect (cons im nil)))
(tichunks nil)
(spans nil))
spans)
(while (< pos end)
;; 1. recompute outdated chunks
(setq tichunks nil)
(dolist (ichunk ichunks)
(if (and (cdr ichunk)
(< pos (nth 5 ichunk)))
(push ichunk tichunks)
(let ((nchunk (pm-next-chunk (car ichunk) pos)))
(when nchunk
(push (cons (car ichunk) nchunk) tichunks)))))
(setq ichunks (reverse tichunks))
;; 2. Compute all (next) spans
;; 1. Recompute outdated chunks - if pos behind a chunk, replace
;; this chunk with next chunk of the same type.
(let (tchunks)
(dolist (echunk echunks)
(if (and (cdr echunk)
(< pos (nth 5 echunk)))
(push echunk tchunks)
(let ((nchunk (pm-next-chunk (car echunk) pos)))
(if nchunk
(push (cons (car echunk) nchunk) tchunks)
;; If nil, chunk is the last of this type in the buffer,
;; or there are no such chunks at all (on 1st iteration).
;; Keep it in the list in order to correctly compute last
;; intersections with nested innermodes.
(when (cdr echunk)
(push echunk tchunks))))))
(setq echunks (reverse tchunks)))
;; 2. Compute all (next) spans from spans
(setq spans nil)
(dolist (ichunk ichunks)
(let ((chunk (cdr ichunk)))
(let ((span (cond
((< pos (nth 1 chunk)) (list nil pos (nth 1 chunk) (car chunk)))
((< pos (nth 2 chunk)) (list 'head (nth 1 chunk) (nth 2 chunk) (car chunk)))
((< pos (nth 3 chunk)) (list 'body (nth 2 chunk) (nth 3 chunk) (car chunk)))
((< pos (nth 4 chunk)) (list 'tail (nth 3 chunk) (nth 4 chunk) (car chunk))))))
(push span spans))))
(dolist (echunk echunks)
(let ((chunk (cdr echunk)))
(let ((s (cond
((< pos (nth 1 chunk)) (list nil pos (nth 1 chunk) (car chunk)))
((< pos (nth 2 chunk)) (list 'head (nth 1 chunk) (nth 2 chunk) (car chunk)))
((< pos (nth 3 chunk)) (list 'body (nth 2 chunk) (nth 3 chunk) (car chunk)))
((< pos (nth 4 chunk)) (list 'tail (nth 3 chunk) (nth 4 chunk) (car chunk)))
(t (list nil (nth 4 chunk) (point-max) (car chunk))))))
(push s spans))))
(setq spans (nreverse spans))
;; 3. Intersect
;; 3. Intersect the spans
(setq nspan (list nil pos (point-max) hostmode))
(dolist (s spans)
(setq nspan (pm--intersect-spans nspan s)))
;; (setq pm--span-counter (1+ pm--span-counter)) ;; for debugging
;; NB: If there is a bug in the core, this caching is likely
;; causing major issues (runs in font-lock). Disable during
;; debugging.
(pm-cache-span nspan)
(setq nttype (pm-true-span-type nspan))
;; 4. funcall on region if type changed
;; 4. funcall on (previous) region if type changed
(unless (eq ttype nttype)
(when span
(with-current-buffer (pm-span-buffer span)
(funcall fn beg pos)))
(with-current-buffer (pm-span-buffer span)
(funcall fn beg pos))
(setq ttype nttype
beg (nth 1 nspan)))
(setq span nspan
pos (nth 2 nspan)))))
;; 5. funcall on last region
(with-current-buffer (pm-span-buffer span)
(funcall fn beg pos))))))
@@ -1237,10 +1306,11 @@ transport) are performed."
FUN is a function of one argument a span object (also available
in a dynamic variable *span*). Buffer is *not* narrowed to the
span, nor point is moved. If COUNT is non-nil, jump at most that
many times. If BACKWARDP is non-nil, map backwards. Point
synchronization across indirect buffers is not taken care of.
Modification of the buffer during mapping is an undefined
behavior."
many times. If BACKWARDP is non-nil, map backwards. If VISIBLY is
non-nil select buffers with the full synchronization (as if
performed by the user), otherwise point synchronization across
indirect buffers is not taken care of. Modification of the buffer
during mapping is an undefined behavior."
;; Important! Don't forget to save-excursion when calling map-overs-spans and
;; synchronize points if needed. Mapping can end in different buffer and
;; invalidate the caller assumptions.
@@ -1287,7 +1357,7 @@ behavior."
(narrow-to-region sbeg send)))))
(defmacro pm-with-narrowed-to-span (span &rest body)
(declare (indent 1) (debug body))
(declare (indent 1) (debug (sexp body)))
`(save-restriction
(pm-narrow-to-span ,span)
,@body))
@@ -1296,9 +1366,9 @@ behavior."
;;; HOOKS
;; There is also `poly-lock-after-change' in poly-lock.el
(defun polymode-flush-syntax-ppss-cache (beg end _)
"Run `syntax-ppss-flush-cache' from BEG to END in all polymode buffers."
"Run `syntax-ppss-flush-cache' from BEG to END in all polymode buffers.
Placed with high priority in `after-change-functions' hook."
;; Modification hooks are run only in current buffer and not in other (base or
;; indirect) buffers. Thus some actions like flush of ppss cache must be taken
;; care explicitly. We run some safety hooks checks here as well.
@@ -1306,13 +1376,14 @@ behavior."
(when (buffer-live-p buff)
(with-current-buffer buff
;; micro-optimization to avoid calling the flush twice
(when (memq 'syntax-ppss-flush-cache before-change-functions)
(remove-hook 'before-change-functions 'syntax-ppss-flush-cache t))
(when (memq #'syntax-ppss-flush-cache before-change-functions)
(remove-hook 'before-change-functions #'syntax-ppss-flush-cache t))
;; need to be the first to avoid breaking preceding hooks
(unless (eq (car after-change-functions)
'polymode-flush-syntax-ppss-cache)
(delq 'polymode-flush-syntax-ppss-cache after-change-functions)
(add-hook 'after-change-functions 'polymode-flush-syntax-ppss-cache nil t))
#'polymode-flush-syntax-ppss-cache)
(delq #'polymode-flush-syntax-ppss-cache after-change-functions)
(setq after-change-functions (cons #'polymode-flush-syntax-ppss-cache
after-change-functions)))
(syntax-ppss-flush-cache beg end)
;; Check if something has changed our hooks. (Am I theoretically paranoid or
;; this is indeed needed?) `fontification-functions' (and others?) should be
@@ -1323,21 +1394,121 @@ behavior."
;; (remove-hook 'after-change-functions 'jit-lock-after-change t))
))))
(defun polymode-pre-command-synchronize-state ()
"Synchronize state between buffers.
Currently synchronize points only. Runs in local `pre-command-hook'."
(pm--synchronize-points (current-buffer)))
(defun pm--run-other-hooks (allow syms hook &rest args)
(when (and allow polymode-mode pm/polymode)
(dolist (sym syms)
(dolist (buf (eieio-oref pm/polymode '-buffers))
(when (buffer-live-p buf)
(unless (eq buf (current-buffer))
(with-current-buffer buf
(when (memq sym (symbol-value hook))
(if args
(apply sym args)
(funcall sym))))))))))
(defun polymode-post-command-select-buffer ()
"Select the appropriate (indirect) buffer corresponding to point's context.
This funciton is placed in local `post-command-hook'."
;; BUFFER SAVE
;; TOTHINK: add auto-save-hook?
(defvar polymode-run-these-before-save-functions-in-other-buffers nil
"Beore-save functions to run in indirect buffers.
Saving happens from the base buffer, thus only `before-save-hook'
declared in the base buffer is triggered.")
(defvar polymode-run-these-after-save-functions-in-other-buffers nil
"After-save functions to run in indirect buffers.
Saving happens from the base buffer, thus only `after-save-hook'
declared in the base buffer is triggered.")
(defun polymode-before-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-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))
;; change hooks
(defvar polymode-run-these-before-change-functions-in-other-buffers nil
"Before-change functions to run in all other buffers.")
(defvar polymode-run-these-after-change-functions-in-other-buffers nil
"After-change functions to run in all other buffers.")
(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))
(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))
(defvar polymode-run-these-pre-commands-in-other-buffers nil
"These commands, if present in `pre-command-hook', are run in other bufers.")
(defvar polymode-run-these-post-commands-in-other-buffers nil
"These commands, if present in `post-command-hook', are run in other bufers.")
(defun polymode-pre-command ()
"Synchronize state between buffers and run pre-commands in other buffers.
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)))))
(defun polymode-post-command ()
"Select the buffer relevant buffer and run post-commands in other buffers.
Run all the `post-command-hooks' in the new buffer and those
command defined in
`polymode-run-these-post-commands-in-other-buffers' whenever
appropriate. This function is placed into local
`post-command-hook' with very low priority."
(when (and pm-allow-post-command-hook
polymode-mode
pm/chunkmode)
(condition-case err
(pm-switch-to-buffer)
(error (message "(pm-switch-to-buffer %s): %s"
(point) (error-message-string err))))))
pm/polymode)
(let ((cbuf (current-buffer)))
(condition-case err
(pm-switch-to-buffer)
(error (message "error in polymode-post-command: (pm-switch-to-buffer %s): %s"
(point) (error-message-string err))))
(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)
;; 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"
(point) (error-message-string err)))))))
(defvar-local pm--killed nil)
(defun polymode-after-kill-fixes ()
@@ -1395,6 +1566,8 @@ NEW-MODE can be t in which case mode is picked from the
(add-hook 'after-change-major-mode-hook #'polymode-after-change-major-mode-cleanup)
;;; CORE ADVICE
@@ -1412,9 +1585,23 @@ If FUN is a list, apply ADVICE to each element of it."
(unless pm-initialization-in-progress
(apply orig-fun args)))
(defun polymode-inhibit-in-indirect-buffers (orig-fun &rest args)
"Don't run ORIG-FUN (with ARGS) in polymode indirect buffers (aka inner modes).
Use this function to around advice delicate functions:
(advice-add \\='xyz :around #\\='polymode-inhibit-in-indirect-buffers)
or with `pm-around-advice' which allows for multiple advises at once:
(pm-around-advice \\='(foo bar) #\\='polymode-inhibit-in-indirect-buffers)"
(unless (and polymode-mode (buffer-base-buffer))
(apply orig-fun args)))
(defun polymode-with-current-base-buffer (orig-fun &rest args)
"Switch to base buffer and apply ORIG-FUN to ARGS.
Used in advises."
Use this function to around advice of functions that should run
in base buffer only like this:
(advice-add \\='foo :around #\\='polymode-with-current-base-buffer)
or with `pm-around-advice' which allows for multiple advises at
once:
(pm-around-advice \\='(foo bar) #\\='polymode-with-current-base-buffer)"
(if (and polymode-mode
(not pm--killed)
(buffer-live-p (buffer-base-buffer)))
@@ -1439,12 +1626,11 @@ Used in advises."
(pm--synchronize-points base))))
(apply orig-fun args)))
;; Most importat Core
;; (pm-around-advice #'kill-buffer #'polymode-with-current-base-buffer)
(pm-around-advice #'find-alternate-file #'polymode-with-current-base-buffer)
(pm-around-advice #'write-file #'polymode-with-current-base-buffer)
(pm-around-advice #'basic-save-buffer #'polymode-with-current-base-buffer)
;; (advice-remove #'kill-buffer #'polymode-with-current-base-buffer)
;; (advice-remove #'find-alternate-file #'polymode-with-current-base-buffer)
(pm-around-advice 'find-alternate-file #'polymode-with-current-base-buffer)
(pm-around-advice 'write-file #'polymode-with-current-base-buffer)
(pm-around-advice 'basic-save-buffer #'polymode-with-current-base-buffer)
;;; FILL
@@ -1473,7 +1659,8 @@ ARG is the same as in `forward-paragraph'"
(defun pm--call-syntax-propertize-original (start end)
(condition-case err
(funcall pm--syntax-propertize-function-original start end)
(save-excursion
(funcall pm--syntax-propertize-function-original start end))
(error
(message "ERROR: (%s %d %d) -> %s"
(if (symbolp pm--syntax-propertize-function-original)
@@ -1617,9 +1804,9 @@ ARG is the same as in `forward-paragraph'"
;; (when polymode-mode
;; (pm--reset-ppss-cache (pm-innermost-span pos))))
;; (advice-add #'syntax-ppss :before #'polymode-reset-ppss-cache)
;; (advice-add 'syntax-ppss :before #'polymode-reset-ppss-cache)
;; (unless pm--emacs>26
;; (advice-add #'syntax-ppss :before #'polymode-reset-ppss-cache))
;; (advice-add 'syntax-ppss :before #'polymode-reset-ppss-cache))
;; (defun polymode-restrict-syntax-propertize-extension (orig-fun beg end)
;; (if (and polymode-mode pm/polymode)

View File

@@ -1,6 +1,6 @@
;;; polymode-debug.el --- Interactive debugging utilities for polymode -*- lexical-binding: t -*-
;;
;; Copyright (C) 2016-2018 Vitalie Spinu
;; Copyright (C) 2016-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;
@@ -81,16 +81,38 @@
Key bindings:
\\{pm-debug-minor-mode-map}"
nil
" PMDBG"
:lighter " PMDBG"
:group 'polymode
(if pm-debug-minor-mode
(progn
;; this is global hook. No need to complicate with local hooks
(add-hook 'post-command-hook 'pm-debug-highlight-current-span))
(add-hook 'post-command-hook #'pm-debug-highlight-current-span)
;; (add-hook 'before-save-hook #'pm-debug-beore-change -99 t)
;; (add-hook 'after-save-hook #'pm-debug-after-change -99)
)
;; (remove-hook 'before-save-hook #'pm-debug-beore-change)
;; (remove-hook 'after-save-hook #'pm-debug-after-change)
(delete-overlay pm--underline-overlay)
(delete-overlay pm--highlight-overlay)
(remove-hook 'post-command-hook 'pm-debug-highlight-current-span)))
(remove-hook 'post-command-hook #'pm-debug-highlight-current-span)))
;; use to track point movements (#295)
(defun pm--debug-report-point (msg &optional r)
(when polymode-mode
(message "%s %s buffer[%s:%s %s:%s] window[%s:%s]"
msg (if r r "")
(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))))
;; (defun pm-debug-beore-change (&rest r)
;; (pm--debug-report-point "|before|" this-command))
;; (defun pm-debug-after-change (&rest r)
;; (pm--debug-report-point "|after|" this-command))
;;;###autoload
(defun pm-debug-minor-mode-on ()
@@ -249,61 +271,67 @@ With NO-CACHE prefix, don't use cached values of the span."
(defvar pm-traced-functions
'(
;; core initialization
(0 (pm-initialize
pm--common-setup
pm--mode-setup))
;; core initialization (traced even when polymode-mode is not yet installed)
(0 (pm--common-setup
pm--mode-setup
pm--run-derived-mode-hooks
pm--run-init-hooks
pm-initialize
hack-local-variables
run-hooks
run-mode-hooks))
;; core hooks
(1 (polymode-post-command-select-buffer
(1 (polymode-pre-command
polymode-post-command
polymode-after-kill-fixes
;; this one indicates the start of a sequence
poly-lock-after-change))
;; advises
(2 (pm-override-output-cons
pm-around-advice
polymode-with-current-base-buffer))
polymode-with-current-base-buffer
polymode-inhibit-during-initialization
pm-check-for-real-change-in-extend-multiline
poly-lock-no-jit-lock-in-polymode-buffers
pm-override-output-position))
;; (2.5 . "^markdown-fontify-.*")
;; init
(3 (pm-map-over-spans
pm-map-over-modes
pm-innermost-span
pm-next-chunk))
;; font-lock
(3 (font-lock-default-fontify-region
font-lock-fontify-keywords-region
font-lock-fontify-region
font-lock-fontify-syntactically-region
font-lock-unfontify-region
jit-lock--run-functions
jit-lock-fontify-now
poly-lock--after-change-internal
poly-lock--extend-region
poly-lock--extend-region-span
poly-lock-after-change
poly-lock-flush
poly-lock-fontify-now
poly-lock-function))
(4 . ".*\\(font\\|jit\\|poly\\)-lock.*")
;; syntax
(4 (syntax-ppss
(5 (syntax-ppss
pm--call-syntax-propertize-original
polymode-syntax-propertize
polymode-restrict-syntax-propertize-extension
pm-flush-syntax-ppss-cache
pm--reset-ppss-cache))
;; core functions
(5 (pm-select-buffer
(6 (pm-select-buffer
pm-map-over-spans
pm--get-intersected-span
pm--cached-span))
;; (13 . "^syntax-")
(14 . "^polymode-")
(15 . "^pm-")))
(6 . "^polymode-")
(7 . "^pm-")
(20 . "^syntax-")
))
(defvar pm--do-trace nil)
;;;###autoload
(defun pm-toggle-tracing (level)
"Toggle polymode tracing.
With numeric prefix toggle tracing for that LEVEL. Currently
universal argument toggles maximum level of tracing (4). Default
level is 3."
universal argument toggles maximum level of tracing (15). See
`pm-traced-functions'. Default level is 4."
(interactive "P")
(setq level (prefix-numeric-value (or level 3)))
(with-current-buffer (get-buffer-create "*Messages*")
(setq level (prefix-numeric-value (or level 4)))
(with-current-buffer (get-buffer-create "*TMessages*")
(read-only-mode -1))
(when pm--do-trace
(untrace-all))
(setq pm--do-trace (not pm--do-trace))
(if pm--do-trace
(progn (dolist (kv pm-traced-functions)
@@ -313,7 +341,6 @@ level is 3."
(dolist (fn (cadr kv))
(pm-trace fn)))))
(message "Polymode tracing activated"))
(untrace-all)
(message "Polymode tracing deactivated")))
@@ -322,7 +349,7 @@ level is 3."
"Trace function FN.
Use `untrace-function' to untrace or `untrace-all' to untrace all
currently traced functions."
(interactive (trace--read-args "Trace: "))
(interactive (trace--read-args "Trace:"))
(let ((buff (get-buffer "*Messages*")))
(unless (advice-member-p trace-advice-name fn)
(advice-add
@@ -332,11 +359,15 @@ currently traced functions."
#'pm-trace--tracing-context)))
(lambda (body &rest args)
(when (eq fn 'polymode-flush-syntax-ppss-cache)
;; waf is this?
(with-current-buffer buff
(save-excursion
(goto-char (point-max))
(insert "\n"))))
(if polymode-mode
(if (or (memq fn (nth 1 (car pm-traced-functions)))
polymode-mode
;; (derived-mode-p 'markdown-mode)
)
(apply advice body args)
(apply body args))))
`((name . ,trace-advice-name)
@@ -359,8 +390,8 @@ currently traced functions."
(defun pm-trace--tracing-context ()
(let ((span (or *span*
(get-text-property (point) :pm-span))))
(format " [%s pos:%d(%d-%d) %s%s (%f)]"
(current-buffer) (point) (point-min) (point-max)
(format " [%s pos:%d/%d(%d-%d) %s%s (%f)]"
(current-buffer) (point) (window-point) (point-min) (point-max)
(or (when span
(when (not (and (= (point-min) (nth 1 span))
(= (point-max) (nth 2 span))))
@@ -379,10 +410,14 @@ currently traced functions."
(arg)))
(defun pm-trace--fix-args-for-tracing (orig-fn fn level args context)
(let ((args (or (and (listp args)
(listp (cdr args))
(ignore-errors (mapcar #'pm-trace--fix-1-arg-for-tracing args)))
args)))
(let* ((args (or (and (listp args)
(listp (cdr args))
(ignore-errors (mapcar #'pm-trace--fix-1-arg-for-tracing args)))
args))
(print-circle t)
(sargs (format "%s" args)))
(when (> (length sargs) 200)
(setq args "[...]"))
(funcall orig-fn fn level args context)))
(advice-add #'trace-entry-message :around #'pm-trace--fix-args-for-tracing)
@@ -434,8 +469,8 @@ currently traced functions."
;;;###autoload
(defun pm-debug-relevant-variables (&optional out-type)
"Get the relevant polymode variables.
If OUT-TYPE is 'buffer, print the variables in the dedicated
buffer, if 'message issue a message, if nil just return a list of values."
If OUT-TYPE is `buffer', print the variables in the dedicated buffer,
if `message' issue a message, if nil just return a list of values."
(interactive (list 'buffer))
(let* ((cbuff (current-buffer))
(vars (cl-loop for v on pm-debug-relevant-variables by #'cddr
@@ -446,15 +481,18 @@ buffer, if 'message issue a message, if nil just return a list of values."
(require 'pp)
(cond
((eq out-type 'buffer)
(with-current-buffer (get-buffer-create "*polymode-vars*")
(erase-buffer)
(goto-char (point-max))
(insert (format "\n================== %s ===================\n" cbuff))
(insert (pp-to-string vars))
(toggle-truncate-lines -1)
(goto-char (point-max))
(view-mode)
(display-buffer (current-buffer))))
(let ((inhibit-read-only t)
(buf (get-buffer-create "*polymode-vars*")))
(with-current-buffer buf
(erase-buffer)
(goto-char (point-max))
(insert (format "\n================== %s ===================\n" cbuff))
(insert (pp-to-string vars))
(toggle-truncate-lines -1)
(goto-char (point-max))
(view-mode)
(display-buffer (current-buffer)))
(pop-to-buffer buf)))
((eq out-type 'message)
(message "%s" (pp-to-string vars)))
(t vars))))
@@ -551,7 +589,7 @@ On prefix NO-CACHE don't use cached spans."
(save-excursion
(goto-char (point-max))
(insert "\n")
(insert (apply 'format (concat "%f [%s at %d]: " msg)
(insert (apply #'format (concat "%f [%s at %d]: " msg)
(float-time) cbuf cpos args))))))
(provide 'polymode-debug)

View File

@@ -1,6 +1,6 @@
;;; polymode-export.el --- Exporting facilities for polymodes -*- lexical-binding: t -*-
;;
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;
@@ -31,6 +31,7 @@
(require 'polymode-core)
(require 'polymode-classes)
(eval-when-compile (require 'polymode-weave)) ;Silence "unknown slot from-to".
(defgroup polymode-export nil
"Polymode Exporters"
@@ -39,7 +40,6 @@
(defcustom polymode-exporter-output-file-format "%s-exported"
"Format of the exported files.
%s is substituted with the current file name sans extension."
:group 'polymode-export
:type 'string)
(defclass pm-exporter (pm-root)
@@ -442,7 +442,6 @@ for each polymode in CONFIGS."
:function 'pm-default-shell-export-function
:sentinel 'pm-default-shell-export-sentinel)
"Pandoc exporter."
:group 'polymode-export
:type 'object)
(provide 'polymode-export)

View File

@@ -1,6 +1,6 @@
;;; polymode-methods.el --- Methods for polymode classes -*- lexical-binding: t -*-
;;
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;
@@ -35,6 +35,21 @@
(cl-defgeneric pm-initialize (object)
"Initialize current buffer with OBJECT.")
(defun pm--instantiate-innermodes (config)
"Instantiate CONFIG's innermodes respecting inheritance."
(let ((inner-syms (delete-dups
(delq :inherit
(apply #'append
(pm--collect-parent-slots
config 'innermodes
(lambda (obj)
(memq :inherit
(eieio-oref obj 'innermodes)))))))))
(oset config -innermodes
(mapcar (lambda (sub-name)
(clone (symbol-value sub-name)))
inner-syms))))
(cl-defmethod pm-initialize ((config pm-polymode))
"Initialization of host buffers.
Ran by the polymode mode function."
@@ -49,7 +64,8 @@ Ran by the polymode mode function."
;; minor modes.
(host-mode (or (eieio-oref hostmode 'mode)
(oset hostmode :mode major-mode))))
;; host-mode hooks are run here, but polymode is not initialized
;; 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)
@@ -58,27 +74,13 @@ Ran by the polymode mode function."
pm/chunkmode hostmode
pm/current t
pm/type nil)
(pm--instantiate-innermodes config)
(pm--common-setup)
;; Initialize innermodes
(pm--initialize-innermodes config)
;; FIXME: must go into polymode-compat.el
(add-hook 'flyspell-incorrect-hook
'pm--flyspel-dont-highlight-in-chunkmodes nil t))
(pm--run-init-hooks hostmode 'host 'polymode-init-host-hook)))
(defun pm--initialize-innermodes (config)
(let ((inner-syms (delete-dups
(delq :inherit
(apply #'append
(pm--collect-parent-slots
config 'innermodes
(lambda (obj)
(memq :inherit
(eieio-oref obj 'innermodes)))))))))
(oset config -innermodes
(mapcar (lambda (sub-name)
(clone (symbol-value sub-name)))
inner-syms))))
(add-hook 'after-save-hook #'polymode-after-save nil t)
(add-hook 'before-save-hook #'polymode-before-save nil t))
(pm--run-init-hooks hostmode 'host 'polymode-init-host-hook)
;; (run-mode-hooks) ;; FIXME
))
(cl-defmethod pm-initialize ((chunkmode pm-inner-chunkmode) &optional type mode)
"Initialization of the innermodes' (indirect) buffers."
@@ -91,6 +93,11 @@ Ran by the polymode mode function."
post-fix)))
(new-name (generate-new-buffer-name core-name)))
(rename-buffer new-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.
;; FIXME: One severe problem is that --*- mode: poly-xyz; does not
;; currently work. See poly-noweb/samples/hello.nw.
(pm--mode-setup mode)
(pm--move-vars '(pm/polymode buffer-file-coding-system) (pm-base-buffer))
;; FIXME: This breaks if different chunkmodes use same-mode buffer. Even for
@@ -112,7 +119,10 @@ Ran by the polymode mode function."
(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'.
(funcall (eieio-oref pm/polymode '-minor-mode)))
(funcall (eieio-oref pm/polymode '-minor-mode))
;; finally run the mode's native hooks (FIXME)
;; (run-mode-hooks)
)
(defvar poly-lock-allow-fontification)
(defun pm--mode-setup (mode &optional buffer)
@@ -164,28 +174,34 @@ initialized. Return the buffer."
(object-add-to-list pm/polymode '-buffers (current-buffer))
;; INDENTATION
(setq-local pm--indent-line-function-original
(if (memq indent-line-function '(indent-relative indent-relative-maybe pm-indent-line-dispatcher))
#'pm--indent-line-basic
indent-line-function))
;; If poly-minor-mode is called twice don't overwrite the original (#289)
(unless pm--indent-line-function-original
(setq-local pm--indent-line-function-original
(if (memq indent-line-function '(nil indent-relative indent-relative-maybe))
#'pm--indent-line-basic
indent-line-function)))
(setq-local indent-line-function #'pm-indent-line-dispatcher)
(setq-local pm--indent-region-function-original
(if (memq indent-region-function '(nil indent-region-line-by-line pm-indent-region))
#'pm--indent-region-line-by-line
indent-region-function))
(unless pm--indent-region-function-original
(setq-local pm--indent-region-function-original
(if (memq indent-region-function '(nil indent-region-line-by-line))
#'pm--indent-region-line-by-line
indent-region-function)))
(setq-local indent-region-function #'pm-indent-region)
;; FILL
(setq-local pm--fill-forward-paragraph-original fill-forward-paragraph-function)
(unless pm--fill-forward-paragraph-original
(setq-local pm--fill-forward-paragraph-original fill-forward-paragraph-function))
(setq-local fill-forward-paragraph-function #'polymode-fill-forward-paragraph)
;; HOOKS
(add-hook 'kill-buffer-hook #'polymode-after-kill-fixes nil t)
(add-hook 'post-command-hook #'polymode-post-command-select-buffer nil t)
(add-hook 'pre-command-hook #'polymode-pre-command-synchronize-state nil t)
(add-hook 'pre-command-hook #'polymode-pre-command -99 t)
(add-hook 'post-command-hook #'polymode-post-command 99 t)
(add-hook 'before-change-functions #'polymode-before-change -95 t)
(add-hook 'after-change-functions #'polymode-after-change 95 t)
;; FONT LOCK (see poly-lock.el)
(setq-local font-lock-function 'poly-lock-mode)
(setq-local font-lock-function #'poly-lock-mode)
;; Font lock is a globalized minor mode and is thus initialized in
;; `after-change-major-mode-hook' within `run-mode-hooks'. As a result
;; poly-lock won't get installed if polymode is installed as a minor mode or
@@ -193,16 +209,14 @@ initialized. Return the buffer."
;; inner buffers are installed) but use `poly-lock-allow-fontification' to
;; disallow fontification in buffers which don't want font-lock (aka those
;; buffers where `turn-on-font-lock-if-desired' doesn't activate font-lock).
(turn-on-font-lock-if-desired) ; <- need this for the sake of poly-minor-modes
;; FIXME: can poly-lock-mode be used here instead?
(setq-local poly-lock-allow-fontification font-lock-mode)
;; Make sure to re-install with our font-lock-function as
;; `turn-on-font-lock-if-desired' from above might actually not call it.
(font-lock-mode t)
(font-lock-flush)
;; (font-lock-flush)
;; SYNTAX (must be done after font-lock for after-change order)
(with-no-warnings
;; [OBSOLETE as of 25.1 but we still protect it]
(pm-around-advice syntax-begin-function 'pm-override-output-position))
@@ -219,7 +233,7 @@ initialized. Return the buffer."
;; https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00500.html)
;; TODO: Consider just advising syntax-ppss-flush-cache once the above is
;; fixed in emacs.
(add-hook 'after-change-functions 'polymode-flush-syntax-ppss-cache nil t)
(add-hook 'after-change-functions #'polymode-flush-syntax-ppss-cache -99 t)
(current-buffer)))
@@ -314,7 +328,7 @@ Create and initialize the buffer if does not exist yet.")
Return a list of three elements (TYPE BEG END OBJECT) where TYPE
is a symbol representing the type of the span surrounding
POS (head, tail, body). BEG and END are the coordinates of the
span. OBJECT is a suitable object which is 'responsible' for this
span. OBJECT is a suitable object which is `responsible' for this
span. This is an object that could be dispatched upon with
`pm-select-buffer'. Should return nil if there is no SUBMODE
specific span around POS. Not to be used in programs directly;
@@ -329,7 +343,7 @@ Host modes usually do not compute spans."
(cl-defmethod pm-get-span ((chunkmode pm-inner-chunkmode) &optional pos)
"Return a list of the form (TYPE POS-START POS-END SELF).
TYPE can be 'body, 'head or 'tail. SELF is the CHUNKMODE."
TYPE can be `body', `head' or `tail'. SELF is the CHUNKMODE."
(with-slots (head-matcher tail-matcher head-mode tail-mode) chunkmode
(let ((span (pm--span-at-point head-matcher tail-matcher pos
(eieio-oref chunkmode 'can-overlap))))
@@ -353,7 +367,7 @@ TYPE can be 'body, 'head or 'tail. SELF is the CHUNKMODE."
(cl-defgeneric pm-next-chunk (chunkmode &optional pos)
"Ask the CHUNKMODE for the chunk after POS.
Return a list of three elements (CHUNKMODE HEAD-BEG HEAD-END
Return a list of five elements (CHUNKMODE HEAD-BEG HEAD-END
TAIL-BEG TAIL-END).")
(cl-defmethod pm-next-chunk (_chunkmode &optional _pos)
@@ -606,23 +620,31 @@ to indent."
(goto-char (+ (point) delta))))))
(defun pm--first-line-indent (&optional span)
(save-excursion
(let ((pos (point)))
(goto-char (nth 1 (or span (pm-innermost-span))))
;; when body starts at bol move to previous line
(when (and (= (point) (point-at-bol))
(not (bobp)))
(backward-char 1))
(skip-chars-forward " \t\n")
"Return indentation of first line if not on a first line."
(setq span (or span (pm-innermost-span)))
(let ((pos (point)))
(save-excursion
(goto-char (nth 1 span))
(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)
(- (point) (point-at-bol))))))
;; 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)))))))
;; SPAN is a body span; do nothing if narrowed to body
(defun pm--head-indent (&optional span)
(save-restriction
(widen)
(save-excursion
(let ((sbeg (nth 1 (or span (pm-innermost-span)))))
(let* ((span (or span (pm-innermost-span)))
;; span is innermost, thus can be truncated due to nested innermodes
(span (pm-get-span (nth 3 span) (nth 1 span)))
(sbeg (nth 1 span)))
(goto-char sbeg)
(backward-char 1)
(let ((head-span (pm-innermost-span)))

View File

@@ -1,9 +1,7 @@
(define-package "polymode" "20211124.913" "Extensible framework for multiple major modes"
(define-package "polymode" "20220820.1630" "Extensible framework for multiple major modes"
'((emacs "25"))
:commit "47a7b6541a1e1cea9c22052fa202b7fdb715f03b" :authors
'(("Vitalie Spinu"))
:maintainer
'("Vitalie Spinu")
:commit "63d2c2184941902e2358d0e9b0deb17b943db61a" :maintainer
'("Vitalie Spinu" . "spinuvit@gmail.com")
:keywords
'("languages" "multi-modes" "processes")
:url "https://github.com/polymode/polymode")

View File

@@ -1,6 +1,6 @@
;;; polymode-tangle.el --- Tangling facilities for polymodes (stump) -*- lexical-binding: t -*-
;;
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;

View File

@@ -1,6 +1,6 @@
;;; polymode-test-utils.el --- Testing utilities for polymode -*- lexical-binding: t -*-
;;
;; Copyright (C) 2018-2019, Vitalie Spinu
;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;
@@ -32,6 +32,7 @@
(require 'ert)
(require 'polymode)
(require 'poly-lock)
(eval-when-compile
(require 'cl-lib))
@@ -40,9 +41,7 @@
;; (add-hook 'after-change-major-mode-hook #'global-font-lock-mode-enable-in-buffers)
;; (message "ACMH: %s GFL:%s" after-change-major-mode-hook global-font-lock-mode)
(setq ert-batch-backtrace-right-margin 200)
(defvar pm-verbose (getenv "PM_VERBOSE"))
(defvar pm-verbose nil)
(defvar pm-test-current-change-set nil)
(defun pm-test-get-file (name)
"Find the file with NAME from inside a poly-xyz repo.
@@ -92,7 +91,8 @@ MODE is a quoted symbol."
(kill-buffer *buf*))
(with-current-buffer (get-buffer-create *buf*)
(insert (substring-no-properties ,string))
(funcall ,mode)
(let ((inhibit-message (not pm-verbose)))
(funcall ,mode))
(setq-default indent-tabs-mode nil)
;; In emacs 27 this is called from run-mode-hooks
(and (bound-and-true-p syntax-propertize-function)
@@ -152,12 +152,11 @@ MODE is a quoted symbol."
(remove-hook 'text-mode-hook 'flyspell-mode) ;; triggers "too much reentrancy" error
(let ((inhibit-message (not pm-verbose)))
(funcall-interactively ',mode))
;; (flyspell-mode -1) ;; triggers "too much reentrancy" error
(hack-local-variables 'ignore-mode)
(goto-char (point-min))
,pre-form
;; FIXME: figure this mambo-jumbo
;; need this to activate all chunks
(font-lock-ensure)
(goto-char (point-min))
(save-excursion
(let ((font-lock-mode t))
@@ -175,7 +174,8 @@ MODE is a quoted symbol."
;; fontification in X either (waf?)
(add-hook 'after-change-functions #'pm-test-invoke-fontification t t))
(point-min) (point-max))))
(font-lock-ensure)
;; (font-lock-flush)
;; (font-lock-ensure)
,@body
(current-buffer)))))
@@ -258,6 +258,8 @@ MODE is a quoted symbol."
ALLOW-FAILED-FACES should be a list of faces on which failures
are OK."
(save-excursion
(font-lock-flush)
(font-lock-ensure)
(pm-map-over-spans
(lambda (span) (pm-test-span-faces span allow-failed-faces)))))
@@ -346,6 +348,7 @@ execution undo is called once. After each change-set
`(kill-buffer
(pm-test-run-on-file ,mode ,file
(pm-test-faces)
(set-buffer-modified-p nil)
(dolist (cset ',change-sets)
(let ((poly-lock-defer-after-change nil)
(pm-test-current-change-set (caar cset)))
@@ -356,7 +359,8 @@ execution undo is called once. After each change-set
(undo-boundary)
(pm-test-faces)
(let ((inhibit-message (not pm-verbose)))
(undo)))))))
(when (buffer-modified-p)
(undo))))))))
(defun pm-test--run-indentation-tests ()
"Run an automatic batch of indentation tests.
@@ -440,7 +444,8 @@ points."
(defmacro pm-test-map-over-modes (mode file)
`(pm-test-run-on-file ,mode ,file
(let ((beg (point-min))
(end (point-max)))
(end (point-max))
(pm-use-cache t))
(with-buffer-prepared-for-poly-lock
(remove-text-properties beg end '(:pm-span :pm-face)))
(pm-map-over-modes (lambda (b e)) beg end)

View File

@@ -1,6 +1,6 @@
;;; polymode-weave.el --- Weaving facilities for polymodes -*- lexical-binding: t -*-
;;
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; URL: https://github.com/polymode/polymode
;;
@@ -38,7 +38,6 @@
(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)

View File

@@ -1,8 +1,8 @@
;;; polymode.el --- Extensible framework for multiple major modes -*- lexical-binding: t -*-
;;
;; Author: Vitalie Spinu
;; Maintainer: Vitalie Spinu
;; Copyright (C) 2013-2019, Vitalie Spinu
;; Maintainer: Vitalie Spinu <spinuvit@gmail.com>
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Version: 0.2.2
;; Package-Requires: ((emacs "25"))
;; URL: https://github.com/polymode/polymode
@@ -56,22 +56,22 @@ Not effective after loading the polymode library.")
;; eval
(define-key map "v" 'polymode-eval-map)
;; navigation
(define-key map "\C-n" 'polymode-next-chunk)
(define-key map "\C-p" 'polymode-previous-chunk)
(define-key map "\C-\M-n" 'polymode-next-chunk-same-type)
(define-key map "\C-\M-p" 'polymode-previous-chunk-same-type)
(define-key map "\C-n" #'polymode-next-chunk)
(define-key map "\C-p" #'polymode-previous-chunk)
(define-key map "\C-\M-n" #'polymode-next-chunk-same-type)
(define-key map "\C-\M-p" #'polymode-previous-chunk-same-type)
;; chunk manipulation
(define-key map "\M-k" 'polymode-kill-chunk)
(define-key map "\M-m" 'polymode-mark-or-extend-chunk)
(define-key map "\C-t" 'polymode-toggle-chunk-narrowing)
(define-key map "\M-k" #'polymode-kill-chunk)
(define-key map "\M-m" #'polymode-mark-or-extend-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 "$" 'polymode-show-process-buffer)
(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 "$" #'polymode-show-process-buffer)
map)
"Polymode prefix map.
Lives on `polymode-prefix-key' in polymode buffers.")
@@ -520,6 +520,7 @@ most frequently used slots are:
:innermodes List of symbols pointing to `pm-inner-chunkmode'
objects which specify the behavior of inner modes (or submodes)."
(declare
(indent defun)
(doc-string 3)
(debug (&define name
[&optional [&not keywordp] name]
@@ -657,7 +658,7 @@ most frequently used slots are:
(define-minor-mode polymode-minor-mode
"Polymode minor mode, used to make everything work."
nil " PM")
:lighter " PM")
(define-derived-mode poly-head-tail-mode prog-mode "HeadTail"
"Default major mode for polymode head and tail spans."