- ;; Only fontify the node if it hasn't already been done.
- (unless (let ((where (next-property-change (point-min))))
- (and where (not (= where (point-max)))))
- (save-excursion
- (let ((inhibit-read-only t)
- (case-fold-search t)
- paragraph-markers)
- (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 (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 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)))))
- (goto-char (point-min))
- (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))))
- (goto-char (point-min))
- (while (re-search-forward "\\(\\*Note[ \t]*\\)\n?[ \t]*\\([^:]*\\)\\(:[^.,:(]*\\(([^)]*)[^.,:]*\\)?[,:]?\n?\\)" nil t)
- (unless (= (char-after (1- (match-beginning 0))) ?\") ; hack
- (let ((start (match-beginning 0))
- (next (point))
- (hide-tag Info-hide-note-references)
- other-tag)
- (when hide-tag
- ;; *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))
- (if hide-tag
- (add-text-properties (match-beginning 1) (match-end 1)
- '(invisible t front-sticky nil rear-nonsticky t)))
- (add-text-properties
- (match-beginning 2) (match-end 2)
- (cons 'help-echo
- (cons (if (match-end 4)
- (concat "mouse-2: go to " (match-string 4))
- "mouse-2: go to this node")
- '(font-lock-face info-xref
- mouse-face highlight))))
- (when (eq Info-hide-note-references t)
- (add-text-properties (match-beginning 3) (match-end 3)
- '(invisible t front-sticky nil rear-nonsticky t)))
- (when other-tag
- (save-excursion
- (goto-char (match-beginning 1))
- (insert other-tag)))
- (when (and Info-refill-paragraphs
- (or hide-tag (eq Info-hide-note-references t)))
- (push (set-marker (make-marker) start)
- paragraph-markers)))))
-
- (when (and 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)))))
-
- (goto-char (point-min))
- (when (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)
- cont)
- (while (re-search-forward
- (concat "^\\* +\\(" Info-menu-entry-name-re "\\)\\(:"
- Info-node-spec-re "\\([ \t]*\\)\\)")
- nil t)
- (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))
- (add-text-properties
- (match-beginning 1) (match-end 1)
- (cons 'help-echo
- (cons
- (if (match-end 3)
- (concat "mouse-2: go to " (match-string 3))
- "mouse-2: go to this node")
- '(font-lock-face info-xref
- mouse-face highlight))))
- (when (eq Info-hide-note-references t)
+ "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)))
+ rbeg rend)
+
+ ;; 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 "mouse-2: 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
+ (replace-regexp-in-string
+ "%"
+ ;; Preserve text properties on duplicated `%'.
+ (lambda (s) (concat s s)) 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)
+ ((= c ?=) 'info-title-2)
+ ((= c ?-) 'info-title-3)
+ (t 'info-title-4))))
+ (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
+ (when (not (eq Info-hide-note-references 'hide))
+ ;; *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 other-tag
+ `(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)
+ (setq rbeg (match-beginning 2)
+ rend (match-end 2))
+ (put-text-property
+ rbeg rend
+ '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 (file-name-nondirectory
+ (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))
+ ;; For multiline ref, unfontify newline and surrounding whitespace
+ (save-excursion
+ (goto-char rbeg)
+ (save-match-data
+ (while (re-search-forward "\\s-*\n\\s-*" rend t nil)
+ (remove-text-properties (match-beginning 0)
+ (match-end 0)
+ '(font-lock-face t))))))
+ (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 (and (match-string 6) (not (eq Info-hide-note-references 'hide)))
+ (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 ((beg3 (match-beginning 3))
+ (end3 (match-end 3)))
+ (if (and (string-match "\n[ \t]*" (match-string 3))
+ (not (save-match-data
+ (save-excursion
+ (goto-char (1+ end3))
+ (looking-at "[.)]*$")))))
+ (remove-text-properties (+ beg3 (match-beginning 0))
+ (+ beg3 (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 (Info-index-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 "^\\* Menu:\\|\\(?:^\\* +\\(" Info-menu-entry-name-re "\\)\\(:"
+ Info-node-spec-re "\\([ \t]*\\)\\)\\)")
+ nil t)
+ (when (match-beginning 1)
+ (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-star)))
+ (when not-fontified-p
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ (list
+ 'help-echo (if (and (match-end 3)
+ (not (equal (match-string 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 (file-name-nondirectory
+ (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)))