Function: Info-fontify-node
Info-fontify-node is a byte-compiled function defined in info.el.gz.
Signature
(Info-fontify-node)
Documentation
Fontify the node.
Source Code
;; Defined in /usr/src/emacs/lisp/info.el.gz
(defun Info-fontify-node ()
"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-single-property-change (point-min)
'font-lock-face)))
(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
Info-fontify-maximum-menu-size
(or (eq Info-fontify-maximum-menu-size t)
(< (- (point-max) (point-min))
Info-fontify-maximum-menu-size))))
;; Disable Info-hide-note-references in nodes that are
;; incompatible with that feature.
(Info-hide-note-references
(if (member Info-current-node
(assoc-string
(file-name-sans-extension
(file-name-nondirectory Info-current-file))
Info--dont-hide-references))
nil
Info-hide-note-references))
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 (downcase 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 'header-line-highlight)
(put-text-property tbeg nend
'help-echo
(concat "mouse-2: Go to node "
(buffer-substring nbeg nend)))
;; Set up the text property keymap. Depending on
;; `Info-use-header-line', it is either used in the
;; buffer, or copied to the header line. A symbol value
;; of the `link-args' property is handled specially by
;; `Info-mouse-follow-link'.
(put-text-property tbeg nend 'keymap Info-link-keymap)
(put-text-property tbeg nend 'link-args
(intern (downcase tag))))))
;; (when (> Info-breadcrumbs-depth 0)
;; (insert (Info-breadcrumbs)))
;; Treat header line.
(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))
(buffer-substring (point) header-end))
(if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*"
header-end t)
(concat "No next, prev or up links -- "
(buffer-substring (point) header-end))
(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.
(cond
((> Info-breadcrumbs-depth 0)
(let ((ov (make-overlay (point-min) (1+ header-end))))
(overlay-put ov 'display (Info-breadcrumbs))
(overlay-put ov 'evaporate t)))
((not (bobp))
;; Hide the punctuation at the end, too.
(skip-chars-backward " \t,")
(put-text-property (point) header-end 'invisible t)
;; Hide the suffix of the Info file name.
(beginning-of-line)
(if (re-search-forward
(format "File: %s\\([^,\n\t]+\\),"
(if (stringp Info-current-file)
(file-name-sans-extension
(file-name-nondirectory Info-current-file))
Info-current-file))
header-end t)
(put-text-property (match-beginning 1) (match-end 1)
'invisible t)))))))
;; Fontify titles
(goto-char (point-min))
(when (and font-lock-mode not-fontified-p)
(while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*\\*+\\|==+\\|--+\\|\\.\\.+\\)$"
nil t)
;; Only consider it as an underlined title if the ASCII
;; underline has the same size as the text. A typical
;; counter example is when a continuation "..." is alone
;; on a line.
(when (= (string-width (match-string 1))
(string-width (match-string 2)))
(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 (display-multi-font-p)
(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 (and (not (eq Info-hide-note-references 'hide))
(> (line-number-at-pos) 4)) ; Skip breadcrumbs
;; *Note is often used where *note should have been
(goto-char start)
(skip-syntax-backward " ")
(when (memq (char-before) '(?\( ?\[ ?\{))
;; Check whether the paren is preceded by
;; an end of sentence
(skip-syntax-backward " ("))
(setq other-tag
(cond ((save-match-data (looking-back "\\(^\\|[ (]\\)see"
(- (point) 4)))
"")
;; We want "Also *note" to produce
;; "Also see", but "See also *note" to produce
;; "See also", so match case-sensitively.
((save-match-data (let ((case-fold-search nil))
(looking-back "\\(^\\| \\)also"
(- (point) 5))))
"")
((save-match-data (looking-back "\\(^\\| \\)in"
(- (point) 3)))
"")
((memq (char-before) '(nil ?\. ?! ??))
"See ")
((save-match-data
(save-excursion
(search-forward "\n\n" start t)))
"See ")
(t "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-no-properties 5)
(and (not (equal (match-string 4) ""))
(match-string-no-properties 4))
(match-string-no-properties 2)))))
(external-link-p
(string-match "(\\([^)]+\\))\\([^)]*\\)" node))
(file (if external-link-p
(file-name-nondirectory
(match-string-no-properties 1 node))
Info-current-file))
(hl Info-history-list)
res)
(if external-link-p
(setq node (if (equal (match-string 2 node) "")
"Top"
(match-string-no-properties 2 node))))
(while hl
(if (and (string-equal node (nth 1 (car hl)))
(equal file
(if (and external-link-p
(stringp (caar hl)))
(file-name-nondirectory
(caar hl))
(caar 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))
(dolist (m 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)
;; Don't take time to annotate huge menus
Info-fontify-maximum-menu-size
(or (eq Info-fontify-maximum-menu-size t)
(< (- (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)
(put-text-property
(match-beginning 1) (match-end 1)
'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-no-properties 1)
(match-string-no-properties 3)))
(external-link-p
(string-match "(\\([^)]+\\))\\([^)]*\\)" node))
(file (if external-link-p
(file-name-nondirectory
(match-string-no-properties 1 node))
Info-current-file))
(hl Info-history-list)
res)
(if external-link-p
(setq node (if (equal (match-string 2 node) "")
"Top"
(match-string-no-properties 2 node))))
(while hl
(if (and (string-equal node (nth 1 (car hl)))
(equal file
(if (and external-link-p
(stringp (caar hl)))
(file-name-nondirectory
(caar hl))
(caar 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))
(not (Info-index-node)))
(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)))
;; Hide index line numbers
(goto-char (point-min))
(when (and not-fontified-p (Info-index-node))
(while (re-search-forward "[ \t\n]*(line +[0-9]+)" nil t)
(put-text-property (match-beginning 0) (match-end 0)
'invisible t)))
;; Fontify http and ftp references
(goto-char (point-min))
(when not-fontified-p
(while (re-search-forward "\\(https?\\|ftp\\)://[^ \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"))))
;; Fontify footnotes
(goto-char (point-min))
(when (and not-fontified-p (re-search-forward "^[ \t]*-+ Footnotes -+$" nil t))
(let ((limit (point))
(fncount 0))
;; How many footnotes do we have in this node?
(while (re-search-forward "^ [ \t]*([0-9]+) " nil t)
(setq fncount (1+ fncount)))
(goto-char (point-min))
(while (re-search-forward "\\((\\([0-9]+\\))\\)" nil t)
(let ((footnote-num (string-to-number (match-string 2))))
;; Don't fontify parenthesized numbers that cannot
;; possibly be one of this node's footnotes. This still
;; doesn't catch unrelated numbers that happen to be
;; small enough, but in that case they should use
;; "@footnotestyle separate" in the Texinfo sources.
(when (and (> footnote-num 0)
(<= footnote-num fncount))
(add-text-properties (match-beginning 0) (match-end 0)
`(font-lock-face info-xref
link t
mouse-face highlight
help-echo
,(if (< (point) limit)
"mouse-2: go to footnote definition"
"mouse-2: go to footnote reference"))))))))
;; Hide empty lines at the end of the node.
(goto-char (point-max))
(skip-chars-backward "\n")
(when (< (point) (1- (point-max)))
(put-text-property (point) (1- (point-max)) 'invisible t))
(set-buffer-modified-p nil))))