Mercurial > emacs

comparison lisp/info.el @ 107917:b8efa032f216

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Put breadcrumbs on overlay instead of inserting to buffer (bug#5809). * info.el (Info-find-node-2): Comment out code that skips breadcrumbs line. (Info-mouse-follow-link): New command. (Info-link-keymap): New keymap. (Info-breadcrumbs): Rename from `Info-insert-breadcrumbs'. Return a string with links instead of inserting breadcrumbs to the Info buffer. (Info-fontify-node): Comment out code that inserts breadcrumbs. Instead of putting the `invisible' text property over the Info header, make an overlay over the Info header with the `invisible' property and `after-string' set to the string returned by `Info-breadcrumbs'.
author Juri Linkov <juri@jurta.org>
date Tue, 06 Apr 2010 01:15:04 +0300
parents ef2a56409ad3
children c168d4537385 b9c7f875c4e8
comparison
equal deleted inserted replaced
107916:a8900b7136bc 107917:b8efa032f216
1051 (error "No such node or anchor: %s" nodename)) 1051 (error "No such node or anchor: %s" nodename))
1052 1052
1053 (Info-select-node) 1053 (Info-select-node)
1054 (goto-char (point-min)) 1054 (goto-char (point-min))
1055 (forward-line 1) ; skip header line 1055 (forward-line 1) ; skip header line
1056 (when (> Info-breadcrumbs-depth 0) ; skip breadcrumbs line 1056 ;; (when (> Info-breadcrumbs-depth 0) ; skip breadcrumbs line
1057 (forward-line 1)) 1057 ;; (forward-line 1))
1058 1058
1059 (cond (anchorpos 1059 (cond (anchorpos
1060 (let ((new-history (list Info-current-file 1060 (let ((new-history (list Info-current-file
1061 (substring-no-properties nodename)))) 1061 (substring-no-properties nodename))))
1062 ;; Add anchors to the history too 1062 ;; Add anchors to the history too
3549 ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)")) 3549 ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)"))
3550 (Info-goto-node "Top" fork)) 3550 (Info-goto-node "Top" fork))
3551 ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)")) 3551 ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)"))
3552 (Info-goto-node node fork))) 3552 (Info-goto-node node fork)))
3553 node)) 3553 node))
3554
3555 (defun Info-mouse-follow-link (click)
3556 "Follow a link where you click."
3557 (interactive "e")
3558 (let* ((position (event-start click))
3559 (posn-string (and position (posn-string position)))
3560 (string (car-safe posn-string))
3561 (string-pos (cdr-safe posn-string))
3562 (link-args (and string string-pos
3563 (get-text-property string-pos 'link-args string))))
3564 (when link-args
3565 (Info-goto-node link-args))))
3566
3554 3567
3555 (defvar Info-mode-map 3568 (defvar Info-mode-map
3556 (let ((map (make-keymap))) 3569 (let ((map (make-keymap)))
3557 (suppress-keymap map) 3570 (suppress-keymap map)
3558 (define-key map "." 'beginning-of-buffer) 3571 (define-key map "." 'beginning-of-buffer)
4139 (define-key keymap [mouse-2] 'Info-up) 4152 (define-key keymap [mouse-2] 'Info-up)
4140 (define-key keymap [follow-link] 'mouse-face) 4153 (define-key keymap [follow-link] 'mouse-face)
4141 keymap) 4154 keymap)
4142 "Keymap to put on the Up link in the text or the header line.") 4155 "Keymap to put on the Up link in the text or the header line.")
4143 4156
4144 (defun Info-insert-breadcrumbs () 4157 (defvar Info-link-keymap
4158 (let ((keymap (make-sparse-keymap)))
4159 (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link)
4160 (define-key keymap [header-line mouse-2] 'Info-mouse-follow-link)
4161 (define-key keymap [header-line down-mouse-1] 'ignore)
4162 (define-key keymap [mouse-2] 'Info-mouse-follow-link)
4163 (define-key keymap [follow-link] 'mouse-face)
4164 keymap)
4165 "Keymap to put on the link in the text or the header line.")
4166
4167 (defun Info-breadcrumbs ()
4145 (let ((nodes (Info-toc-nodes Info-current-file)) 4168 (let ((nodes (Info-toc-nodes Info-current-file))
4146 (node Info-current-node) 4169 (node Info-current-node)
4147 (crumbs ()) 4170 (crumbs ())
4148 (depth Info-breadcrumbs-depth)) 4171 (depth Info-breadcrumbs-depth)
4172 line)
4149 4173
4150 ;; Get ancestors from the cached parent-children node info 4174 ;; Get ancestors from the cached parent-children node info
4151 (while (and (not (equal "Top" node)) (> depth 0)) 4175 (while (and (not (equal "Top" node)) (> depth 0))
4152 (setq node (nth 1 (assoc node nodes))) 4176 (setq node (nth 1 (assoc node nodes)))
4153 (if node (push node crumbs)) 4177 (if node (push node crumbs))
4170 (format "(%s)Top" 4194 (format "(%s)Top"
4171 (if (stringp Info-current-file) 4195 (if (stringp Info-current-file)
4172 (file-name-nondirectory Info-current-file) 4196 (file-name-nondirectory Info-current-file)
4173 ;; Some legacy code can still use a symbol. 4197 ;; Some legacy code can still use a symbol.
4174 Info-current-file))))) 4198 Info-current-file)))))
4175 (insert (if (bolp) "" " > ") 4199 (setq line (concat
4176 (cond 4200 line
4177 ((null node) "...") 4201 (if (null line) "" " > ")
4178 ((equal node Info-current-node) 4202 (cond
4179 ;; No point linking to ourselves. 4203 ((null node) "...")
4180 (propertize text 'font-lock-face 'info-header-node)) 4204 ((equal node Info-current-node)
4181 (t 4205 ;; No point linking to ourselves.
4182 (concat "*Note " text "::")))))) 4206 (propertize text 'font-lock-face 'info-header-node))
4183 (insert "\n")))) 4207 (t
4208 (propertize text
4209 'mouse-face 'highlight
4210 'font-lock-face 'info-header-xref
4211 'help-echo "mouse-2: Go to node"
4212 'keymap Info-link-keymap
4213 'link-args text)))))))
4214 (setq line (concat line "\n")))
4215 ;; (font-lock-append-text-property 0 (length line)
4216 ;; 'font-lock-face 'header-line line)
4217 line))
4184 4218
4185 (defun Info-fontify-node () 4219 (defun Info-fontify-node ()
4186 "Fontify the node." 4220 "Fontify the node."
4187 (save-excursion 4221 (save-excursion
4188 (let* ((inhibit-read-only t) 4222 (let* ((inhibit-read-only t)
4225 (cond 4259 (cond
4226 ((string-equal (downcase tag) "prev") Info-prev-link-keymap) 4260 ((string-equal (downcase tag) "prev") Info-prev-link-keymap)
4227 ((string-equal (downcase tag) "next") Info-next-link-keymap) 4261 ((string-equal (downcase tag) "next") Info-next-link-keymap)
4228 ((string-equal (downcase tag) "up" ) Info-up-link-keymap)))))) 4262 ((string-equal (downcase tag) "up" ) Info-up-link-keymap))))))
4229 4263
4230 (when (> Info-breadcrumbs-depth 0) 4264 ;; (when (> Info-breadcrumbs-depth 0)
4231 (Info-insert-breadcrumbs)) 4265 ;; (insert (Info-breadcrumbs)))
4232 4266
4233 ;; Treat header line. 4267 ;; Treat header line.
4234 (when Info-use-header-line 4268 (when Info-use-header-line
4235 (goto-char (point-min)) 4269 (goto-char (point-min))
4236 (let* ((header-end (line-end-position)) 4270 (let* ((header-end (line-end-position))
4258 (lambda (s) (concat s s)) header)) 4292 (lambda (s) (concat s s)) header))
4259 ;; Hide the part of the first line 4293 ;; Hide the part of the first line
4260 ;; that is in the header, if it is just part. 4294 ;; that is in the header, if it is just part.
4261 (cond 4295 (cond
4262 ((> Info-breadcrumbs-depth 0) 4296 ((> Info-breadcrumbs-depth 0)
4263 (put-text-property (point-min) (1+ header-end) 'invisible t)) 4297 (let ((ov (make-overlay (point-min) (1+ header-end))))
4298 (overlay-put ov 'invisible t)
4299 (overlay-put ov 'after-string (Info-breadcrumbs))
4300 (overlay-put ov 'evaporate t)))
4264 ((not (bobp)) 4301 ((not (bobp))
4265 ;; Hide the punctuation at the end, too. 4302 ;; Hide the punctuation at the end, too.
4266 (skip-chars-backward " \t,") 4303 (skip-chars-backward " \t,")
4267 (put-text-property (point) header-end 'invisible t)))))) 4304 (put-text-property (point) header-end 'invisible t))))))
4268 4305