106 |
(goto-char (point-min)) |
(goto-char (point-min)) |
107 |
(if (re-search-forward |
(if (re-search-forward |
108 |
"^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*" |
"^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*" |
109 |
(save-excursion (forward-line 100) (point)) t) |
(line-beginning-position 100) t) |
110 |
(expand-file-name (match-string 1))))))) |
(expand-file-name (match-string 1))))))) |
111 |
(prompt (if default-filename |
(prompt (if default-filename |
112 |
(format "Info file (%s): " default-filename) |
(format "Info file (%s): " default-filename) |
113 |
"Info file: "))) |
"Info file: "))) |
114 |
(read-file-name prompt |
(read-file-name prompt nil default-filename t)))) |
|
default-directory |
|
|
default-filename |
|
|
t)))) |
|
115 |
(info-xref-check-list (list filename))) |
(info-xref-check-list (list filename))) |
116 |
|
|
117 |
;;;###autoload |
;;;###autoload |
136 |
things are returned if for instance a source code directory is in the path." |
things are returned if for instance a source code directory is in the path." |
137 |
|
|
138 |
(info-initialize) ;; establish Info-directory-list |
(info-initialize) ;; establish Info-directory-list |
139 |
(apply 'append |
(apply 'nconc |
140 |
(mapcar |
(mapcar |
141 |
(lambda (dir) |
(lambda (dir) |
142 |
(let ((result nil)) |
(let ((result nil)) |
143 |
(dolist (name (directory-files dir t)) |
(dolist (name (directory-files dir t)) |
144 |
(if (and (not (file-directory-p name)) |
(unless (or (file-directory-p name) (info-xref-subfile-p name)) |
145 |
(not (info-xref-subfile-p name))) |
(push name result))) |
146 |
(setq result (cons name result)))) |
(nreverse result))) |
|
(reverse result))) |
|
147 |
(append Info-directory-list Info-additional-directory-list)))) |
(append Info-directory-list Info-additional-directory-list)))) |
148 |
|
|
149 |
(defun info-xref-subfile-p (filename) |
(defun info-xref-subfile-p (filename) |
207 |
"\\*[Nn]ote[ \n\t]+[^:]*:[ \n\t]+\\(\\(([^)]+)\\)[^.,]+\\)[.,]" |
"\\*[Nn]ote[ \n\t]+[^:]*:[ \n\t]+\\(\\(([^)]+)\\)[^.,]+\\)[.,]" |
208 |
nil t) |
nil t) |
209 |
(let* ((file (match-string 2)) |
(let* ((file (match-string 2)) |
210 |
(node (info-xref-whitespace (match-string 1)))) |
(node ;; Canonicalize spaces: we could use "[\t\n ]+" but |
211 |
|
;; we try to avoid uselessly replacing " " with " ". |
212 |
|
(replace-regexp-in-string "[\t\n][\t\n ]*\\| [\t\n ]+" " " |
213 |
|
(match-string 1) t t))) |
214 |
;; see if the file exists, if we haven't tried it before |
;; see if the file exists, if we haven't tried it before |
215 |
(unless (assoc file info-xref-xfile-alist) |
(unless (assoc file info-xref-xfile-alist) |
216 |
(let ((found (info-xref-goto-node-p file))) |
(let ((found (info-xref-goto-node-p file))) |
217 |
(setq info-xref-xfile-alist (cons (cons file found) |
(push (cons file found) info-xref-xfile-alist) |
218 |
info-xref-xfile-alist)) |
(unless found |
219 |
(if (not found) |
(info-xref-output (format "Not available to check: %s\n" file))))) |
|
(info-xref-output |
|
|
(format "Not available to check: %s\n" file))))) |
|
220 |
;; if the file exists, try the node, if we haven't before |
;; if the file exists, try the node, if we haven't before |
221 |
(when (cdr (assoc file info-xref-xfile-alist)) |
(when (cdr (assoc file info-xref-xfile-alist)) |
222 |
(unless (assoc node info-xref-xfile-alist) |
(unless (assoc node info-xref-xfile-alist) |
228 |
(defun info-xref-output (str) |
(defun info-xref-output (str) |
229 |
"Emit STR as an info-xref result message." |
"Emit STR as an info-xref result message." |
230 |
(with-current-buffer info-xref-results-buffer |
(with-current-buffer info-xref-results-buffer |
231 |
(insert info-xref-filename-heading) |
(insert info-xref-filename-heading str) |
232 |
(setq info-xref-filename-heading "") |
(setq info-xref-filename-heading ""))) |
|
(insert str))) |
|
233 |
|
|
234 |
;; When asking Info-goto-node to fork, *info* needs to be the current |
;; When asking Info-goto-node to fork, *info* needs to be the current |
235 |
;; buffer, otherwise it seems to clone the current buffer but then do the |
;; buffer, otherwise it seems to clone the current buffer but then do the |
243 |
;; this difference by checking before killing. |
;; this difference by checking before killing. |
244 |
;; |
;; |
245 |
(defun info-xref-goto-node-p (node) |
(defun info-xref-goto-node-p (node) |
246 |
"Return t if it's possible to goto the given NODE." |
"Return t if it's possible to go to the given NODE." |
247 |
(let ((oldbuf (current-buffer))) |
(let ((oldbuf (current-buffer))) |
248 |
(save-excursion |
(save-excursion |
249 |
(save-window-excursion |
(save-window-excursion |
259 |
(unless (equal (current-buffer) oldbuf) |
(unless (equal (current-buffer) oldbuf) |
260 |
(kill-buffer (current-buffer)))))))) |
(kill-buffer (current-buffer)))))))) |
261 |
|
|
|
;; Can this be done better? |
|
|
(defun info-xref-whitespace (str) |
|
|
"In STR, convert tabs and newlines to spaces, collapse repeated spaces." |
|
|
(setq str (copy-sequence str)) |
|
|
(dotimes (i (length str)) |
|
|
(let ((c (elt str i))) |
|
|
(if (or (= c ?\n) |
|
|
(= c ?\t)) |
|
|
(aset str i ? )))) |
|
|
(let ((dst 0) |
|
|
(prev -1)) |
|
|
(dotimes (i (length str)) |
|
|
(let ((c (elt str i))) |
|
|
(unless (and (= c ? ) |
|
|
(= prev ? )) |
|
|
(aset str dst c) |
|
|
(setq dst (1+ dst))) |
|
|
(setq prev c))) |
|
|
(setq str (substring str 0 dst))) |
|
|
str) |
|
|
|
|
262 |
(provide 'info-xref) |
(provide 'info-xref) |
263 |
|
|
264 |
;;; info-xref.el ends here |
;;; info-xref.el ends here |