bug#5809: 23.1.94; cross-reference by anchor yields in accurate position

[Juri Linkov]

>> 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))))
+
 
 (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/