From: Juri Linkov <juri@linkov.net>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 57813@debbugs.gnu.org
Subject: bug#57813: Icon images are non-functional
Date: Sun, 18 Sep 2022 22:06:56 +0300 [thread overview]
Message-ID: <86bkrcijsf.fsf@mail.linkov.net> (raw)
In-Reply-To: <83sfkpz2gb.fsf@gnu.org> (Eli Zaretskii's message of "Sun, 18 Sep 2022 08:17:08 +0300")
[-- Attachment #1: Type: text/plain, Size: 793 bytes --]
>> Here is a preliminary patch
>
> Thanks. I only quickly read the patch, and have one comment: the
> hard-coded left-margin should depend on the value returned by
> current-bidi-paragraph-direction, because text that is displayed
> right-to-left should have the icons on the right margin, not left
> margin.
To not create a new mirrored image file for RTL arrow required a change in
icons--create to support ':rotation 180' for the existing image file:
(define-icon outline-close-rtl-in-margins outline-close
'((image "outline-close.svg" "outline-close.pbm"
:height 10 :ascent center :rotation 180))
"Icon used for buttons for closing a section in outline buffers."
:version "29.1"
:help-echo "Close this section")
Then the right margin could be used with:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: outline-minor-mode-rtl-in-margins.patch --]
[-- Type: text/x-diff, Size: 8603 bytes --]
diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el
index ff4f20c207..96f5ea6b08 100644
--- a/lisp/emacs-lisp/icons.el
+++ b/lisp/emacs-lisp/icons.el
@@ -202,7 +202,9 @@ icons--create
:height (if (eq height 'line)
(window-default-line-height)
height)
- :scale 1 :ascent 'center)
+ :scale 1
+ :rotation (plist-get keywords :rotation)
+ :ascent (or (plist-get keywords :ascent) 'center))
(create-image file))))))
(cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords)
diff --git a/lisp/outline.el b/lisp/outline.el
index 25ef1616b9..32c5799814 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -292,6 +292,16 @@ outline-minor-mode-use-buttons
:safe #'booleanp
:version "29.1")
+(defcustom outline-minor-mode-use-margins '(derived-mode . special-mode)
+ "Whether to display clickable buttons on the margins.
+The value should be a `buffer-match-p' condition.
+
+These buttons can be used to hide and show the body under the heading.
+Note that this feature is meant to be used in editing buffers."
+ :type 'buffer-predicate
+ :safe #'booleanp
+ :version "29.1")
+
(define-icon outline-open nil
'((image "outline-open.svg" "outline-open.pbm"
:height 15 :ascent center)
@@ -312,6 +322,27 @@ outline-close
:version "29.1"
:help-echo "Close this section")
+(define-icon outline-open-in-margins outline-open
+ '((image "outline-open.svg" "outline-open.pbm"
+ :height 10 :ascent center))
+ "Icon used for buttons for opening a section in outline buffers."
+ :version "29.1"
+ :help-echo "Open this section")
+
+(define-icon outline-close-in-margins outline-close
+ '((image "outline-open.svg" "outline-open.pbm"
+ :height 10 :ascent center :rotation -90))
+ "Icon used for buttons for closing a section in outline buffers."
+ :version "29.1"
+ :help-echo "Close this section")
+
+(define-icon outline-close-rtl-in-margins outline-close
+ '((image "outline-open.svg" "outline-open.pbm"
+ :height 10 :ascent center :rotation 90))
+ "Icon used for buttons for closing a section in outline buffers."
+ :version "29.1"
+ :help-echo "Close this section")
+
\f
(defvar outline-level #'outline-level
"Function of no args to compute a header's nesting level in an outline.
@@ -453,6 +486,11 @@ outline-minor-mode
(key-description outline-minor-mode-prefix) outline-mode-prefix-map)
(if outline-minor-mode
(progn
+ (when (outline--use-margins-p)
+ (if (eq (current-bidi-paragraph-direction) 'right-to-left)
+ (setq-local right-margin-width (1+ right-margin-width))
+ (setq-local left-margin-width (1+ left-margin-width)))
+ (setq-local fringes-outside-margins t))
(when outline-minor-mode-highlight
(if (and global-font-lock-mode (font-lock-specified-p major-mode))
(progn
@@ -473,6 +511,11 @@ outline-minor-mode
(font-lock-remove-keywords nil outline-font-lock-keywords))
(remove-overlays nil nil 'outline-overlay t)
(font-lock-flush))
+ (when (outline--use-margins-p)
+ (if (eq (current-bidi-paragraph-direction) 'right-to-left)
+ (setq-local right-margin-width (1- right-margin-width))
+ (setq-local left-margin-width (1- left-margin-width)))
+ (setq-local fringes-outside-margins nil))
(setq line-move-ignore-invisible nil)
;; Cause use of ellipses for invisible text.
(remove-from-invisibility-spec '(outline . t))
@@ -483,6 +526,10 @@ outline--use-buttons-p
(and outline-minor-mode
(buffer-match-p outline-minor-mode-use-buttons (current-buffer))))
+(defun outline--use-margins-p ()
+ (and outline-minor-mode
+ (buffer-match-p outline-minor-mode-use-margins (current-buffer))))
+
(defvar-local outline-heading-alist ()
"Alist associating a heading for every possible level.
Each entry is of the form (HEADING . LEVEL).
@@ -1012,10 +1061,43 @@ outline--make-button-overlay
(overlay-put o 'face (plist-get icon 'face))))
o))
-(defun outline--insert-open-button ()
+(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 'follow-link 'mouse-face)
+ (overlay-put o 'mouse-face 'highlight)
+ (overlay-put o 'outline-margin t))
+ (let ((icon
+ (icon-elements (if (eq type 'close)
+ (if (eq (current-bidi-paragraph-direction)
+ 'right-to-left)
+ 'outline-close-rtl-in-margins
+ 'outline-close-in-margins)
+ 'outline-open-in-margins)))
+ (inhibit-read-only t))
+ (overlay-put
+ o 'before-string
+ (propertize " " 'display
+ `((margin ,(if (eq (current-bidi-paragraph-direction)
+ 'right-to-left)
+ 'right-margin 'left-margin))
+ ,(or (plist-get icon 'image)
+ (plist-get icon 'string))))))
+ o))
+
+(defun outline--insert-open-button (&optional margins-p)
(with-silent-modifications
(save-excursion
- (beginning-of-line)
+ (beginning-of-line)
+ (if margins-p
+ (let ((o (outline--make-margin-overlay 'open)))
+ (overlay-put o 'help-echo "Click to hide")
+ (overlay-put o 'keymap
+ (define-keymap
+ "<mouse-2>" #'outline-hide-subtree)))
(when (derived-mode-p 'special-mode)
(let ((inhibit-read-only t))
(insert " ")
@@ -1025,12 +1107,18 @@ outline--insert-open-button
(overlay-put o 'keymap
(define-keymap
"RET" #'outline-hide-subtree
- "<mouse-2>" #'outline-hide-subtree))))))
+ "<mouse-2>" #'outline-hide-subtree)))))))
-(defun outline--insert-close-button ()
+(defun outline--insert-close-button (&optional margins-p)
(with-silent-modifications
(save-excursion
- (beginning-of-line)
+ (beginning-of-line)
+ (if margins-p
+ (let ((o (outline--make-margin-overlay 'close)))
+ (overlay-put o 'help-echo "Click to show")
+ (overlay-put o 'keymap
+ (define-keymap
+ "<mouse-2>" #'outline-show-subtree)))
(when (derived-mode-p 'special-mode)
(let ((inhibit-read-only t))
(insert " ")
@@ -1040,23 +1128,25 @@ outline--insert-close-button
(overlay-put o 'keymap
(define-keymap
"RET" #'outline-show-subtree
- "<mouse-2>" #'outline-show-subtree))))))
+ "<mouse-2>" #'outline-show-subtree)))))))
(defun outline--fix-up-all-buttons (&optional from to)
- (when (outline--use-buttons-p)
- (when from
- (save-excursion
- (goto-char from)
- (setq from (line-beginning-position))))
- (outline-map-region
- (lambda ()
- (if (save-excursion
- (outline-end-of-heading)
- (seq-some (lambda (o) (eq (overlay-get o 'invisible) 'outline))
- (overlays-at (point))))
- (outline--insert-close-button)
- (outline--insert-open-button)))
- (or from (point-min)) (or to (point-max)))))
+ (let ((buttons-p (outline--use-buttons-p))
+ (margins-p (outline--use-margins-p)))
+ (when (or buttons-p margins-p)
+ (when from
+ (save-excursion
+ (goto-char from)
+ (setq from (line-beginning-position))))
+ (outline-map-region
+ (lambda ()
+ (if (save-excursion
+ (outline-end-of-heading)
+ (seq-some (lambda (o) (eq (overlay-get o 'invisible) 'outline))
+ (overlays-at (point))))
+ (outline--insert-close-button margins-p)
+ (outline--insert-open-button margins-p)))
+ (or from (point-min)) (or to (point-max))))))
(define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1")
next prev parent reply other threads:[~2022-09-18 19:06 UTC|newest]
Thread overview: 31+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-09-14 19:40 bug#57813: Icon images are non-functional Juri Linkov
2022-09-15 16:30 ` Juri Linkov
2022-09-15 16:36 ` Juri Linkov
2022-09-15 16:53 ` Eli Zaretskii
2022-09-15 17:35 ` Juri Linkov
2022-09-15 18:32 ` Eli Zaretskii
2022-09-15 19:46 ` Juri Linkov
2022-09-16 16:16 ` Juri Linkov
2022-09-15 19:53 ` Juri Linkov
2022-09-16 5:29 ` Eli Zaretskii
2022-09-16 7:09 ` Juri Linkov
2022-09-17 19:37 ` Juri Linkov
2022-09-18 5:08 ` Eli Zaretskii
2022-09-18 18:46 ` Juri Linkov
2022-09-18 5:17 ` Eli Zaretskii
2022-09-18 19:06 ` Juri Linkov [this message]
2022-09-19 12:12 ` Eli Zaretskii
2022-09-19 19:37 ` Juri Linkov
2022-09-20 11:31 ` Eli Zaretskii
2022-09-20 16:12 ` Juri Linkov
2022-09-23 15:48 ` Juri Linkov
2022-09-23 16:26 ` Lars Ingebrigtsen
2022-09-24 17:17 ` Juri Linkov
2022-10-12 14:42 ` Max Brieiev
2022-10-12 18:55 ` Juri Linkov
2022-10-23 16:55 ` Juri Linkov
2022-10-13 7:51 ` Juri Linkov
2022-10-18 18:14 ` Juri Linkov
2022-10-18 18:35 ` Juri Linkov
2022-10-19 6:44 ` Juri Linkov
2022-10-22 18:38 ` Juri Linkov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=86bkrcijsf.fsf@mail.linkov.net \
--to=juri@linkov.net \
--cc=57813@debbugs.gnu.org \
--cc=eliz@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).