From 044960ead25e5e7a9da9ebcd2103e39d4142e1e4 Mon Sep 17 00:00:00 2001 From: Ken Manheimer Date: Sun, 5 Jul 2020 16:27:52 -0400 Subject: [PATCH 1/5] Backport: Fix allout-widgets-mode handling of edits to item cue, fixing (bug#11312) * lisp/allout-widgets.el (allout-decorate-item-cue): Properly decorate item cue span. (allout-setup-text-properties): use allout-graphics-modification-handler as allout-cue-span-category modification hook. (cherry picked from commit 8e13d332481551e4c8c1c66dd0c69dd09256dffc) --- lisp/allout-widgets.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index fbdddca7d76..3c6a05cbbce 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -677,7 +677,7 @@ outline hot-spot navigation (see `allout-mode')." (setplist 'allout-cue-span-category nil) (put 'allout-cue-span-category 'evaporate t) (put 'allout-cue-span-category - 'modification-hooks '(allout-body-modification-handler)) + 'modification-hooks '(allout-graphics-modification-handler)) (put 'allout-cue-span-category 'local-map allout-cue-span-keymap) (put 'allout-cue-span-category 'mouse-face widget-button-face) (put 'allout-cue-span-category 'pointer 'arrow) @@ -1994,8 +1994,7 @@ reapplying this method will rectify the glyphs." ;; NOTE: most of the cue-area (when (not (widget-get item-widget :is-container)) - (let* ((cue-start (or (widget-get item-widget :distinctive-end) - (widget-get item-widget :icon-end))) + (let* ((cue-start (widget-get item-widget :icon-end)) (body-start (widget-get item-widget :body-start)) ;(expanded (widget-get item-widget :expanded)) ;(has-subitems (widget-get item-widget :has-subitems)) From 3071cecda070b0a4808eeca8009a5dc088606ec6 Mon Sep 17 00:00:00 2001 From: Ken Manheimer Date: Mon, 6 Jul 2020 14:18:57 -0400 Subject: [PATCH 2/5] Backport: Don't let item decoration be disrupted by too-shallow items. * lisp/allout-widgets.el (allout-decorate-item-and-context): Check for parent-position having value before using it. Also, shift local emacs vars topic deeper so it doesn't constitute an instance of that particular aberrant case. (cherry picked from commit 8684216542889fa57daa32072104afc69785907f) --- lisp/allout-widgets.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 3c6a05cbbce..e7750b3606e 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -1594,7 +1594,10 @@ We return the item-widget corresponding to the item at point." (if is-container (progn (widget-put item-widget :is-container t) (setq reverse-siblings-chart (list 1))) - (goto-char (widget-apply parent :actual-position :from)) + (let ((parent-position (widget-apply parent + :actual-position :from))) + (when parent-position + (goto-char parent-position))) (if (widget-get parent :is-container) ;; `allout-goto-prefix' will go to first non-container item: (allout-goto-prefix) @@ -2388,7 +2391,7 @@ The elements of LIST are not copied, just the list structure itself." ;;;_ : provide (provide 'allout-widgets) -;;;_. Local emacs vars. -;;;_ , Local variables: -;;;_ , allout-layout: (-1 : 0) -;;;_ , End: +;;;_ . Local emacs vars. +;;;_ , Local variables: +;;;_ , allout-layout: (-1 : 0) +;;;_ , End: From 2035ecca578f3cbcc96c314e16e21be51ddea98d Mon Sep 17 00:00:00 2001 From: Ken Manheimer Date: Mon, 6 Jul 2020 13:19:11 -0400 Subject: [PATCH 3/5] Backport: Provide missing let definition to prevent background void-variable error. * lisp/allout-widgets.el (allout-widgets-exposure-change-processor) Let-declare handled-conceal, for reference through `(symbol-value)' within the let body. (Because the error happens in an after-change-functions hook, so it is caught and reported as a message by allout-widgets-hook-error-handler.) (cherry picked from commit 3c410b6b4753e02269bb36914e7534eb124150dd) --- lisp/allout-widgets.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index e7750b3606e..64f2ba500d9 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -988,6 +988,7 @@ Generally invoked via `allout-exposure-change-functions'." ;; have to distinguish between concealing and exposing so that, eg, ;; `allout-expose-topic's mix is handled properly. handled-expose + handled-conceal covered deactivate-mark) From 82742e295d2907bb2f56090296f7a128f1f3d6aa Mon Sep 17 00:00:00 2001 From: Ken Manheimer Date: Tue, 7 Jul 2020 10:32:03 -0400 Subject: [PATCH 4/5] Backport: Resolve missing button-region keymap bindings. * lisp/allout-widgets.el (allout-item-icon-keymap, allout-item-body-keymap, allout-cue-span-keymap, allout-widgets-mode): Inherit from both (current-local-map) and (current-global-map). This provides for missing global bindings when inheriting from just (current-local-map), eg Esc-<. (cherry picked from commit dd7c191291c8eb1afeac0f1512745491c5c7a317) --- lisp/allout-widgets.el | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 64f2ba500d9..5460551106b 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -415,15 +415,17 @@ not altered with an escape sequence.") ;;;_ , Widget element formatting ;;;_ = allout-item-icon-keymap (defvar allout-item-icon-keymap - (let ((km (make-sparse-keymap))) + (let ((km (make-sparse-keymap)) + (as-parent (if (current-local-map) + (make-composed-keymap (current-local-map) + (current-global-map)) + (current-global-map)))) + ;; The keymap parent is reset on the each local var when mode starts. + (set-keymap-parent km as-parent) (dolist (digit '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")) (define-key km digit 'digit-argument)) (define-key km "-" 'negative-argument) -;; (define-key km [(return)] 'allout-tree-expand-command) -;; (define-key km [(meta return)] 'allout-toggle-torso-command) -;; (define-key km [(down-mouse-1)] 'allout-item-button-click) -;; (define-key km [(down-mouse-2)] 'allout-toggle-torso-event-command) ;; Override underlying mouse-1 and mouse-2 bindings in icon territory: (define-key km [(mouse-1)] (lambda () (interactive) nil)) (define-key km [(mouse-2)] (lambda () (interactive) nil)) @@ -433,17 +435,16 @@ not altered with an escape sequence.") km) "General tree-node key bindings.") +(make-variable-buffer-local 'allout-item-icon-keymap) ;;;_ = allout-item-body-keymap (defvar allout-item-body-keymap (let ((km (make-sparse-keymap)) - (local-map (current-local-map))) -;; (define-key km [(control return)] 'allout-tree-expand-command) -;; (define-key km [(meta return)] 'allout-toggle-torso-command) - ;; XXX We need to reset this per buffer's mode; we do so in - ;; allout-widgets-mode. - (if local-map - (set-keymap-parent km local-map)) - + (as-parent (if (current-local-map) + (make-composed-keymap (current-local-map) + (current-global-map)) + (current-global-map)))) + ;; The keymap parent is reset on the each local var when mode starts. + (set-keymap-parent km as-parent) km) "General key bindings for the text content of outline items.") (make-variable-buffer-local 'allout-item-body-keymap) @@ -456,6 +457,7 @@ not altered with an escape sequence.") (set-keymap-parent km allout-item-icon-keymap) km) "Keymap used in the item cue area - the space between the icon and headline.") +(make-variable-buffer-local 'allout-cue-span-keymap) ;;;_ = allout-escapes-category (defvar allout-escapes-category nil "Symbol for category of text property used to hide escapes of prefix-like @@ -566,8 +568,13 @@ outline hot-spot navigation (see `allout-mode')." (add-to-invisibility-spec '(allout-torso . t)) (add-to-invisibility-spec 'allout-escapes) - (if (current-local-map) - (set-keymap-parent allout-item-body-keymap (current-local-map))) + (let ((as-parent (if (current-local-map) + (make-composed-keymap (current-local-map) + (current-global-map)) + (current-global-map)))) + (set-keymap-parent allout-item-body-keymap as-parent) + ;; allout-cue-span-keymap uses allout-item-icon-keymap as parent. + (set-keymap-parent allout-item-icon-keymap as-parent)) (add-hook 'allout-exposure-change-functions 'allout-widgets-exposure-change-recorder nil 'local) From bc10e467f1c2b885637ef734afc331e6b2127373 Mon Sep 17 00:00:00 2001 From: Ken Manheimer Date: Sun, 5 Jul 2020 16:38:13 -0400 Subject: [PATCH 5/5] Backport: Rectify allout-widgets region undecoration so item at start is not missed. * lisp/allout-widgets.el (allout-widgets-undecorate-region): Reorganize the loop so an item at the start is not skipped. (cherry picked from commit 33d85cb768b40794bffcd9ab22fbdec1211a74e5) --- lisp/allout-widgets.el | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 5460551106b..2a8dced5e9c 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -2060,19 +2060,22 @@ Optional FORCE means force reassignment of the region property." ;;;_ > allout-widgets-undecorate-region (start end) (defun allout-widgets-undecorate-region (start end) "Eliminate widgets and decorations for all items in region from START to END." - (let ((next start) - widget) + (let (done next widget + (end (or end (point-max)))) (save-excursion (goto-char start) - (while (< (setq next (next-single-char-property-change next - 'display - (current-buffer) - end)) - end) - (goto-char next) - (when (setq widget (allout-get-item-widget)) - ;; if the next-property/overly progression got us to a widget: - (allout-widgets-undecorate-item widget t)))))) + (while (not done) + (when (and (allout-on-current-heading-p) + (setq widget (allout-get-item-widget))) + (if widget + (allout-widgets-undecorate-item widget t))) + (goto-char (setq next + (next-single-char-property-change (point) + 'display + (current-buffer) + end))) + (if (>= next end) + (setq done t)))))) ;;;_ > allout-widgets-undecorate-text (text) (defun allout-widgets-undecorate-text (text) "Eliminate widgets and decorations for all items in TEXT."