X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1239851cdd4cf7a75e98a850b1420d2cc7440455..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/woman.el diff --git a/lisp/woman.el b/lisp/woman.el index ed04ae4c83..610590a297 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1,11 +1,11 @@ ;;; woman.el --- browse UN*X manual pages `wo (without) man' -;; Copyright (C) 2000, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2002, 2004 Free Software Foundation, Inc. ;; Author: Francis J. Wright ;; Maintainer: Francis J. Wright ;; Keywords: help, unix -;; Adapted-By: Eli Zaretskii +;; Adapted-By: Eli Zaretskii ;; Version: see `woman-version' ;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/ @@ -402,6 +402,7 @@ ;; Alexander Hinds ;; Stefan Hornburg ;; Theodore Jump +;; David Kastrup ;; Paul Kinnucan ;; Jonas Linde ;; Andrew McRae @@ -438,7 +439,8 @@ "Return concatenated list of FN applied to successive `car' elements of X. FN must return a list, cons or nil. Useful for splicing into a list." ;; Based on the Standard Lisp function MAPCAN but with args swapped! - (and x (nconc (funcall fn (car x)) (woman-mapcan fn (cdr x))))) + ;; More concise implementation than the recursive one. -- dak + (apply #'nconc (mapcar fn x))) (defun woman-parse-colon-path (paths) "Explode search path string PATHS into a list of directory names. @@ -809,7 +811,7 @@ Only useful when run on a graphic display such as X or MS-Windows." (defcustom woman-fill-frame nil ;; Based loosely on a suggestion by Theodore Jump: - "*If non-nil then most of the frame width is used." + "*If non-nil then most of the window width is used." :type 'boolean :group 'woman-formatting) @@ -1130,7 +1132,7 @@ Used non-interactively, arguments are optional: if given then TOPIC should be a topic string and non-nil RE-CACHE forces re-caching." (interactive (list nil current-prefix-arg)) ;; The following test is for non-interactive calls via gnudoit etc. - (if (or (interactive-p) (not (stringp topic)) (string-match "\\S " topic)) + (if (or (not (stringp topic)) (string-match "\\S " topic)) (let ((file-name (woman-file-name topic re-cache))) (if file-name (woman-find-file file-name) @@ -1367,15 +1369,16 @@ The cdr of each alist element is the path-index / filename." ;; is re-processed by `woman-topic-all-completions-merge'. (let (dir files (path-index 0)) ; indexing starts at zero (while path - (setq dir (car path) - path (cdr path)) + (setq dir (pop path)) (if (woman-not-member dir path) ; use each directory only once! - (setq files - (nconc files - (woman-topic-all-completions-1 dir path-index)))) + (push (woman-topic-all-completions-1 dir path-index) + files)) (setq path-index (1+ path-index))) ;; Uniquefy topics: - (woman-topic-all-completions-merge files))) + ;; Concate all lists with a single nconc call to + ;; avoid retraversing the first lists repeatedly -- dak + (woman-topic-all-completions-merge + (apply #'nconc files)))) (defun woman-topic-all-completions-1 (dir path-index) "Return an alist of the man topics in directory DIR with index PATH-INDEX. @@ -1388,55 +1391,54 @@ of the first `woman-cache-level' elements from the following list: ;; unnecessary. So let us assume that `woman-file-regexp' will ;; filter out any directories, which probably should not be there ;; anyway, i.e. it is a user error! - (mapcar - (lambda (file) - (cons - (file-name-sans-extension - (if (string-match woman-file-compression-regexp file) - (file-name-sans-extension file) - file)) - (if (> woman-cache-level 1) - (cons - path-index - (if (> woman-cache-level 2) - (cons file nil)))))) - (directory-files dir nil woman-file-regexp))) + ;; + ;; Don't sort files: we do that when merging, anyway. -- dak + (let (newlst (lst (directory-files dir nil woman-file-regexp t)) + ;; Make an explicit regexp for stripping extension and + ;; compression extension: file-name-sans-extension is a + ;; far too costly function. -- dak + (ext (format "\\(\\.[^.\\/]*\\)?\\(%s\\)?\\'" + woman-file-compression-regexp))) + ;; Use a loop instead of mapcar in order to avoid the speed + ;; penalty of binding function arguments. -- dak + (dolist (file lst newlst) + (push + (cons + (if (string-match ext file) + (substring file 0 (match-beginning 0)) + file) + (and (> woman-cache-level 1) + (cons + path-index + (and (> woman-cache-level 2) + (list file))))) + newlst)))) (defun woman-topic-all-completions-merge (alist) "Merge the alist ALIST so that the keys are unique. Also make each path-info component into a list. \(Note that this function changes the value of ALIST.)" - ;; Intended to be fast by avoiding recursion and list copying. - (if (> woman-cache-level 1) - (let ((newalist alist)) - (while newalist - (let ((tail newalist) (topic (car (car newalist)))) - ;; Make the path-info into a list: - (setcdr (car newalist) (list (cdr (car newalist)))) - (while tail - (while (and tail (not (string= topic (car (car (cdr tail)))))) - (setq tail (cdr tail))) - (if tail ; merge path-info into (car newalist) - (let ((path-info (cdr (car (cdr tail))))) - (if (member path-info (cdr (car newalist))) - () - ;; Make the path-info into a list: - (nconc (car newalist) (list path-info))) - (setcdr tail (cdr (cdr tail)))) - )) - (setq newalist (cdr newalist)))) - alist) + ;; Replaces unreadably "optimized" O(n^2) implementation. + ;; Instead we use sorting to merge stuff efficiently. -- dak + (let (elt newalist) + ;; Sort list into reverse order + (setq alist (sort alist (lambda(x y) (string< (car y) (car x))))) + ;; merge duplicate keys. + (if (> woman-cache-level 1) + (while alist + (setq elt (pop alist)) + (if (equal (car elt) (caar newalist)) + (unless (member (cdr elt) (cdar newalist)) + (setcdr (car newalist) (cons (cdr elt) + (cdar newalist)))) + (setcdr elt (list (cdr elt))) + (push elt newalist))) ;; woman-cache-level = 1 => elements are single-element lists ... - (while (and alist (member (car alist) (cdr alist))) - (setq alist (cdr alist))) - (if alist - (let ((newalist alist) cdr_alist) - (while (setq cdr_alist (cdr alist)) - (if (not (member (car cdr_alist) (cdr cdr_alist))) - (setq alist cdr_alist) - (setcdr alist (cdr cdr_alist))) - ) - newalist)))) + (while alist + (setq elt (pop alist)) + (unless (equal (car elt) (caar newalist)) + (push elt newalist)))) + newalist)) (defun woman-file-name-all-completions (topic) "Return an alist of the files in all man directories that match TOPIC." @@ -2211,7 +2213,7 @@ Currently set only from '\" t in the first line of the source file.") ;; Based loosely on a suggestion by Theodore Jump: (if (or woman-fill-frame (not (and (integerp woman-fill-column) (> woman-fill-column 0)))) - (setq woman-fill-column (- (frame-width) woman-default-indent))) + (setq woman-fill-column (- (window-width) woman-default-indent))) ;; Check for preprocessor requests: (goto-char from) @@ -3239,7 +3241,7 @@ If optional arg CONCAT is non-nil then join arguments." ;; Paragraph .LP/PP/HP/IP/TP and font .B/.BI etc. macros reset font. ;; Should .SH/.SS reset font? ;; Font size setting macros (?) should reset font. - (let ((woman-font-alist woman-font-alist) ; for local updating + (let ((font-alist woman-font-alist) ; for local updating (previous-pos (point)) (previous-font 'default) (current-font 'default)) @@ -3270,15 +3272,15 @@ If optional arg CONCAT is non-nil then join arguments." ;; Get font name: (or font (let ((fontstring (match-string 0))) - (setq font (assoc fontstring woman-font-alist) - ;; NB: woman-font-alist contains VARIABLE NAMES. + (setq font (assoc fontstring font-alist) + ;; NB: font-alist contains VARIABLE NAMES. font (if font (cdr font) (WoMan-warn "Unknown font %s." fontstring) ;; Output this message once only per call ... - (setq woman-font-alist + (setq font-alist (cons (cons fontstring 'woman-unknown-face) - woman-font-alist)) + font-alist)) 'woman-unknown-face) ))) ;; Delete font control line or escape sequence: