- ;; Only fontify the node if it hasn't already been done. [We pass in
- ;; LIMIT arg to `next-property-change' because it seems to search past
- ;; (point-max).]
- (unless (and (< (next-property-change (point-min) nil (point-max))
- (point-max))
- ;; But do put the text properties if the local-map property
- ;; is inconsistent with Info-use-header-line's value.
- (eq
- (= (next-single-property-change
- (point-min) 'local-map nil (point-max))
- (point-max))
- (null Info-use-header-line)))
- (save-excursion
- (let ((buffer-read-only nil)
- (case-fold-search t))
- (goto-char (point-min))
- (when (looking-at "^File: [^,: \t]+,?[ \t]+")
- (goto-char (match-end 0))
- (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
- (goto-char (match-end 0))
- (let* ((nbeg (match-beginning 2))
- (nend (match-end 2))
- (tbeg (match-beginning 1))
- (tag (buffer-substring tbeg (match-end 1))))
- (if (string-equal tag "Node")
- (put-text-property nbeg nend 'face 'info-header-node)
- (put-text-property nbeg nend 'face 'info-header-xref)
- (put-text-property tbeg nend 'mouse-face 'highlight)
- (put-text-property tbeg nend
- 'help-echo
- (concat "Go to node "
- (buffer-substring nbeg nend)))
- ;; Don't bind mouse events on the header line if we
- ;; aren't going to display the header line.
- (when Info-use-header-line
- (let ((fun (cdr (assoc tag '(("Prev" . Info-prev)
- ("Next" . Info-next)
- ("Up" . Info-up))))))
- (when fun
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap [header-line mouse-1] fun)
- (define-key keymap [header-line mouse-2] fun)
- (put-text-property tbeg nend 'local-map keymap)))))
- (if (not Info-use-header-line)
- ;; In case they switched Info-use-header-line off
- ;; in the middle of an Info session, some text
- ;; properties may have been left lying around from
- ;; past visits of this node. Remove them.
- (remove-text-properties tbeg nend '(local-map nil)))
- ))))
- (goto-char (point-min))
- (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\|\\.+\\)$"
- nil t)
- (let ((c (preceding-char))
- face)
- (cond ((= c ?*) (setq face 'Info-title-1-face))
- ((= c ?=) (setq face 'Info-title-2-face))
- ((= c ?-) (setq face 'Info-title-3-face))
- (t (setq face 'Info-title-4-face)))
- (put-text-property (match-beginning 1) (match-end 1)
- 'face face))
- ;; This is a serious problem for trying to handle multiple
- ;; frame types at once. We want this text to be invisible
- ;; on frames that can display the font above.
- (when (memq (framep (selected-frame)) '(x pc w32 mac))
- (add-text-properties (match-beginning 2) (1+ (match-end 2))
- '(invisible t intangible t))))
- (goto-char (point-min))
- (while (re-search-forward "\\*Note[ \n\t]+\\([^:]*\\):" nil t)
- (if (= (char-after (1- (match-beginning 0))) ?\") ; hack
- nil
- (add-text-properties (match-beginning 1) (match-end 1)
- '(face info-xref
- mouse-face highlight
- help-echo "mouse-2: go to this node"))))
- (goto-char (point-min))
- (if (and (search-forward "\n* Menu:" nil t)
- (not (string-match "\\<Index\\>" Info-current-node))
- ;; Don't take time to annotate huge menus
- (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
- (let ((n 0))
- (while (re-search-forward "^\\* +\\([^:\t\n]*\\):" nil t)
- (setq n (1+ n))
- (if (zerop (% n 3)) ; visual aids to help with 1-9 keys
- (put-text-property (match-beginning 0)
- (1+ (match-beginning 0))
- 'face 'info-menu-5))
- (add-text-properties (match-beginning 1) (match-end 1)
- '(face info-xref
- mouse-face highlight
- help-echo "mouse-2: go to this node")))))
- (Info-fontify-menu-headers)
- (set-buffer-modified-p nil)))))
+ "Fontify the node."
+ (save-excursion
+ (let* ((inhibit-read-only t)
+ (case-fold-search t)
+ paragraph-markers
+ (not-fontified-p ; the node hasn't already been fontified
+ (not (let ((where (next-property-change (point-min))))
+ (and where (not (= where (point-max)))))))
+ (fontify-visited-p ; visited nodes need to be re-fontified
+ (and Info-fontify-visited-nodes
+ ;; Don't take time to refontify visited nodes in huge nodes
+ (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size))))
+
+ ;; Fontify header line
+ (goto-char (point-min))
+ (when (and not-fontified-p (looking-at "^\\(File: [^,: \t]+,?[ \t]+\\)?"))
+ (goto-char (match-end 0))
+ (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
+ (goto-char (match-end 0))
+ (let* ((nbeg (match-beginning 2))
+ (nend (match-end 2))
+ (tbeg (match-beginning 1))
+ (tag (match-string 1)))
+ (if (string-equal tag "Node")
+ (put-text-property nbeg nend 'font-lock-face 'info-header-node)
+ (put-text-property nbeg nend 'font-lock-face 'info-header-xref)
+ (put-text-property tbeg nend 'mouse-face 'highlight)
+ (put-text-property tbeg nend
+ 'help-echo
+ (concat "Go to node "
+ (buffer-substring nbeg nend)))
+ ;; Always set up the text property keymap.
+ ;; It will either be used in the buffer
+ ;; or copied in the header line.
+ (put-text-property tbeg nend 'keymap
+ (cond
+ ((equal tag "Prev") Info-prev-link-keymap)
+ ((equal tag "Next") Info-next-link-keymap)
+ ((equal tag "Up") Info-up-link-keymap))))))
+ (when Info-use-header-line
+ (goto-char (point-min))
+ (let ((header-end (line-end-position))
+ header)
+ ;; If we find neither Next: nor Prev: link, show the entire
+ ;; node header. Otherwise, don't show the File: and Node:
+ ;; parts, to avoid wasting precious space on information that
+ ;; is available in the mode line.
+ (if (re-search-forward
+ "\\(next\\|up\\|prev[ious]*\\): "
+ header-end t)
+ (progn
+ (goto-char (match-beginning 1))
+ (setq header (buffer-substring (point) header-end)))
+ (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" header-end t)
+ (setq header
+ (concat "No next, prev or up links -- "
+ (buffer-substring (point) header-end)))
+ (setq header (buffer-substring (point) header-end))))
+ (put-text-property (point-min) (1+ (point-min))
+ 'header-line (Info-escape-percent header))
+ ;; Hide the part of the first line
+ ;; that is in the header, if it is just part.
+ (unless (bobp)
+ ;; Hide the punctuation at the end, too.
+ (skip-chars-backward " \t,")
+ (put-text-property (point) header-end 'invisible t)))))
+
+ ;; Fontify titles
+ (goto-char (point-min))
+ (when not-fontified-p
+ (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\|\\.+\\)$"
+ nil t)
+ (let* ((c (preceding-char))
+ (face
+ (cond ((= c ?*) 'Info-title-1-face)
+ ((= c ?=) 'Info-title-2-face)
+ ((= c ?-) 'Info-title-3-face)
+ (t 'Info-title-4-face))))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-face face))
+ ;; This is a serious problem for trying to handle multiple
+ ;; frame types at once. We want this text to be invisible
+ ;; on frames that can display the font above.
+ (when (memq (framep (selected-frame)) '(x pc w32 mac))
+ (add-text-properties (1- (match-beginning 2)) (match-end 2)
+ '(invisible t front-sticky nil rear-nonsticky t)))))
+
+ ;; Fontify cross references
+ (goto-char (point-min))
+ (when (or not-fontified-p fontify-visited-p)
+ (while (re-search-forward "\\(\\*Note[ \n\t]+\\)\\([^:]*\\)\\(:[ \t]*\\([^.,:(]*\\)\\(\\(([^)]*)\\)[^.,:]*\\)?[,:]?\n?\\)" nil t)
+ (let ((start (match-beginning 0))
+ (next (point))
+ other-tag)
+ (when not-fontified-p
+ (when Info-hide-note-references
+ ;; *Note is often used where *note should have been
+ (goto-char start)
+ (skip-syntax-backward " ")
+ (setq other-tag
+ (cond ((memq (char-before) '(nil ?\. ?! ??))
+ "See ")
+ ((memq (char-before) '(?\, ?\; ?\: ?-))
+ "see ")
+ ((memq (char-before) '(?\( ?\[ ?\{))
+ ;; Check whether the paren is preceded by
+ ;; an end of sentence
+ (skip-syntax-backward " (")
+ (if (memq (char-before) '(nil ?\. ?! ??))
+ "See "
+ "see "))
+ ((save-match-data (looking-at "\n\n"))
+ "See ")))
+ (goto-char next)
+ (add-text-properties
+ (match-beginning 1)
+ (or (save-match-data
+ ;; Don't hide \n after *Note
+ (let ((start1 (match-beginning 1)))
+ (if (string-match "\n" (match-string 1))
+ (+ start1 (match-beginning 0)))))
+ (match-end 1))
+ (if (and other-tag (not (eq Info-hide-note-references 'hide)))
+ `(display ,other-tag front-sticky nil rear-nonsticky t)
+ '(invisible t front-sticky nil rear-nonsticky t))))
+ (add-text-properties
+ (match-beginning 2) (match-end 2)
+ (list
+ 'help-echo (if (or (match-end 5)
+ (not (equal (match-string 4) "")))
+ (concat "mouse-2: go to " (or (match-string 5)
+ (match-string 4)))
+ "mouse-2: go to this node")
+ 'mouse-face 'highlight)))
+ (when (or not-fontified-p fontify-visited-p)
+ (add-text-properties
+ (match-beginning 2) (match-end 2)
+ (list
+ 'font-lock-face
+ ;; Display visited nodes in a different face
+ (if (and Info-fontify-visited-nodes
+ (save-match-data
+ (let* ((node (replace-regexp-in-string
+ "^[ \t]+" ""
+ (replace-regexp-in-string
+ "[ \t\n]+" " "
+ (or (match-string 5)
+ (and (not (equal (match-string 4) ""))
+ (match-string 4))
+ (match-string 2)))))
+ (file (file-name-nondirectory
+ Info-current-file))
+ (hl Info-history-list)
+ res)
+ (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
+ (setq file (match-string 1 node)
+ node (if (equal (match-string 2 node) "")
+ "Top"
+ (match-string 2 node))))
+ (while hl
+ (if (and (string-equal node (nth 1 (car hl)))
+ (string-equal file
+ (file-name-nondirectory
+ (nth 0 (car hl)))))
+ (setq res (car hl) hl nil)
+ (setq hl (cdr hl))))
+ res))) 'info-xref-visited 'info-xref))))
+ (when not-fontified-p
+ (when (memq Info-hide-note-references '(t hide))
+ (add-text-properties (match-beginning 3) (match-end 3)
+ '(invisible t front-sticky nil rear-nonsticky t))
+ ;; Unhide the file name of the external reference in parens
+ (if (match-string 6)
+ (remove-text-properties (match-beginning 6) (match-end 6)
+ '(invisible t front-sticky nil rear-nonsticky t)))
+ ;; Unhide newline because hidden newlines cause too long lines
+ (save-match-data
+ (let ((start3 (match-beginning 3)))
+ (if (string-match "\n[ \t]*" (match-string 3))
+ (remove-text-properties (+ start3 (match-beginning 0)) (+ start3 (match-end 0))
+ '(invisible t front-sticky nil rear-nonsticky t))))))
+ (when (and Info-refill-paragraphs Info-hide-note-references)
+ (push (set-marker (make-marker) start)
+ paragraph-markers))))))
+
+ ;; Refill paragraphs (experimental feature)
+ (when (and not-fontified-p
+ Info-refill-paragraphs
+ paragraph-markers)
+ (let ((fill-nobreak-invisible t)
+ (fill-individual-varying-indent nil)
+ (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$")
+ (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$")
+ (adaptive-fill-mode nil))
+ (goto-char (point-max))
+ (while paragraph-markers
+ (let ((m (car paragraph-markers)))
+ (setq paragraph-markers (cdr paragraph-markers))
+ (when (< m (point))
+ (goto-char m)
+ (beginning-of-line)
+ (let ((beg (point)))
+ (when (zerop (forward-paragraph))
+ (fill-individual-paragraphs beg (point) nil nil)
+ (goto-char beg))))
+ (set-marker m nil)))))
+
+ ;; Fontify menu items
+ (goto-char (point-min))
+ (when (and (or not-fontified-p fontify-visited-p)
+ (search-forward "\n* Menu:" nil t)
+ (not (string-match "\\<Index\\>" Info-current-node))
+ ;; Don't take time to annotate huge menus
+ (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
+ (let ((n 0)
+ cont)
+ (while (re-search-forward
+ (concat "^\\* +\\(" Info-menu-entry-name-re "\\)\\(:"
+ Info-node-spec-re "\\([ \t]*\\)\\)")
+ nil t)
+ (when not-fontified-p
+ (setq n (1+ n))
+ (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys
+ (put-text-property (match-beginning 0)
+ (1+ (match-beginning 0))
+ 'font-lock-face 'info-menu-5)))
+ (when not-fontified-p
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ (list
+ 'help-echo (if (match-end 3)
+ (concat "mouse-2: go to " (match-string 3))
+ "mouse-2: go to this node")
+ 'mouse-face 'highlight)))
+ (when (or not-fontified-p fontify-visited-p)
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ (list
+ 'font-lock-face
+ ;; Display visited menu items in a different face
+ (if (and Info-fontify-visited-nodes
+ (save-match-data
+ (let ((node (if (equal (match-string 3) "")
+ (match-string 1)
+ (match-string 3)))
+ (file (file-name-nondirectory Info-current-file))
+ (hl Info-history-list)
+ res)
+ (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
+ (setq file (match-string 1 node)
+ node (if (equal (match-string 2 node) "")
+ "Top"
+ (match-string 2 node))))
+ (while hl
+ (if (and (string-equal node (nth 1 (car hl)))
+ (string-equal file
+ (file-name-nondirectory
+ (nth 0 (car hl)))))
+ (setq res (car hl) hl nil)
+ (setq hl (cdr hl))))
+ res))) 'info-xref-visited 'info-xref))))
+ (when (and not-fontified-p (memq Info-hide-note-references '(t hide)))
+ (put-text-property (match-beginning 2) (1- (match-end 6))
+ 'invisible t)
+ ;; Unhide the file name in parens
+ (if (and (match-end 4) (not (eq (char-after (match-end 4)) ?.)))
+ (remove-text-properties (match-beginning 4) (match-end 4)
+ '(invisible t)))
+ ;; We need a stretchable space like :align-to but with
+ ;; a minimum value.
+ (put-text-property (1- (match-end 6)) (match-end 6) 'display
+ (if (>= 22 (- (match-end 1)
+ (match-beginning 0)))
+ '(space :align-to 24)
+ '(space :width 2)))
+ (setq cont (looking-at "."))
+ (while (and (= (forward-line 1) 0)
+ (looking-at "\\([ \t]+\\)[^*\n]"))
+ (put-text-property (match-beginning 1) (1- (match-end 1))
+ 'invisible t)
+ (put-text-property (1- (match-end 1)) (match-end 1)
+ 'display
+ (if cont
+ '(space :align-to 26)
+ '(space :align-to 24)))
+ (setq cont t))))))
+
+ ;; Fontify menu headers
+ ;; Add the face `info-menu-header' to any header before a menu entry
+ (goto-char (point-min))
+ (when (and not-fontified-p (re-search-forward "^\\* Menu:" nil t))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'font-lock-face 'info-menu-header)
+ (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-face 'info-menu-header)))
+
+ ;; Fontify http and ftp references
+ (goto-char (point-min))
+ (when not-fontified-p
+ (while (re-search-forward "[hf]t?tp://[^ \t\n\"`({<>})']+" nil t)
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(font-lock-face info-xref
+ mouse-face highlight
+ help-echo "mouse-2: go to this URL"))))
+
+ (set-buffer-modified-p nil))))
HCoop / bpt / emacs.git / blobdiff