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")

158
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)
(remove-overlays nil nil 'outline-margin t) (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))
(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)
'outline-open))))
;; In editing buffers we use overlays only, but in other buffers
;; we use a mix of text properties, text and overlays to make
;; movement commands work more logically.
(if (eq outline-minor-mode-use-buttons 'insert)
(let ((inhibit-read-only t))
(put-text-property (point) (1+ (point)) 'face (plist-get icon 'face))
(if-let ((image (plist-get icon 'image)))
(overlay-put o 'display image)
(overlay-put o 'display (concat (plist-get icon 'string)
(string (char-after (point)))))
(overlay-put o 'face (plist-get icon 'face))))
(overlay-put
o 'before-string
(propertize " "
'display
(or (plist-get icon 'image)
(plist-get icon 'string))))))
o))
(defun outline--make-margin-overlay (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 (if outline--use-rtl
'outline-close-rtl-in-margins 'outline-close-rtl-in-margins
'outline-close-in-margins) 'outline-close-in-margins))))
'outline-open-in-margins)))) ('insert
(overlay-put (mapcar
o 'before-string (lambda (icon-name)
(propertize " " 'display (icon-elements icon-name))
`((margin ,(if outline--use-rtl (list 'outline-open
'right-margin 'left-margin)) (if outline--use-rtl 'outline-close-rtl 'outline-close))))
,(or (plist-get icon 'image) (_
(plist-get icon 'string)))))) (mapcar
o)) (lambda (icon-name)
(propertize (icon-string icon-name)
'mouse-face 'default
'follow-link 'mouse-face
'keymap (define-keymap "<mouse-2>" #'outline-cycle)))
(list 'outline-open
(if outline--use-rtl 'outline-close-rtl 'outline-close))))))
(defun outline--insert-open-button () (defun outline--insert-button (type)
(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))
(overlays-at (point)))))
(unless o
(when (eq outline-minor-mode-use-buttons 'insert) (when (eq outline-minor-mode-use-buttons 'insert)
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(insert " ") (insert " ")
(beginning-of-line))) (beginning-of-line)))
(let ((o (outline--make-button-overlay 'open))) (setq o (make-overlay (point) (1+ (point))))
(overlay-put o 'help-echo "Click to hide")))))) (overlay-put o 'outline-button t)
(overlay-put o 'evaporate t))
(defun outline--insert-close-button () (pcase outline-minor-mode-use-buttons
(with-silent-modifications ('insert
(save-excursion (overlay-put o 'display (or (plist-get icon 'image)
(beginning-of-line) (plist-get icon 'string)))
(if (eq outline-minor-mode-use-buttons 'in-margins) (overlay-put o 'face (plist-get icon 'face))
(outline--make-margin-overlay 'close) (overlay-put o 'follow-link 'mouse-face)
(when (eq outline-minor-mode-use-buttons 'insert) (overlay-put o 'mouse-face 'highlight)
(let ((inhibit-read-only t)) (overlay-put o 'keymap (define-keymap
(insert " ") "RET" #'outline-cycle
(beginning-of-line))) "<mouse-2>" #'outline-cycle))
(let ((o (outline--make-button-overlay 'close))) (overlay-put o 'help-echo (if (eq type 'close)
(overlay-put o 'help-echo "Click to show")))))) "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))