unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Juri Linkov <juri@jurta.org>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: 5809@debbugs.gnu.org
Subject: bug#5809: 23.1.94; cross-reference by anchor yields in accurate position
Date: Mon, 05 Apr 2010 02:52:19 +0300	[thread overview]
Message-ID: <87eiiuwz6g.fsf@mail.jurta.org> (raw)
In-Reply-To: <jwv7honl29z.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Sun, 04 Apr 2010 10:31:51 -0400")

>> There are still a problem.  I can't find a way to move the cursor
>> inside the overlay's after-string and click links inside it.
>
> That's what I said would be the limitation: you can't "click" with
> the keyboard.  I think it's an acceptable limitation for now.
> Also you can't copy&paste the string (e.g. to make a bug report).

We could change the background color of the overlay's after-string
to look like the header line (grey background) so users will expect
that only mouse clicks should work on grey areas.

This patch works with mouse clicks, but needs more testing:

=== modified file 'lisp/info.el'
--- lisp/info.el	2010-03-03 19:23:20 +0000
+++ lisp/info.el	2010-04-04 23:50:03 +0000
@@ -153,12 +153,12 @@ (defcustom Info-use-header-line t
   :group 'info)
 
 (defface info-header-xref
-  '((t :inherit info-xref))
+  '((t :inherit (info-xref header-line)))
   "Face for Info cross-references in a node header."
   :group 'info)
 
 (defface info-header-node
-  '((t :inherit info-node))
+  '((t :inherit (info-node header-line)))
   "Face for Info nodes in a node header."
   :group 'info)
 
@@ -1053,8 +1053,6 @@ (defun Info-find-node-2 (filename nodena
 	    (Info-select-node)
 	    (goto-char (point-min))
 	    (forward-line 1)		       ; skip header line
-	    (when (> Info-breadcrumbs-depth 0) ; skip breadcrumbs line
-	      (forward-line 1))
 
 	    (cond (anchorpos
                    (let ((new-history (list Info-current-file
@@ -3551,6 +3549,19 @@ (defun Info-try-follow-nearest-node (&op
      ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)"))
       (Info-goto-node node fork)))
     node))
+
+(defun Info-mouse-follow-link (click)
+  "Follow a link under point."
+  (interactive "e")
+  (let* ((position (event-start click))
+	 (posn-string (and position (posn-string position)))
+	 (string (car-safe posn-string))
+	 (string-pos (cdr-safe posn-string))
+	 (link-args (and string string-pos
+			 (get-text-property string-pos 'link-args string))))
+    (when link-args
+      (Info-goto-node link-args))))
+
 \f
 (defvar Info-mode-map
   (let ((map (make-keymap)))
@@ -4141,11 +4152,22 @@ (defvar Info-up-link-keymap
     keymap)
   "Keymap to put on the Up link in the text or the header line.")
 
-(defun Info-insert-breadcrumbs ()
+(defvar Info-link-keymap
+  (let ((keymap (make-sparse-keymap)))
+    (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link)
+    (define-key keymap [header-line mouse-2] 'Info-mouse-follow-link)
+    (define-key keymap [header-line down-mouse-1] 'ignore)
+    (define-key keymap [mouse-2] 'Info-mouse-follow-link)
+    (define-key keymap [follow-link] 'mouse-face)
+    keymap)
+  "Keymap to put on the link in the text or the header line.")
+
+(defun Info-breadcrumbs ()
   (let ((nodes (Info-toc-nodes Info-current-file))
 	(node Info-current-node)
         (crumbs ())
-        (depth Info-breadcrumbs-depth))
+        (depth Info-breadcrumbs-depth)
+	line)
 
     ;; Get ancestors from the cached parent-children node info
     (while (and (not (equal "Top" node)) (> depth 0))
@@ -4172,15 +4194,24 @@ (defun Info-insert-breadcrumbs ()
 			     (file-name-nondirectory Info-current-file)
 			   ;; Some legacy code can still use a symbol.
 			   Info-current-file)))))
-	  (insert (if (bolp) "" " > ")
-		  (cond
-		   ((null node) "...")
-		   ((equal node Info-current-node)
-		    ;; No point linking to ourselves.
-		    (propertize text 'font-lock-face 'info-header-node))
-		   (t
-		    (concat "*Note " text "::"))))))
-      (insert "\n"))))
+	  (setq line (concat
+		      line
+		      (if (null line) "" (propertize " > " 'face 'header-line))
+		      (cond
+		       ((null node) (propertize "..." 'face 'header-line))
+		       ((equal node Info-current-node)
+			;; No point linking to ourselves.
+			(propertize text 'font-lock-face 'info-header-node))
+		       (t
+			(propertize text
+				    'mouse-face 'highlight
+				    'font-lock-face 'info-header-xref
+				    'help-echo "mouse-2: Go to node"
+				    'keymap Info-link-keymap
+				    'link-args text)
+			))))))
+      (setq line (concat line (propertize "\n" 'face 'header-line))))
+    line))
 
 (defun Info-fontify-node ()
   "Fontify the node."
@@ -4227,9 +4258,6 @@ (defun Info-fontify-node ()
 		((string-equal (downcase tag) "next") Info-next-link-keymap)
 		((string-equal (downcase tag) "up"  ) Info-up-link-keymap))))))
 
-        (when (> Info-breadcrumbs-depth 0)
-          (Info-insert-breadcrumbs))
-
         ;; Treat header line.
         (when Info-use-header-line
           (goto-char (point-min))
@@ -4260,7 +4288,10 @@ (defun Info-fontify-node ()
             ;; that is in the header, if it is just part.
             (cond
              ((> Info-breadcrumbs-depth 0)
-              (put-text-property (point-min) (1+ header-end) 'invisible t))
+              (put-text-property (point-min) (1+ header-end) 'invisible t)
+	      (overlay-put
+	       (make-overlay header-end (1+ header-end))
+	       'after-string (Info-breadcrumbs)))
              ((not (bobp))
               ;; Hide the punctuation at the end, too.
               (skip-chars-backward " \t,")

-- 
Juri Linkov
http://www.jurta.org/emacs/






  reply	other threads:[~2010-04-04 23:52 UTC|newest]

Thread overview: 49+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2010-03-31  9:58 bug#5809: 23.1.94; cross-reference by anchor yields in accurate position Eli Zaretskii
2010-03-31 11:17 ` Eli Zaretskii
2010-03-31 15:08 ` Juri Linkov
2010-03-31 15:55   ` Eli Zaretskii
2010-04-01 18:06     ` Juri Linkov
2010-04-01 18:13       ` Eli Zaretskii
2010-04-01 18:30         ` Juri Linkov
2010-04-01 20:22           ` Eli Zaretskii
2010-04-01 20:49             ` Eli Zaretskii
2010-04-01 21:10               ` Juri Linkov
2010-04-01 22:16               ` Stefan Monnier
2010-04-02  7:07                 ` Eli Zaretskii
2010-04-02 14:17                   ` Drew Adams
2010-04-02 14:39                     ` Eli Zaretskii
2010-04-02 15:26                       ` Drew Adams
2010-04-04 20:39                         ` Drew Adams
2010-04-04 20:47                           ` Eli Zaretskii
2010-04-04 22:51                             ` Drew Adams
2010-04-04 23:58                               ` Juri Linkov
2010-04-05  7:01                                 ` Drew Adams
2010-04-05 16:42                                   ` Juri Linkov
2010-04-05 20:11                                     ` Stefan Monnier
2010-04-05 23:17                                       ` Drew Adams
2010-04-06  5:49                                         ` Drew Adams
2010-04-06 17:46                                           ` Drew Adams
2010-04-05 16:45                               ` Juri Linkov
2010-04-05 17:12                                 ` Drew Adams
2010-04-05 21:55                                 ` Eli Zaretskii
2010-04-05  6:38                   ` Drew Adams
2010-04-02 16:14                 ` Juri Linkov
2010-04-02 16:31                   ` Drew Adams
2010-04-02 17:41                   ` Eli Zaretskii
2010-04-02 18:01                   ` Stefan Monnier
2010-04-02 23:11                     ` Juri Linkov
2010-04-03 22:04                       ` Juri Linkov
2010-04-04  6:12                         ` Eli Zaretskii
2010-04-04 11:07                           ` Juri Linkov
2010-04-04 12:12                             ` Eli Zaretskii
2010-04-04 23:51                               ` Juri Linkov
2010-04-05  5:26                                 ` Eli Zaretskii
2010-04-04 14:31                         ` Stefan Monnier
2010-04-04 23:52                           ` Juri Linkov [this message]
2010-04-05  2:06                             ` Stefan Monnier
2010-04-05 16:50                               ` Juri Linkov
2010-04-05 20:09                                 ` Stefan Monnier
2010-04-05 22:17                                   ` Juri Linkov
2010-04-01 21:09             ` Juri Linkov
2010-04-02 18:03               ` Stefan Monnier
2010-04-25 18:28 ` Chong Yidong

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=87eiiuwz6g.fsf@mail.jurta.org \
    --to=juri@jurta.org \
    --cc=5809@debbugs.gnu.org \
    --cc=monnier@iro.umontreal.ca \
    /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).