/[emacs]/emacs/lisp/woman.el
ViewVC logotype

Diff of /emacs/lisp/woman.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.16.4.1 by handa, Fri Apr 16 12:50:11 2004 UTC revision 1.16.4.2 by miles, Mon Jun 28 07:28:48 2004 UTC
# Line 1  Line 1 
1  ;;; woman.el --- browse UN*X manual pages `wo (without) man'  ;;; woman.el --- browse UN*X manual pages `wo (without) man'
2    
3  ;; Copyright (C) 2000, 2002 Free Software Foundation, Inc.  ;; Copyright (C) 2000, 2002, 2004 Free Software Foundation, Inc.
4    
5  ;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>  ;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
6  ;; Maintainer: Francis J. Wright <F.J.Wright@qmul.ac.uk>  ;; Maintainer: Francis J. Wright <F.J.Wright@qmul.ac.uk>
# Line 402  Line 402 
402  ;;   Alexander Hinds <ahinds@thegrid.net>  ;;   Alexander Hinds <ahinds@thegrid.net>
403  ;;   Stefan Hornburg <sth@hacon.de>  ;;   Stefan Hornburg <sth@hacon.de>
404  ;;   Theodore Jump <tjump@cais.com>  ;;   Theodore Jump <tjump@cais.com>
405    ;;   David Kastrup <dak@gnu.org>
406  ;;   Paul Kinnucan <paulk@mathworks.com>  ;;   Paul Kinnucan <paulk@mathworks.com>
407  ;;   Jonas Linde <jonas@init.se>  ;;   Jonas Linde <jonas@init.se>
408  ;;   Andrew McRae <andrewm@optimation.co.nz>  ;;   Andrew McRae <andrewm@optimation.co.nz>
# Line 438  Line 439 
439    "Return concatenated list of FN applied to successive `car' elements of X.    "Return concatenated list of FN applied to successive `car' elements of X.
440  FN must return a list, cons or nil.  Useful for splicing into a list."  FN must return a list, cons or nil.  Useful for splicing into a list."
441    ;; Based on the Standard Lisp function MAPCAN but with args swapped!    ;; Based on the Standard Lisp function MAPCAN but with args swapped!
442    (and x (nconc (funcall fn (car x)) (woman-mapcan fn (cdr x)))))    ;; More concise implementation than the recursive one.  -- dak
443      (apply #'nconc (mapcar fn x)))
444    
445  (defun woman-parse-colon-path (paths)  (defun woman-parse-colon-path (paths)
446    "Explode search path string PATHS into a list of directory names.    "Explode search path string PATHS into a list of directory names.
# Line 1367  The cdr of each alist element is the pat Line 1369  The cdr of each alist element is the pat
1369    ;; is re-processed by `woman-topic-all-completions-merge'.    ;; is re-processed by `woman-topic-all-completions-merge'.
1370    (let (dir files (path-index 0))       ; indexing starts at zero    (let (dir files (path-index 0))       ; indexing starts at zero
1371      (while path      (while path
1372        (setq dir (car path)        (setq dir (pop path))
             path (cdr path))  
1373        (if (woman-not-member dir path)   ; use each directory only once!        (if (woman-not-member dir path)   ; use each directory only once!
1374            (setq files            (push (woman-topic-all-completions-1 dir path-index)
1375                  (nconc files                  files))
                        (woman-topic-all-completions-1 dir path-index))))  
1376        (setq path-index (1+ path-index)))        (setq path-index (1+ path-index)))
1377      ;; Uniquefy topics:      ;; Uniquefy topics:
1378      (woman-topic-all-completions-merge files)))      ;; Concate all lists with a single nconc call to
1379        ;; avoid retraversing the first lists repeatedly  -- dak
1380        (woman-topic-all-completions-merge
1381         (apply #'nconc files))))
1382    
1383  (defun woman-topic-all-completions-1 (dir path-index)  (defun woman-topic-all-completions-1 (dir path-index)
1384    "Return an alist of the man topics in directory DIR with index PATH-INDEX.    "Return an alist of the man topics in directory DIR with index PATH-INDEX.
# Line 1388  of the first `woman-cache-level' element Line 1391  of the first `woman-cache-level' element
1391    ;; unnecessary.  So let us assume that `woman-file-regexp' will    ;; unnecessary.  So let us assume that `woman-file-regexp' will
1392    ;; filter out any directories, which probably should not be there    ;; filter out any directories, which probably should not be there
1393    ;; anyway, i.e. it is a user error!    ;; anyway, i.e. it is a user error!
1394    (mapcar    ;;
1395     (lambda (file)    ;; Don't sort files: we do that when merging, anyway.  -- dak
1396       (cons    (let (newlst (lst (directory-files dir nil woman-file-regexp t))
1397        (file-name-sans-extension                 ;; Make an explicit regexp for stripping extension and
1398         (if (string-match woman-file-compression-regexp file)                 ;; compression extension: file-name-sans-extension is a
1399             (file-name-sans-extension file)                 ;; far too costly function.  -- dak
1400           file))                 (ext (format "\\(\\.[^.\\/]*\\)?\\(%s\\)?\\'"
1401        (if (> woman-cache-level 1)                              woman-file-compression-regexp)))
1402            (cons      ;; Use a loop instead of mapcar in order to avoid the speed
1403             path-index      ;; penalty of binding function arguments.  -- dak
1404             (if (> woman-cache-level 2)        (dolist (file lst newlst)
1405                 (cons file nil))))))          (push
1406     (directory-files dir nil woman-file-regexp)))           (cons
1407              (if (string-match ext file)
1408                  (substring file 0 (match-beginning 0))
1409                file)
1410              (and (> woman-cache-level 1)
1411                   (cons
1412                    path-index
1413                    (and (> woman-cache-level 2)
1414                         (list file)))))
1415             newlst))))
1416    
1417  (defun woman-topic-all-completions-merge (alist)  (defun woman-topic-all-completions-merge (alist)
1418    "Merge the alist ALIST so that the keys are unique.    "Merge the alist ALIST so that the keys are unique.
1419  Also make each path-info component into a list.  Also make each path-info component into a list.
1420  \(Note that this function changes the value of ALIST.)"  \(Note that this function changes the value of ALIST.)"
1421    ;; Intended to be fast by avoiding recursion and list copying.    ;; Replaces unreadably "optimized" O(n^2) implementation.
1422    (if (> woman-cache-level 1)    ;; Instead we use sorting to merge stuff efficiently.  -- dak
1423        (let ((newalist alist))    (let (elt newalist)
1424          (while newalist      ;; Sort list into reverse order
1425            (let ((tail newalist) (topic (car (car newalist))))      (setq alist (sort alist (lambda(x y) (string< (car y) (car x)))))
1426              ;; Make the path-info into a list:      ;; merge duplicate keys.
1427              (setcdr (car newalist) (list (cdr (car newalist))))      (if (> woman-cache-level 1)
1428              (while tail          (while alist
1429                (while (and tail (not (string= topic (car (car (cdr tail))))))            (setq elt (pop alist))
1430                  (setq tail (cdr tail)))            (if (equal (car elt) (caar newalist))
1431                (if tail                  ; merge path-info into (car newalist)                (unless (member (cdr elt) (cdar newalist))
1432                    (let ((path-info (cdr (car (cdr tail)))))                  (setcdr (car newalist) (cons (cdr elt)
1433                      (if (member path-info (cdr (car newalist)))                                               (cdar newalist))))
1434                          ()              (setcdr elt (list (cdr elt)))
1435                        ;; Make the path-info into a list:              (push elt newalist)))
                       (nconc (car newalist) (list path-info)))  
                     (setcdr tail (cdr (cdr tail))))  
                 ))  
             (setq newalist (cdr newalist))))  
         alist)  
1436      ;; woman-cache-level = 1 => elements are single-element lists ...      ;; woman-cache-level = 1 => elements are single-element lists ...
1437      (while (and alist (member (car alist) (cdr alist)))        (while alist
1438        (setq alist (cdr alist)))          (setq elt (pop alist))
1439      (if alist          (unless (equal (car elt) (caar newalist))
1440          (let ((newalist alist) cdr_alist)            (push elt newalist))))
1441            (while (setq cdr_alist (cdr alist))      newalist))
             (if (not (member (car cdr_alist) (cdr cdr_alist)))  
                 (setq alist cdr_alist)  
               (setcdr alist (cdr cdr_alist)))  
             )  
           newalist))))  
1442    
1443  (defun woman-file-name-all-completions (topic)  (defun woman-file-name-all-completions (topic)
1444    "Return an alist of the files in all man directories that match TOPIC."    "Return an alist of the files in all man directories that match TOPIC."

Legend:
Removed from v.1.16.4.1  
changed lines
  Added in v.1.16.4.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26