Mercurial > hg > xemacs-beta

comparison lisp/info.el @ 380:8626e4521993 r21-2-5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents a300bb07d72d
children 7d59cb494b73
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
311 ;; Modified 1998-09-23 by Didier Verna <verna@inf.enst.fr> 311 ;; Modified 1998-09-23 by Didier Verna <verna@inf.enst.fr>
312 ;; 312 ;;
313 ;; Use the new macro `with-search-caps-disable-folding' 313 ;; Use the new macro `with-search-caps-disable-folding'
314 314
315 ;; Code: 315 ;; Code:
316 (eval-when-compile
317 (condition-case nil (require 'browse-url) (error nil)))
316 318
317 (defgroup info nil 319 (defgroup info nil
318 "The info package for Emacs." 320 "The info package for Emacs."
319 :group 'help 321 :group 'help
320 :group 'docs) 322 :group 'docs)
458 (defvar Info-suffix-list '( ("" . nil) 460 (defvar Info-suffix-list '( ("" . nil)
459 (".info" . nil) 461 (".info" . nil)
460 (".info.gz" . "gzip -dc %s") 462 (".info.gz" . "gzip -dc %s")
461 (".info-z" . "gzip -dc %s") 463 (".info-z" . "gzip -dc %s")
462 (".info.Z" . "uncompress -c %s") 464 (".info.Z" . "uncompress -c %s")
465 (".bz2" . "bzip2 -dc %s")
463 (".gz" . "gzip -dc %s") 466 (".gz" . "gzip -dc %s")
464 (".Z" . "uncompress -c %s") 467 (".Z" . "uncompress -c %s")
465 (".zip" . "unzip -c %s") ) 468 (".zip" . "unzip -c %s") )
466 "List of file name suffixes and associated decoding commands. 469 "List of file name suffixes and associated decoding commands.
467 Each entry should be (SUFFIX . STRING); if STRING contains %s, that is 470 Each entry should be (SUFFIX . STRING); if STRING contains %s, that is
802 actually get any text from." 805 actually get any text from."
803 (if (and Info-dir-contents Info-dir-file-attributes 806 (if (and Info-dir-contents Info-dir-file-attributes
804 ;; Verify that none of the files we used has changed 807 ;; Verify that none of the files we used has changed
805 ;; since we used it. 808 ;; since we used it.
806 (eval (cons 'and 809 (eval (cons 'and
807 (mapcar '(lambda (elt) 810 (mapcar #'(lambda (elt)
808 (let ((curr (file-attributes (car elt)))) 811 (let ((curr (file-attributes (car elt))))
809 ;; Don't compare the access time. 812 ;; Don't compare the access time.
810 (if curr (setcar (nthcdr 4 curr) 0)) 813 (if curr (setcar (nthcdr 4 curr) 0))
811 (setcar (nthcdr 4 (cdr elt)) 0) 814 (setcar (nthcdr 4 (cdr elt)) 0)
812 (equal (cdr elt) curr))) 815 (equal (cdr elt) curr)))
813 Info-dir-file-attributes)))) 816 Info-dir-file-attributes))))
814 (insert Info-dir-contents) 817 (insert Info-dir-contents)
815 (let ((dirs (reverse Info-directory-list)) 818 (let ((dirs (reverse Info-directory-list))
816 buffers lbuffers buffer others nodes dirs-done) 819 buffers lbuffers buffer others nodes dirs-done)
817 820
1020 (let ((dir-mod-time (nth 5 (file-attributes file))) 1023 (let ((dir-mod-time (nth 5 (file-attributes file)))
1021 f-mod-time 1024 f-mod-time
1022 newer) 1025 newer)
1023 (setq Info-dir-newer-info-files nil) 1026 (setq Info-dir-newer-info-files nil)
1024 (mapcar 1027 (mapcar
1025 '(lambda (f) 1028 #'(lambda (f)
1026 (prog2 1029 (prog2
1027 (setq f-mod-time (nth 5 (file-attributes f))) 1030 (setq f-mod-time (nth 5 (file-attributes f)))
1028 (setq newer (or (> (car f-mod-time) (car dir-mod-time)) 1031 (setq newer (or (> (car f-mod-time) (car dir-mod-time))
1029 (and (= (car f-mod-time) (car dir-mod-time)) 1032 (and (= (car f-mod-time) (car dir-mod-time))
1030 (> (car (cdr f-mod-time)) (car (cdr dir-mod-time)))))) 1033 (> (car (cdr f-mod-time)) (car (cdr dir-mod-time))))))
1031 (if (and (file-readable-p f) 1034 (if (and (file-readable-p f)
1032 newer) 1035 newer)
1033 (setq Info-dir-newer-info-files 1036 (setq Info-dir-newer-info-files
1034 (cons f Info-dir-newer-info-files))))) 1037 (cons f Info-dir-newer-info-files)))))
1035 (directory-files (file-name-directory file) 1038 (directory-files (file-name-directory file)
1036 'fullname 1039 'fullname
1037 ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" 1040 ".*\\.info\\(\\.gz\\|\\.bz2\\|\\.Z\\|-z\\|\\.zip\\)?$"
1038 'nosort 1041 'nosort
1039 t)) 1042 t))
1040 Info-dir-newer-info-files)) 1043 Info-dir-newer-info-files))
1041 1044
1042 (defun Info-extract-dir-entry-from (file) 1045 (defun Info-extract-dir-entry-from (file)
1086 1089
1087 (defun Info-dump-dir-entries (entries) 1090 (defun Info-dump-dir-entries (entries)
1088 (let ((tab-width 8) 1091 (let ((tab-width 8)
1089 (description-col 0) 1092 (description-col 0)
1090 len) 1093 len)
1091 (mapcar '(lambda (e) 1094 (mapcar #'(lambda (e)
1092 (setq e (cdr e)) ; Drop filename 1095 (setq e (cdr e)) ; Drop filename
1093 (setq len (length (concat (car e) 1096 (setq len (length (concat (car e)
1094 (car (cdr e))))) 1097 (car (cdr e)))))
1095 (if (> len description-col) 1098 (if (> len description-col)
1096 (setq description-col len))) 1099 (setq description-col len)))
1097 entries) 1100 entries)
1098 (setq description-col (+ 5 description-col)) 1101 (setq description-col (+ 5 description-col))
1099 (mapcar '(lambda (e) 1102 (mapcar #'(lambda (e)
1100 (setq e (cdr e)) ; Drop filename 1103 (setq e (cdr e)) ; Drop filename
1101 (insert "* " (car e) ":" (car (cdr e))) 1104 (insert "* " (car e) ":" (car (cdr e)))
1102 (setq e (car (cdr (cdr e)))) 1105 (setq e (car (cdr (cdr e))))
1103 (while e 1106 (while e
1104 (indent-to-column description-col) 1107 (indent-to-column description-col)
1105 (insert (car e) "\n") 1108 (insert (car e) "\n")
1106 (setq e (cdr e)))) 1109 (setq e (cdr e))))
1107 entries) 1110 entries)
1108 (insert "\n"))) 1111 (insert "\n")))
1109 1112
1110 1113
1111 (defun Info-build-dir-anew (directory) 1114 (defun Info-build-dir-anew (directory)
1132 (erase-buffer) 1135 (erase-buffer)
1133 (insert Info-dir-prologue 1136 (insert Info-dir-prologue
1134 "Info files in " directory ":\n\n") 1137 "Info files in " directory ":\n\n")
1135 (Info-dump-dir-entries 1138 (Info-dump-dir-entries
1136 (mapcar 1139 (mapcar
1137 '(lambda (f) 1140 #'(lambda (f)
1138 (or (Info-extract-dir-entry-from f) 1141 (or (Info-extract-dir-entry-from f)
1139 (list 'dummy 1142 (list 'dummy
1140 (progn 1143 (progn
1141 (string-match "\\(.*\\)\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" 1144 (string-match "\\(.*\\)\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
1142 (file-name-nondirectory f)) 1145 (file-name-nondirectory f))
1143 (capitalize (match-string 1 (file-name-nondirectory f)))) 1146 (capitalize (match-string 1 (file-name-nondirectory f))))
1144 ":" 1147 ":"
1145 (list Info-no-description-string)))) 1148 (list Info-no-description-string))))
1146 info-files)) 1149 info-files))
1147 (if to-temp 1150 (if to-temp
1148 (set-buffer-modified-p nil) 1151 (set-buffer-modified-p nil)
1149 (save-buffer)) 1152 (save-buffer))
1150 (if to-temp 1153 (if to-temp
1197 (point-max))) 1200 (point-max)))
1198 (while next-section 1201 (while next-section
1199 (narrow-to-region mark next-section) 1202 (narrow-to-region mark next-section)
1200 (setq dir-section-contents (nreverse (Info-parse-dir-entries (point-min) 1203 (setq dir-section-contents (nreverse (Info-parse-dir-entries (point-min)
1201 (point-max)))) 1204 (point-max))))
1202 (mapcar '(lambda (file) 1205 (mapcar
1203 (setq dir-entry (assoc (downcase 1206 #'(lambda (file)
1204 (file-name-sans-extension 1207 (setq dir-entry (assoc (downcase
1205 (file-name-nondirectory file)))
1206 dir-section-contents)
1207 file-dir-entry (Info-extract-dir-entry-from file))
1208 (if dir-entry
1209 (if file-dir-entry
1210 ;; A dir entry in the info file takes precedence over an
1211 ;; existing entry in the dir file
1212 (setcdr dir-entry (cdr file-dir-entry)))
1213 (unless (or not-first-section
1214 (assoc (downcase
1215 (file-name-sans-extension 1208 (file-name-sans-extension
1216 (file-name-nondirectory file))) 1209 (file-name-nondirectory file)))
1217 dir-full-contents)) 1210 dir-section-contents)
1218 (if file-dir-entry 1211 file-dir-entry (Info-extract-dir-entry-from file))
1219 (setq dir-section-contents (cons file-dir-entry 1212 (if dir-entry
1220 dir-section-contents)) 1213 (if file-dir-entry
1221 (setq dir-section-contents 1214 ;; A dir entry in the info file takes precedence over an
1222 (cons (list 'dummy 1215 ;; existing entry in the dir file
1223 (capitalize (file-name-sans-extension 1216 (setcdr dir-entry (cdr file-dir-entry)))
1224 (file-name-nondirectory file))) 1217 (unless (or not-first-section
1225 ":" 1218 (assoc (downcase
1226 (list Info-no-description-string)) 1219 (file-name-sans-extension
1227 dir-section-contents)))))) 1220 (file-name-nondirectory file)))
1228 Info-dir-newer-info-files) 1221 dir-full-contents))
1222 (if file-dir-entry
1223 (setq dir-section-contents (cons file-dir-entry
1224 dir-section-contents))
1225 (setq dir-section-contents
1226 (cons (list 'dummy
1227 (capitalize (file-name-sans-extension
1228 (file-name-nondirectory file)))
1229 ":"
1230 (list Info-no-description-string))
1231 dir-section-contents))))))
1232 Info-dir-newer-info-files)
1229 (delete-region (point-min) (point-max)) 1233 (delete-region (point-min) (point-max))
1230 (Info-dump-dir-entries (nreverse dir-section-contents)) 1234 (Info-dump-dir-entries (nreverse dir-section-contents))
1231 (widen) 1235 (widen)
1232 (if (= next-section (point-max)) 1236 (if (= next-section (point-max))
1233 (setq next-section nil) 1237 (setq next-section nil)
1370 (if (stringp (cdr (car suff))) 1374 (if (stringp (cdr (car suff)))
1371 (let ((command (if (string-match "%s" (cdr (car suff))) 1375 (let ((command (if (string-match "%s" (cdr (car suff)))
1372 (format (cdr (car suff)) file) 1376 (format (cdr (car suff)) file)
1373 (concat (cdr (car suff)) " < " file)))) 1377 (concat (cdr (car suff)) " < " file))))
1374 (message "%s..." command) 1378 (message "%s..." command)
1375 (if (eq system-type 'vax-vms) 1379 (call-process shell-file-name nil t nil "-c" command)
1376 (call-process command nil t nil)
1377 (call-process shell-file-name nil t nil "-c" command))
1378 (message "") 1380 (message "")
1379 (if visit 1381 (when visit
1380 (progn 1382 (setq buffer-file-name file)
1381 (setq buffer-file-name file) 1383 (set-buffer-modified-p nil)
1382 (set-buffer-modified-p nil) 1384 (clear-visited-file-modtime)))
1383 (clear-visited-file-modtime))))
1384 (insert-file-contents file visit)))) 1385 (insert-file-contents file visit))))
1385 1386
1386 (defun Info-select-node () 1387 (defun Info-select-node ()
1387 "Select the node that point is in, after using `g *' to select whole file." 1388 "Select the node that point is in, after using `g *' to select whole file."
1388 (interactive) 1389 (interactive)
2777 (add-hook 'mouse-track-click-hook 'Info-maybe-follow-clicked-node) 2778 (add-hook 'mouse-track-click-hook 'Info-maybe-follow-clicked-node)
2778 (add-hook 'mouse-track-click-hook 'Info-mouse-track-double-click-hook) 2779 (add-hook 'mouse-track-click-hook 'Info-mouse-track-double-click-hook)
2779 ;; #### The console-on-window-system-p check is to allow this to 2780 ;; #### The console-on-window-system-p check is to allow this to
2780 ;; work on tty's. The real problem here is that featurep really 2781 ;; work on tty's. The real problem here is that featurep really
2781 ;; needs to have some device/console domain knowledge added to it. 2782 ;; needs to have some device/console domain knowledge added to it.
2783 (defvar info::toolbar)
2782 (if (and (featurep 'toolbar) 2784 (if (and (featurep 'toolbar)
2783 (console-on-window-system-p) 2785 (console-on-window-system-p)
2784 (not Info-inhibit-toolbar)) 2786 (not Info-inhibit-toolbar))
2785 (set-specifier default-toolbar (cons (current-buffer) info::toolbar))) 2787 (set-specifier default-toolbar (cons (current-buffer) info::toolbar)))
2786 (if (featurep 'menubar) 2788 (if (featurep 'menubar)