aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuri Linkov2022-09-20 19:11:58 +0300
committerJuri Linkov2022-09-20 19:11:58 +0300
commitcefda4a6c521a01b031f5e94a31473a91d06eaea (patch)
tree510c0e5c0dca32fa009258646b8491ccf341b321
parent120ade62cd26dd502f1ae3784079e4cd88607a0b (diff)
downloademacs-cefda4a6c521a01b031f5e94a31473a91d06eaea.tar.gz
emacs-cefda4a6c521a01b031f5e94a31473a91d06eaea.zip
* lisp/outline.el: Bind margin mouse event to cycle outlines (bug#57813)
(outline-minor-mode): In mode keymap bind 'right/left-margin mouse-1' to outline-cycle, and 'right/left-margin S-mouse-1' to outline-cycle-buffer. (outline-hide-subtree, outline-show-subtree): Add save-excursion to keep point unmoved after mouse click. (outline-cycle): Add optional arg 'event' like in outline-hide-subtree and outline-show-subtree, and add save-excursion to keep point unmoved after mouse click. (outline--make-button-overlay, outline--make-margin-overlay): Put overlay property 'evaporate' to t. (outline--insert-open-button, outline--insert-close-button): Remove temporary attempts to bind margin-local mouse events.
-rw-r--r--lisp/outline.el82
1 files changed, 42 insertions, 40 deletions
diff --git a/lisp/outline.el b/lisp/outline.el
index 3aebc25e130..3503ba2265e 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -490,6 +490,10 @@ See the command `outline-mode' for more information on this mode."
490 :keymap (define-keymap 490 :keymap (define-keymap
491 :parent outline-minor-mode-cycle-map 491 :parent outline-minor-mode-cycle-map
492 "<menu-bar>" outline-minor-mode-menu-bar-map 492 "<menu-bar>" outline-minor-mode-menu-bar-map
493 "<left-margin> <mouse-1>" 'outline-cycle
494 "<right-margin> <mouse-1>" 'outline-cycle
495 "<left-margin> S-<mouse-1>" 'outline-cycle-buffer
496 "<right-margin> S-<mouse-1>" 'outline-cycle-buffer
493 (key-description outline-minor-mode-prefix) outline-mode-prefix-map) 497 (key-description outline-minor-mode-prefix) outline-mode-prefix-map)
494 (if outline-minor-mode 498 (if outline-minor-mode
495 (progn 499 (progn
@@ -1051,9 +1055,10 @@ Note that this does not hide the lines preceding the first heading line."
1051 "Hide everything after this heading at deeper levels. 1055 "Hide everything after this heading at deeper levels.
1052If non-nil, EVENT should be a mouse event." 1056If non-nil, EVENT should be a mouse event."
1053 (interactive (list last-nonmenu-event)) 1057 (interactive (list last-nonmenu-event))
1054 (when (mouse-event-p event) 1058 (save-excursion
1055 (mouse-set-point event)) 1059 (when (mouse-event-p event)
1056 (outline-flag-subtree t)) 1060 (mouse-set-point event))
1061 (outline-flag-subtree t)))
1057 1062
1058(defun outline--make-button-overlay (type) 1063(defun outline--make-button-overlay (type)
1059 (let ((o (seq-find (lambda (o) 1064 (let ((o (seq-find (lambda (o)
@@ -1061,6 +1066,7 @@ If non-nil, EVENT should be a mouse event."
1061 (overlays-at (point))))) 1066 (overlays-at (point)))))
1062 (unless o 1067 (unless o
1063 (setq o (make-overlay (point) (1+ (point)))) 1068 (setq o (make-overlay (point) (1+ (point))))
1069 (overlay-put o 'evaporate t)
1064 (overlay-put o 'follow-link 'mouse-face) 1070 (overlay-put o 'follow-link 'mouse-face)
1065 (overlay-put o 'mouse-face 'highlight) 1071 (overlay-put o 'mouse-face 'highlight)
1066 (overlay-put o 'outline-button t)) 1072 (overlay-put o 'outline-button t))
@@ -1088,8 +1094,7 @@ If non-nil, EVENT should be a mouse event."
1088 (overlays-at (point))))) 1094 (overlays-at (point)))))
1089 (unless o 1095 (unless o
1090 (setq o (make-overlay (point) (1+ (point)))) 1096 (setq o (make-overlay (point) (1+ (point))))
1091 (overlay-put o 'follow-link 'mouse-face) 1097 (overlay-put o 'evaporate t)
1092 (overlay-put o 'mouse-face 'highlight)
1093 (overlay-put o 'outline-margin t)) 1098 (overlay-put o 'outline-margin t))
1094 (let ((icon (icon-elements (if (eq type 'close) 1099 (let ((icon (icon-elements (if (eq type 'close)
1095 (if outline--use-rtl 1100 (if outline--use-rtl
@@ -1111,11 +1116,7 @@ If non-nil, EVENT should be a mouse event."
1111 (save-excursion 1116 (save-excursion
1112 (beginning-of-line) 1117 (beginning-of-line)
1113 (if use-margins 1118 (if use-margins
1114 (let ((o (outline--make-margin-overlay 'open))) 1119 (outline--make-margin-overlay 'open)
1115 (overlay-put o 'help-echo "Click to hide")
1116 (overlay-put o 'keymap
1117 (define-keymap
1118 "<mouse-2>" #'outline-hide-subtree)))
1119 (when (derived-mode-p 'special-mode) 1120 (when (derived-mode-p 'special-mode)
1120 (let ((inhibit-read-only t)) 1121 (let ((inhibit-read-only t))
1121 (insert " ") 1122 (insert " ")
@@ -1125,19 +1126,14 @@ If non-nil, EVENT should be a mouse event."
1125 (overlay-put o 'keymap 1126 (overlay-put o 'keymap
1126 (define-keymap 1127 (define-keymap
1127 "RET" #'outline-hide-subtree 1128 "RET" #'outline-hide-subtree
1128 "<mouse-2>" #'outline-hide-subtree 1129 "<mouse-2>" #'outline-hide-subtree)))))))
1129 "<left-margin> <mouse-1>" #'outline-hide-subtree)))))))
1130 1130
1131(defun outline--insert-close-button (&optional use-margins) 1131(defun outline--insert-close-button (&optional use-margins)
1132 (with-silent-modifications 1132 (with-silent-modifications
1133 (save-excursion 1133 (save-excursion
1134 (beginning-of-line) 1134 (beginning-of-line)
1135 (if use-margins 1135 (if use-margins
1136 (let ((o (outline--make-margin-overlay 'close))) 1136 (outline--make-margin-overlay 'close)
1137 (overlay-put o 'help-echo "Click to show")
1138 (overlay-put o 'keymap
1139 (define-keymap
1140 "<mouse-2>" #'outline-show-subtree)))
1141 (when (derived-mode-p 'special-mode) 1137 (when (derived-mode-p 'special-mode)
1142 (let ((inhibit-read-only t)) 1138 (let ((inhibit-read-only t))
1143 (insert " ") 1139 (insert " ")
@@ -1147,8 +1143,7 @@ If non-nil, EVENT should be a mouse event."
1147 (overlay-put o 'keymap 1143 (overlay-put o 'keymap
1148 (define-keymap 1144 (define-keymap
1149 "RET" #'outline-show-subtree 1145 "RET" #'outline-show-subtree
1150 "<mouse-2>" #'outline-show-subtree 1146 "<mouse-2>" #'outline-show-subtree)))))))
1151 "<left-margin> <mouse-1>" #'outline-show-subtree)))))))
1152 1147
1153(defun outline--fix-up-all-buttons (&optional from to) 1148(defun outline--fix-up-all-buttons (&optional from to)
1154 (when (or outline--use-buttons outline--use-margins) 1149 (when (or outline--use-buttons outline--use-margins)
@@ -1182,11 +1177,13 @@ If non-nil, EVENT should be a mouse event."
1182(define-obsolete-function-alias 'hide-leaves #'outline-hide-leaves "25.1") 1177(define-obsolete-function-alias 'hide-leaves #'outline-hide-leaves "25.1")
1183 1178
1184(defun outline-show-subtree (&optional event) 1179(defun outline-show-subtree (&optional event)
1185 "Show everything after this heading at deeper levels." 1180 "Show everything after this heading at deeper levels.
1181If non-nil, EVENT should be a mouse event."
1186 (interactive (list last-nonmenu-event)) 1182 (interactive (list last-nonmenu-event))
1187 (when (mouse-event-p event) 1183 (save-excursion
1188 (mouse-set-point event)) 1184 (when (mouse-event-p event)
1189 (outline-flag-subtree nil)) 1185 (mouse-set-point event))
1186 (outline-flag-subtree nil)))
1190 1187
1191(define-obsolete-function-alias 'show-subtree #'outline-show-subtree "25.1") 1188(define-obsolete-function-alias 'show-subtree #'outline-show-subtree "25.1")
1192 1189
@@ -1661,7 +1658,7 @@ Return either `hide-all', `headings-only', or `show-all'."
1661 (< (save-excursion (outline-next-heading) (point)) 1658 (< (save-excursion (outline-next-heading) (point))
1662 (save-excursion (outline-end-of-subtree) (point))))) 1659 (save-excursion (outline-end-of-subtree) (point)))))
1663 1660
1664(defun outline-cycle () 1661(defun outline-cycle (&optional event)
1665 "Cycle visibility state of the current heading line's body. 1662 "Cycle visibility state of the current heading line's body.
1666 1663
1667This cycles the visibility of the current heading line's subheadings 1664This cycles the visibility of the current heading line's subheadings
@@ -1669,23 +1666,28 @@ and body between `hide all', `headings only' and `show all'.
1669 1666
1670`Hide all' means hide all the subheadings and their bodies. 1667`Hide all' means hide all the subheadings and their bodies.
1671`Headings only' means show the subheadings, but not their bodies. 1668`Headings only' means show the subheadings, but not their bodies.
1672`Show all' means show all the subheadings and their bodies." 1669`Show all' means show all the subheadings and their bodies.
1673 (interactive) 1670
1674 (condition-case nil 1671If non-nil, EVENT should be a mouse event."
1675 (pcase (outline--cycle-state) 1672 (interactive (list last-nonmenu-event))
1676 ('hide-all 1673 (save-excursion
1677 (if (outline-has-subheading-p) 1674 (when (mouse-event-p event)
1678 (progn (outline-show-children) 1675 (mouse-set-point event))
1679 (message "Only headings")) 1676 (condition-case nil
1677 (pcase (outline--cycle-state)
1678 ('hide-all
1679 (if (outline-has-subheading-p)
1680 (progn (outline-show-children)
1681 (message "Only headings"))
1682 (outline-show-subtree)
1683 (message "Show all")))
1684 ('headings-only
1680 (outline-show-subtree) 1685 (outline-show-subtree)
1681 (message "Show all"))) 1686 (message "Show all"))
1682 ('headings-only 1687 ('show-all
1683 (outline-show-subtree) 1688 (outline-hide-subtree)
1684 (message "Show all")) 1689 (message "Hide all")))
1685 ('show-all 1690 (outline-before-first-heading nil))))
1686 (outline-hide-subtree)
1687 (message "Hide all")))
1688 (outline-before-first-heading nil)))
1689 1691
1690(defvar-local outline--cycle-buffer-state 'show-all 1692(defvar-local outline--cycle-buffer-state 'show-all
1691 "Internal variable used for tracking buffer cycle state.") 1693 "Internal variable used for tracking buffer cycle state.")