procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/outline.el: Pre-compute some frequent data for button icons (bug#57813)

Browse source 
(outline--button-icons): New buffer-local variable.
(outline-minor-mode): Set outline--button-icons.
Unify overlay name 'outline-margin' with 'outline-button'.
(outline--make-button-overlay, outline--make-margin-overlay)
(outline--insert-open-button, outline--insert-close-button): Remove functions.
(outline--create-button-icons, outline--insert-button): New functions
with code refactored from old functions.  Add more support for icon faces.
(outline--fix-up-all-buttons): Use outline--insert-button.
(outline--fix-buttons-after-change): Unify overlay name
'outline-margin' with 'outline-button'.

* lisp/minibuffer.el (completions-group-separator): Change face
attribute :strike-through to :underline.
This commit is contained in:
Juri Linkov 2022-10-23 19:54:31 +03:00
parent a01bd1a208
commit f7816c94b6
2 changed files with 80 additions and 98 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lisp/minibuffer.el
View file

@ -1237,7 +1237,7 @@ pair of a group title string and a list of group candidate strings."
:version "28.1") :version "28.1")
(defface completions-group-separator (defface completions-group-separator
'((t :inherit shadow :strike-through t)) '((t :inherit shadow :underline t))
"Face used for the separator lines between the candidate groups." "Face used for the separator lines between the candidate groups."
:version "28.1") :version "28.1")

176
lisp/outline.el
View file

@ -299,6 +299,9 @@ don't modify the buffer."
:safe #'symbolp :safe #'symbolp
:version "29.1") :version "29.1")
(defvar-local outline--button-icons nil
"A list of pre-computed button icons.")
(defvar-local outline--use-rtl nil (defvar-local outline--use-rtl nil
"Non-nil when direction of clickable buttons is right-to-left.") "Non-nil when direction of clickable buttons is right-to-left.")
@ -503,6 +506,7 @@ See the command `outline-mode' for more information on this mode."
#'outline--fix-buttons-after-change nil t) #'outline--fix-buttons-after-change nil t)
(when (eq (current-bidi-paragraph-direction) 'right-to-left) (when (eq (current-bidi-paragraph-direction) 'right-to-left)
(setq-local outline--use-rtl t)) (setq-local outline--use-rtl t))
(setq-local outline--button-icons (outline--create-button-icons))
(when (eq outline-minor-mode-use-buttons 'in-margins) (when (eq outline-minor-mode-use-buttons 'in-margins)
(if outline--use-rtl (if outline--use-rtl
(setq-local right-margin-width (1+ right-margin-width)) (setq-local right-margin-width (1+ right-margin-width))
@ -537,9 +541,8 @@ See the command `outline-mode' for more information on this mode."
(font-lock-flush) (font-lock-flush)
(remove-overlays nil nil 'outline-highlight t)) (remove-overlays nil nil 'outline-highlight t))
(when outline-minor-mode-use-buttons (when outline-minor-mode-use-buttons
(if (not (eq outline-minor-mode-use-buttons 'in-margins)) (remove-overlays nil nil 'outline-button t)
(remove-overlays nil nil 'outline-button t) (when (eq outline-minor-mode-use-buttons 'in-margins)
(remove-overlays nil nil 'outline-margin t)
(if outline--use-rtl (if outline--use-rtl
(setq-local right-margin-width (1- right-margin-width)) (setq-local right-margin-width (1- right-margin-width))
(setq-local left-margin-width (1- left-margin-width))) (setq-local left-margin-width (1- left-margin-width)))
@ -1638,95 +1641,76 @@ With a prefix argument, show headings up to that LEVEL."
;;; Button/margin indicators ;;; Button/margin indicators
(defun outline--make-button-overlay (type) (defun outline--create-button-icons ()
(let ((o (seq-find (lambda (o) (pcase outline-minor-mode-use-buttons
(overlay-get o 'outline-button)) ('in-margins
(overlays-at (point))))) (mapcar
(unless o (lambda (icon-name)
(setq o (make-overlay (point) (1+ (point)))) (let* ((icon (icon-elements icon-name))
(overlay-put o 'evaporate t) (face (plist-get icon 'face))
(overlay-put o 'follow-link 'mouse-face) (string (plist-get icon 'string))
(overlay-put o 'mouse-face 'highlight) (image (plist-get icon 'image))
(overlay-put o 'keymap (display `((margin ,(if outline--use-rtl
(define-keymap 'right-margin 'left-margin))
"RET" #'outline-cycle ,(or image (if face (propertize
"<mouse-2>" #'outline-cycle)) string 'face face)
(overlay-put o 'outline-button t)) string))))
(let ((icon (icon-elements (if (eq type 'close) (space (propertize " " 'display display)))
(if outline--use-rtl (if (and image face) (propertize space 'face face) space)))
'outline-close-rtl (list 'outline-open-in-margins
'outline-close) (if outline--use-rtl
'outline-open)))) 'outline-close-rtl-in-margins
;; In editing buffers we use overlays only, but in other buffers 'outline-close-in-margins))))
;; we use a mix of text properties, text and overlays to make ('insert
;; movement commands work more logically. (mapcar
(if (eq outline-minor-mode-use-buttons 'insert) (lambda (icon-name)
(let ((inhibit-read-only t)) (icon-elements icon-name))
(put-text-property (point) (1+ (point)) 'face (plist-get icon 'face)) (list 'outline-open
(if-let ((image (plist-get icon 'image))) (if outline--use-rtl 'outline-close-rtl 'outline-close))))
(overlay-put o 'display image) (_
(overlay-put o 'display (concat (plist-get icon 'string) (mapcar
(string (char-after (point))))) (lambda (icon-name)
(overlay-put o 'face (plist-get icon 'face)))) (propertize (icon-string icon-name)
(overlay-put 'mouse-face 'default
o 'before-string 'follow-link 'mouse-face
(propertize " " 'keymap (define-keymap "<mouse-2>" #'outline-cycle)))
'display (list 'outline-open
(or (plist-get icon 'image) (if outline--use-rtl 'outline-close-rtl 'outline-close))))))
(plist-get icon 'string))))))
o))
(defun outline--make-margin-overlay (type) (defun outline--insert-button (type)
(let ((o (seq-find (lambda (o)
(overlay-get o 'outline-margin))
(overlays-at (point)))))
(unless o
(setq o (make-overlay (point) (1+ (point))))
(overlay-put o 'evaporate t)
(overlay-put o 'keymap
(define-keymap
"RET" #'outline-cycle
"<mouse-2>" #'outline-cycle))
(overlay-put o 'outline-margin t))
(let ((icon (icon-elements (if (eq type 'close)
(if outline--use-rtl
'outline-close-rtl-in-margins
'outline-close-in-margins)
'outline-open-in-margins))))
(overlay-put
o 'before-string
(propertize " " 'display
`((margin ,(if outline--use-rtl
'right-margin 'left-margin))
,(or (plist-get icon 'image)
(plist-get icon 'string))))))
o))
(defun outline--insert-open-button ()
(with-silent-modifications (with-silent-modifications
(save-excursion (save-excursion
(beginning-of-line) (beginning-of-line)
(if (eq outline-minor-mode-use-buttons 'in-margins) (let ((icon (nth (if (eq type 'close) 1 0) outline--button-icons))
(outline--make-margin-overlay 'open) (o (seq-find (lambda (o) (overlay-get o 'outline-button))
(when (eq outline-minor-mode-use-buttons 'insert) (overlays-at (point)))))
(let ((inhibit-read-only t)) (unless o
(insert " ") (when (eq outline-minor-mode-use-buttons 'insert)
(beginning-of-line))) (let ((inhibit-read-only t))
(let ((o (outline--make-button-overlay 'open))) (insert " ")
(overlay-put o 'help-echo "Click to hide")))))) (beginning-of-line)))
(setq o (make-overlay (point) (1+ (point))))
(defun outline--insert-close-button () (overlay-put o 'outline-button t)
(with-silent-modifications (overlay-put o 'evaporate t))
(save-excursion (pcase outline-minor-mode-use-buttons
(beginning-of-line) ('insert
(if (eq outline-minor-mode-use-buttons 'in-margins) (overlay-put o 'display (or (plist-get icon 'image)
(outline--make-margin-overlay 'close) (plist-get icon 'string)))
(when (eq outline-minor-mode-use-buttons 'insert) (overlay-put o 'face (plist-get icon 'face))
(let ((inhibit-read-only t)) (overlay-put o 'follow-link 'mouse-face)
(insert " ") (overlay-put o 'mouse-face 'highlight)
(beginning-of-line))) (overlay-put o 'keymap (define-keymap
(let ((o (outline--make-button-overlay 'close))) "RET" #'outline-cycle
(overlay-put o 'help-echo "Click to show")))))) "<mouse-2>" #'outline-cycle))
(overlay-put o 'help-echo (if (eq type 'close)
"Click to show"
"Click to hide")))
('in-margins
(overlay-put o 'before-string icon)
(overlay-put o 'keymap (define-keymap "RET" #'outline-cycle)))
(_
(overlay-put o 'before-string icon)
(overlay-put o 'keymap (define-keymap "RET" #'outline-cycle))))))))
(defun outline--fix-up-all-buttons (&optional from to) (defun outline--fix-up-all-buttons (&optional from to)
(when outline-minor-mode-use-buttons (when outline-minor-mode-use-buttons
@ -1736,21 +1720,19 @@ With a prefix argument, show headings up to that LEVEL."
(setq from (line-beginning-position)))) (setq from (line-beginning-position))))
(outline-map-region (outline-map-region
(lambda () (lambda ()
(if (save-excursion (let ((close-p (save-excursion
(outline-end-of-heading) (outline-end-of-heading)
(seq-some (lambda (o) (eq (overlay-get o 'invisible) 'outline)) (seq-some (lambda (o) (eq (overlay-get o 'invisible)
(overlays-at (point)))) 'outline))
(outline--insert-close-button) (overlays-at (point))))))
(outline--insert-open-button))) (outline--insert-button (if close-p 'close 'open))))
(or from (point-min)) (or to (point-max))))) (or from (point-min)) (or to (point-max)))))
(defun outline--fix-buttons-after-change (beg end _len) (defun outline--fix-buttons-after-change (beg end _len)
;; Handle whole lines ;; Handle whole lines
(save-excursion (goto-char beg) (setq beg (pos-bol))) (save-excursion (goto-char beg) (setq beg (pos-bol)))
(save-excursion (goto-char end) (setq end (pos-eol))) (save-excursion (goto-char end) (setq end (pos-eol)))
(if (not (eq outline-minor-mode-use-buttons 'in-margins)) (remove-overlays beg end 'outline-button t)
(remove-overlays beg end 'outline-button t)
(remove-overlays beg end 'outline-margin t))
(outline--fix-up-all-buttons beg end)) (outline--fix-up-all-buttons beg end))