Commit 6af7040d authored by Stefan Monnier's avatar Stefan Monnier

(Info-streamline-headings): New var.

(Info-dir-remove-duplicates): New fun.
(Info-insert-dir): Use it.  Simplify the code with push,mapc,dolist.
(Info-select-node): Simplify handling of Info-header-line.
(Info-forward-node): Undo 2000/12/15 since we don't narrow any more.
(Info-mode): Set header-line-format once and for all.
(Info-fontify-node): Accept bogus first line with `File:' missing.
Only make first line invisible if Info-use-header-line.
Don't use `intangible': it's evil.  Use inhibit-read-only.
(Info-follow-reference, Info-next-reference, Info-prev-reference)
(Info-try-follow-nearest-node): Don't bind inhibit-point-motion-hooks
since we don't use intangible any more.
parent 538f9462
......@@ -815,10 +815,8 @@ a case-insensitive match is tried."
(insert-file-contents file)
(make-local-variable 'Info-dir-file-name)
(setq Info-dir-file-name file)
(setq buffers (cons (current-buffer) buffers)
Info-dir-file-attributes
(cons (cons file attrs)
Info-dir-file-attributes)))
(push (current-buffer) buffers)
(push (cons file attrs) Info-dir-file-attributes))
(error (kill-buffer (current-buffer))))))))
(or (cdr dirs) (setq Info-dir-contents-directory
(file-name-as-directory (car dirs))))
......@@ -839,48 +837,34 @@ a case-insensitive match is tried."
(insert-buffer buffer)
;; Look at each of the other buffers one by one.
(while others
(let ((other (car others))
;; Bind this in case the user sets it to nil.
(case-fold-search t)
this-buffer-nodes)
(dolist (other others)
(let (this-buffer-nodes)
;; In each, find all the menus.
(save-excursion
(set-buffer other)
(with-current-buffer other
(goto-char (point-min))
;; Find each menu, and add an elt to NODES for it.
(while (re-search-forward "^\\* Menu:" nil t)
(let (beg nodename end)
(forward-line 1)
(while (and (eolp) (not (eobp)))
(forward-line 1))
(setq beg (point))
(or (search-backward "\n\^_" nil 'move)
(looking-at "\^_")
(signal 'search-failed (list "\n\^_")))
(while (and (zerop (forward-line 1)) (eolp)))
(let ((beg (point))
nodename end)
(re-search-backward "^\^_")
(search-forward "Node: ")
(setq nodename (Info-following-node-name))
(search-forward "\n\^_" nil 'move)
(beginning-of-line)
(setq end (point))
(setq this-buffer-nodes
(cons (list nodename other beg end)
this-buffer-nodes))))
(push (list nodename other beg end) this-buffer-nodes)))
(if (assoc-ignore-case "top" this-buffer-nodes)
(setq nodes (nconc this-buffer-nodes nodes))
(setq problems t)
(message "No `top' node in %s" Info-dir-file-name))))
(setq others (cdr others)))
(message "No `top' node in %s" Info-dir-file-name)))))
;; Add to the main menu a menu item for each other node.
(let ((case-fold-search t)
(re-search-forward "^\\* Menu:")))
(re-search-forward "^\\* Menu:")
(forward-line 1)
(let ((menu-items '("top"))
(nodes nodes)
(case-fold-search t)
(end (save-excursion (search-forward "\^_" nil t) (point))))
(while nodes
(let ((nodename (car (car nodes))))
(dolist (node nodes)
(let ((nodename (car node)))
(save-excursion
(or (member (downcase nodename) menu-items)
(re-search-forward (concat "^\\* +"
......@@ -889,13 +873,12 @@ a case-insensitive match is tried."
end t)
(progn
(insert "* " nodename "::" "\n")
(setq menu-items (cons nodename menu-items))))))
(setq nodes (cdr nodes))))
(push nodename menu-items)))))))
;; Now take each node of each of the other buffers
;; and merge it into the main buffer.
(while nodes
(dolist (node nodes)
(let ((case-fold-search t)
(nodename (car (car nodes))))
(nodename (car node)))
(goto-char (point-min))
;; Find the like-named node in the main buffer.
(if (re-search-forward (concat "^\^_.*\n.*Node: "
......@@ -911,12 +894,10 @@ a case-insensitive match is tried."
(insert "\^_\nFile: dir\tNode: " nodename "\n\n* Menu:\n\n"))
;; Merge the text from the other buffer's menu
;; into the menu in the like-named node in the main buffer.
(apply 'insert-buffer-substring (cdr (car nodes))))
(setq nodes (cdr nodes)))
(apply 'insert-buffer-substring (cdr node))))
(Info-dir-remove-duplicates)
;; Kill all the buffers we just made.
(while buffers
(kill-buffer (car buffers))
(setq buffers (cdr buffers)))
(mapc 'kill-buffer buffers)
(goto-char (point-min))
(if problems
(message "Composing main Info directory...problems encountered, see `*Messages*'")
......@@ -924,6 +905,70 @@ a case-insensitive match is tried."
(setq Info-dir-contents (buffer-string)))
(setq default-directory Info-dir-contents-directory))
(defvar Info-streamline-headings
'(("Emacs" . "Emacs")
("Programming" . "Programming")
("Libraries" . "Libraries")
("World Wide Web\\|Net Utilities" . "Net Utilities"))
"List of elements (RE . NAME) to merge headings matching RE to NAME.")
(defun Info-dir-remove-duplicates ()
(let (limit)
(goto-char (point-min))
;; Remove duplicate headings in the same menu.
(while (search-forward "\n* Menu:" nil t)
(setq limit (save-excursion (search-forward "\n" nil t)))
;; Look for the next heading to unify.
(while (re-search-forward "^\\(\\w.*\\)\n\\*" limit t)
(let ((name (match-string 1))
(start (match-beginning 0))
(entries nil) re)
;; Check whether this heading should be streamlined.
(save-match-data
(dolist (x Info-streamline-headings)
(when (string-match (car x) name)
(setq name (cdr x))
(setq re (car x)))))
(if re (replace-match name t t nil 1))
(goto-char (if (re-search-forward "^[^* \n\t]" limit t)
(match-beginning 0)
(or limit (point-max))))
;; Look for other headings of the same category and merge them.
(save-excursion
(while (re-search-forward "^\\(\\w.*\\)\n\\*" limit t)
(when (if re (save-match-data (string-match re (match-string 1)))
(equal name (match-string 1)))
(forward-line 0)
;; Delete redundant heading.
(delete-region (match-beginning 0) (point))
;; Push the entries onto `text'.
(push
(delete-and-extract-region
(point)
(if (re-search-forward "^[^* \n\t]" nil t)
(match-beginning 0)
(or limit (point-max)))) entries))))
;; Insert the entries just found.
(while (= (line-beginning-position 0) (1- (point)))
(backward-char))
(dolist (entry (nreverse entries))
(insert entry)
(while (= (line-beginning-position 0) (1- (point)))
(delete-region (1- (point)) (point))))
;; Now remove duplicate entries under the same heading.
(let ((seen nil)
(limit (point)))
(goto-char start)
(while (re-search-forward "^* \\([^:\n]+:\\(:\\|[^.\n]+\\).\\)"
limit 'move)
(let ((x (match-string 1)))
(if (member-ignore-case x seen)
(delete-region (match-beginning 0)
(progn (re-search-forward "^[^ \t]" nil t)
(goto-char (match-beginning 0))))
(push x seen))))))))))
;; Note that on entry to this function the current-buffer must be the
;; *info* buffer; not the info tags buffer.
(defun Info-read-subfile (nodepos)
......@@ -1014,17 +1059,7 @@ Bind this in case the user sets it to nil."
(point-max)))
(if Info-enable-active-nodes (eval active-expression))
(Info-fontify-node)
(if Info-use-header-line
(progn
(setq Info-header-line
(get-text-property (point-min) 'header-line))
(setq header-line-format 'Info-header-line)
;;; It is useful to be able to copy the links line out of the buffer
;;; with M-w.
;;; (narrow-to-region (1+ header-end) (point-max))
)
(setq Info-header-line nil)
(setq header-line-format nil)) ; so the header line isn't displayed
(setq Info-header-line (get-text-property (point-min) 'header-line))
(run-hooks 'Info-selection-hook)))))
(defun Info-set-mode-line ()
......@@ -1251,10 +1286,6 @@ Bind this in case the user sets it to nil."
(save-excursion
(save-restriction
(goto-char (point-min))
;;; (when Info-header-line
;;; ;; expose the header line in the buffer
;;; (widen)
;;; (forward-line -1))
(let ((bound (point)))
(forward-line 1)
(cond ((re-search-backward (concat name ":") bound t)
......@@ -1326,7 +1357,6 @@ FOOTNOTENAME may be an abbreviation of the reference name."
(interactive
(let ((completion-ignore-case t)
(case-fold-search t)
(inhibit-point-motion-hooks t)
completions default alt-default (start-point (point)) str i bol eol)
(save-excursion
;; Store end and beginning of line.
......@@ -1391,7 +1421,6 @@ FOOTNOTENAME may be an abbreviation of the reference name."
(error "No reference was specified"))
(let (target beg i (str (concat "\\*note " (regexp-quote footnotename)))
(inhibit-point-motion-hooks t)
(case-fold-search t))
(while (setq i (string-match " " str i))
(setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
......@@ -1609,28 +1638,10 @@ N is the digit argument used to invoke this command."
(not (string-match "\\<index\\>" Info-current-node)))
(Info-goto-node (Info-extract-menu-counting 1))
t)
((save-excursion
(save-restriction
(let (limit)
(when Info-header-line
(goto-char (point-min))
(widen)
(forward-line -1)
(setq limit (point))
(forward-line 1))
(search-backward "next:" limit t))))
((save-excursion (search-backward "next:" nil t))
(Info-next)
t)
((and (save-excursion
(save-restriction
(let (limit)
(when Info-header-line
(goto-char (point-min))
(widen)
(forward-line -1)
(setq limit (point))
(forward-line 1))
(search-backward "up:" limit t))))
((and (save-excursion (search-backward "up:" nil t))
;; Use string-equal, not equal, to ignore text props.
(not (string-equal (downcase (Info-extract-pointer "up"))
"top")))
......@@ -1819,7 +1830,6 @@ parent node."
"Move cursor to the next cross-reference or menu item in the node."
(interactive)
(let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
(inhibit-point-motion-hooks t)
(old-pt (point))
(case-fold-search t))
(or (eobp) (forward-char 1))
......@@ -1840,7 +1850,6 @@ parent node."
"Move cursor to the previous cross-reference or menu item in the node."
(interactive)
(let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
(inhibit-point-motion-hooks t)
(old-pt (point))
(case-fold-search t))
(or (re-search-backward pat nil t)
......@@ -2069,8 +2078,7 @@ If no reference to follow, moves to the next node, or up if none."
;; Common subroutine.
(defun Info-try-follow-nearest-node ()
"Follow a node reference near point. Return non-nil if successful."
(let (node
(inhibit-point-motion-hooks t))
(let (node)
(cond
((setq node (Info-get-token (point) "\\*note[ \n]"
"\\*note[ \n]\\([^:]*\\):"))
......@@ -2365,6 +2373,7 @@ Advanced commands:
(make-local-variable 'Info-history)
(make-local-variable 'Info-index-alternatives)
(make-local-variable 'Info-header-line)
(setq header-line-format (if Info-use-header-line 'Info-header-line))
(set (make-local-variable 'tool-bar-map) info-tool-bar-map)
;; This is for the sake of the invisible text we use handling titles.
(make-local-variable 'line-move-ignore-invisible)
......@@ -2645,16 +2654,13 @@ the variable `Info-file-list-for-emacs'."
"Keymap to put on the Up link in the text or the header line.")
(defun Info-fontify-node ()
;; 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 (< (next-property-change (point-min) nil (point-max))
(point-max))
;; Only fontify the node if it hasn't already been done.
(unless (next-property-change (point-min))
(save-excursion
(let ((buffer-read-only nil)
(let ((inhibit-read-only t)
(case-fold-search t))
(goto-char (point-min))
(when (looking-at "^File: [^,: \t]+,?[ \t]+")
(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))
......@@ -2673,42 +2679,39 @@ the variable `Info-file-list-for-emacs'."
;; Always set up the text property keymap.
;; It will either be used in the buffer
;; or copied in the header line.
(cond ((equal tag "Prev")
(put-text-property tbeg nend 'keymap
Info-prev-link-keymap))
((equal tag "Next")
(put-text-property tbeg nend 'keymap
Info-next-link-keymap))
((equal tag "Up")
(put-text-property tbeg nend 'keymap
Info-up-link-keymap))))))
(goto-char (point-min))
(let ((header-end (save-excursion (end-of-line) (point)))
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]*" nil 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))))
(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 (save-excursion (end-of-line) (point)))
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]*" nil 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)
......@@ -2725,7 +2728,7 @@ the variable `Info-file-list-for-emacs'."
;; 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))))
'(invisible t))))
(goto-char (point-min))
(while (re-search-forward "\\(\\*Note[ \n\t]+\\)\\([^:]*\\)\\(:[^.,:]*[,:]?\\)" nil t)
(unless (= (char-after (1- (match-beginning 0))) ?\") ; hack
......@@ -2748,15 +2751,15 @@ the variable `Info-file-list-for-emacs'."
(if hide-tag
(add-text-properties (match-beginning 1) (match-end 1)
(if other-tag
(list 'display other-tag 'intangible t)
'(invisible t intangible t))))
(list 'display other-tag)
'(invisible t))))
(add-text-properties (match-beginning 2) (match-end 2)
'(font-lock-face info-xref
mouse-face highlight
help-echo "mouse-2: go to this node"))
(if (eq Info-hide-note-references t)
(add-text-properties (match-beginning 3) (match-end 3)
'(invisible t intangible t))))))
'(invisible t))))))
(goto-char (point-min))
(if (and (search-forward "\n* Menu:" nil t)
......@@ -2776,9 +2779,8 @@ the variable `Info-file-list-for-emacs'."
help-echo "mouse-2: go to this node"))
(if (eq Info-hide-note-references t)
(add-text-properties (match-beginning 2) (match-end 2)
(list 'display
(make-string (max 2 (- 22 (- (match-end 1) (match-beginning 1)))) ? )
'intangible t))))))
(list 'display
(make-string (max 2 (- 22 (- (match-end 1) (match-beginning 1)))) ? )))))))
(Info-fontify-menu-headers)
(set-buffer-modified-p nil)))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment