home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / cl-info.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  21.0 KB  |  694 lines
  1. ;;; This is port of GCL's info.lsp to Clisp.  This should basically be
  2. ;;; portable Common Lisp, but I haven't tested it with anything else.
  3.  
  4. ;; CAUTION: This file contains non-printing characters!
  5. ;;
  6. ;; The regexp syntax used in this file is the syntax used by nregex.
  7. ;;
  8. ;; In summary:
  9. ;;
  10. ;; .       (a period) matches any single character
  11. ;; []      character set
  12. ;; ^       beginning of line
  13. ;; $       end of line
  14. ;; ( )     grouping
  15. ;; *       zero or more
  16. ;; ?       zero or one matches
  17. ;; +       one or more
  18. ;;
  19.  
  20.  
  21. (in-package "SI")
  22.  
  23. (defvar *match-data*)
  24. (defvar *case-fold-search* nil)
  25.  
  26. (defun match-start (n)
  27.   (first (aref *match-data* n)))
  28. (defun match-beginning (n)
  29.   (match-start n))
  30. (defun match-end (n)
  31.   (second (aref *match-data* n)))
  32. (defun get-match (s n)
  33.   (subseq s (match-start n) (match-end n)))
  34.  
  35. ;; Compile the regex pattern in PAT for use by the string matcher.
  36. (defun compile-regex (pat &key (case-sensitive t))
  37.   (let ((*compile-print* nil)
  38.     (*compile-verbose* nil)
  39.     #+cmu
  40.     (*compile-progress* nil)
  41.     )
  42.     (compile nil
  43.          (nregex:regex-compile pat :case-sensitive case-sensitive))))
  44.  
  45. ;; Search the string STRING for the pattern PAT.  Only the part of the
  46. ;; string bounded by START and END are searched.  PAT may either be a
  47. ;; string or a compiled regex (which is a function).
  48. ;;
  49. ;; If a match is not found, -1 is returned.  Otherwise, the index of
  50. ;; the start of the match is returned.  *match-data* contains
  51. ;; information about the matches for any groups in the pattern.
  52. (defun string-match (pat string &optional (start 0) (end (length string)))
  53.   (when (stringp pat)
  54.     (setf pat (compile-regex pat :case-sensitive (not *case-fold-search*))))
  55.   (if (funcall pat string :start start :end end)
  56.       (progn
  57.     (setf *match-data* (make-array nregex:*regex-groupings*))
  58.     (dotimes (k nregex:*regex-groupings*)
  59.       (setf (aref *match-data* k) (aref nregex:*regex-groups* k)))
  60.     (match-start 0))
  61.       -1))
  62.  
  63. (eval-when (compile eval)
  64.   (defmacro while (test &body body)
  65.     `(loop while ,test do ,@ body))
  66.   #+nil
  67.   (defmacro f (op x y)
  68.     `(,op (the fixnum ,x) (the fixnum ,y))))
  69.  
  70. ;; #u"" is a C-style string where \n, \t, and \r are converted just as
  71. ;; in C.
  72. (eval-when (compile eval load)
  73. (defun sharp-u-reader (stream subchar arg)
  74.   (declare (ignore subchar arg))
  75.   (let ((tem (make-array 10 :element-type 'base-char
  76.              :fill-pointer 0 :adjustable t)))
  77.     (unless (eql (read-char stream) #\")
  78.       (error "sharp-u-reader reader needs a \"right after it"))
  79.     (loop
  80.      (let ((ch (read-char stream)))
  81.        (cond ((eql ch #\") (return tem))
  82.          ((eql ch #\\)
  83.           (setq ch (read-char stream))
  84.           (setq ch (or (cdr (assoc ch '((#\n . #\newline)
  85.                         (#\t . #\tab)
  86.                         (#\r . #\return))))
  87.                ch))))
  88.        (vector-push-extend ch tem)))
  89.     (coerce tem '(simple-array base-char (*)))))
  90.  
  91. (set-dispatch-macro-character #\# #\u 'sharp-u-reader)
  92. )
  93.  
  94. (defvar *info-data* nil)
  95. (defvar *current-info-data* nil)
  96. (defvar *info-paths*
  97.   '("" "/usr/info/" "/usr/local/lib/info/" "/usr/local/info/"
  98.     "/usr/local/gnu/info/" "/usr/share/info/" ))
  99.  
  100.  
  101. ;; Read the contents of a file FILE starting at position START into a
  102. ;; string.
  103. (defun file-to-string (file &optional (start 0))
  104.   (with-open-file (st file)
  105.     (let ((len (file-length st)))
  106.       (unless (<= 0 start len)
  107.     (error "illegal file start ~a" start))
  108.       (let ((tem (make-array (- len start)
  109.                  :element-type 'base-char)))
  110.     (when (> start 0)
  111.       (file-position st start))
  112.     (read-sequence tem st :start 0 :end (length tem))
  113.     tem))))
  114.  
  115. (defun atoi (string start)
  116.   (parse-integer string :start start :junk-allowed t))
  117.  
  118. ;; FILE is the main (first) info file. Search for the Indirect nodes
  119. ;; and the tag table which exists if the info files are split into
  120. ;; several files.
  121. ;;
  122. ;; Return a list of the tag table text itself and an alist of the
  123. ;; starting index for each file and the name of the corresponding
  124. ;; file.
  125. (let ((pat-indirect-start (compile-regex #u"[ \n]+Indirect:"
  126.                      :case-sensitive t))
  127.       (pat-end-ind (compile-regex #u""
  128.                   :case-sensitive t))
  129.       (pat-indirect (compile-regex #u"\n([^\n]+): ([0-9]+)"
  130.                    :case-sensitive t))
  131.       (pat-tag-table (compile-regex #u"[\n ]+Tag Table:"
  132.                     :case-sensitive t))
  133.       )
  134. (defun info-get-tags (file)
  135.   (let ((lim 0)
  136.     (*case-fold-search* t)
  137.     *match-data* tags files)
  138.     (declare (fixnum lim))
  139.     (let ((s (file-to-string file))
  140.       (i 0))
  141.       (declare (fixnum i)
  142.            (string s))
  143.       ;;(format t "match = ~A~%" (string-match #u"[ \n]+Indirect:" s 0))
  144.       (when (>= (string-match pat-indirect-start s 0) 0)
  145.     ;; The file has multiple parts, so save the filename and the
  146.     ;; offset of each part.
  147.     (setq i (match-end 0))
  148.     ;;(format t "looking for end of Indirect, from ~a~%" i)
  149.     (setq lim (string-match pat-end-ind s i))
  150.     ;;(format t "found Indirect at ~A.  limit = ~A~%" i lim)
  151.     (while (>= (string-match pat-indirect s i lim)
  152.            0)
  153.       ;;(format t "found entry at ~a.~%" (match-start 0))
  154.       (setq i (match-end 0))
  155.       (setq files
  156.         (cons (cons
  157.                (atoi s (match-beginning 2))
  158.                (get-match s 1)
  159.                )
  160.               files))))
  161.       ;;(format t "looking for Tag Table~%")
  162.       (when (>=  (string-match pat-tag-table s i) 0)
  163.     (setq i (match-end 0))
  164.     ;;(format t "Found Tag Table:  ~A ~A~%" (match-start 0) i)
  165.     (when (>= (string-match pat-end-ind s i) 0)
  166.       ;;(format t "Found end at ~A ~A~%" i (match-start 0))
  167.       (setq tags (subseq s i (match-end 0)))))
  168.       (if files
  169.       (or tags (info-error "Need tags if have multiple files")))
  170.       (list* tags (nreverse files)))))
  171. )
  172.  
  173. ;; Quote the given string, protecting any special regexp characters so
  174. ;; that they stand for themselves.
  175. (defun re-quote-string (x)
  176.   (let ((i 0)
  177.     (len (length x))
  178.     ch
  179.     (extra 0))
  180.     (declare (fixnum i len extra)
  181.          (string x))
  182.     (let (tem)
  183.       (tagbody
  184.        AGAIN
  185.      (while (< i len)
  186.        (setq ch (aref x i))
  187.        ;; (cond ((position ch "\\()[]+.*|^$?")
  188.        (when (position ch "\\()[].*|^$")
  189.          (if tem 
  190.          (vector-push-extend #\\ tem)
  191.          (incf extra)))
  192.        (when tem
  193.          (vector-push-extend ch tem))
  194.        (setq i (+ i 1)))
  195.      (cond (tem )
  196.            ((> extra 0)
  197.         (setq tem 
  198.               (make-array (+ (length x) extra)
  199.                   :element-type 'base-char :fill-pointer 0))
  200.         (setq i 0)
  201.         (go AGAIN))
  202.            (t (setq tem x)))
  203.      )
  204.       tem)))
  205.  
  206. (defun get-match (string i)
  207.   (subseq string (match-beginning i) (match-end i)))
  208.  
  209. (defun string-concatenate (&rest strings)
  210.   (apply #'concatenate 'string strings))
  211.  
  212. (defun get-nodes (pat node-string)
  213.   (let ((i 0)
  214.     (*case-fold-search* t)
  215.     (ans '())
  216.     (*match-data* nil))
  217.     (declare (fixnum i))
  218.     (when node-string
  219.       (let ((compiled-pat
  220.          (compile-regex
  221.           (string-concatenate "Node: ([^]*"
  222.                   (re-quote-string pat)
  223.                   "[^]*)")
  224.           :case-sensitive (not *case-fold-search*))))
  225.     (while (>= (string-match compiled-pat node-string i) 0)
  226.       (setq i (match-end 0))
  227.       (setq ans (cons (get-match node-string 1) 
  228.               ans)))
  229.     (nreverse ans)))))
  230.  
  231. (defun get-index-node ()
  232.   (or (third *current-info-data*) 
  233.       (let* (s
  234.          (node-string (car (nth 1 *current-info-data*)))
  235.          (node
  236.           (and node-string (car (get-nodes "index" node-string)))))
  237.     (when node
  238.       (setq s (show-info node nil))
  239.       (setf (third *current-info-data*) s)))))
  240.  
  241. ;; Most of the cost of retrieving documentation is here.  This should
  242. ;; be fast.
  243. (defun nodes-from-index (pat)
  244.   (let ((i 0)
  245.     ans
  246.     (*case-fold-search* t)
  247.     *match-data*
  248.     (index-string (get-index-node)))
  249.     (when index-string
  250.       (let ((compiled-pat
  251.          (compile-regex
  252.           (string-concatenate #u"\n\\* ([^:\n]*"
  253.                   (re-quote-string pat)
  254.                   #u"[^:\n]*):[ \t]+([^\t\n,.]+)")
  255.           :case-sensitive (not *case-fold-search*))))
  256.     (while (>= (string-match compiled-pat index-string i) 0)
  257.       (setq i (match-end 0))
  258.       (push (cons (get-match index-string 1) (get-match index-string 2))
  259.         ans))
  260.     (nreverse ans)))))
  261.  
  262. (defun get-node-index (pat node-string)
  263.   (let ((node pat)
  264.     *match-data*)
  265.     (cond ((null node-string) 0)
  266.       (t
  267.        (setq pat
  268.          (compile-regex
  269.           (string-concatenate "Node: "
  270.                       (re-quote-string pat)
  271.                       "([0-9]+)")
  272.           :case-sensitive (not *case-fold-search*)))
  273.        (cond ((>= (string-match pat node-string) 0)
  274.           (atoi node-string (match-beginning 1)))
  275.          (t
  276.           (info-error "can't find node ~s" node) 0))))))
  277.  
  278. (defun all-matches (pat st)
  279.   (let ((start 0)
  280.     *match-data*)
  281.     (declare (fixnum start))
  282.     (loop while (>= (setq start (string-match pat st start)) 0)
  283.       collect (list start (setq start (match-end 0))))))
  284.  
  285.  
  286.  
  287. (defmacro node (prop x)
  288.   `(nth ,(position prop '(string begin end header name
  289.                  info-subfile
  290.                  file tags)) ,x)) 
  291.  
  292. (defun node-offset (node)
  293.   (+ (car (node info-subfile node)) (node begin node)))
  294.  
  295. (defun file-search (name &optional (dirs *info-paths*) extensions (fail-p t))
  296.   "Search for the first occurrence of a file in the directory list DIRS
  297. that matches the name NAME with extention EXT"
  298.   (dolist (dir dirs)
  299.     (let ((base-name (make-pathname :directory (pathname-directory dir))))
  300.       (dolist (type extensions)
  301.     (let ((pathname (make-pathname :name name
  302.                        :type (if (equalp type "")
  303.                          nil
  304.                          type)
  305.                        :defaults base-name)))
  306.       (when (probe-file pathname)
  307.         (return-from file-search pathname))))))
  308.   ;; We couldn't find the file
  309.   (when fail-p
  310.     (error "Lookup failed in directores: ~S for name ~S with extensions ~S"
  311.        dirs name extensions))
  312.   nil)
  313.  
  314. (defvar *old-lib-directory* nil)
  315.  
  316. (defun setup-info (name)
  317.   (let (tem file)
  318.     (when (equal name "DIR")
  319.       (setq name "dir"))
  320.     (setq file (file-search name *info-paths* '("" "info") nil))
  321.     (cond ((and (null file)
  322.         (not (equal name "dir")))
  323.        ;; jfa: FIXME Sat Feb  2 16:18:04 2002
  324.        ;; The error message is a temporary hack.
  325.        ;; The code following the error message would do something.
  326.        ;; (a) It is not clear to me what it is trying to do.
  327.        ;; (b) The format statmement is missing an argument.
  328.        ;; (c) Even if (b) is fixed, the show-info statement
  329.        ;;     creates an infinite loop.
  330.        ;;
  331.        ;; rlt: I think the code is trying to find the Top entry in
  332.        ;; the file "dir" and looking in there for the location of
  333.        ;; the maxima file.  If you don't have a dir file, we lose.
  334.        (error "Failed to find info directory")
  335.        (format t "looking for dir~A~%")
  336.        (let* ((tem (show-info "(dir)Top" nil))
  337.           *case-fold-search*)
  338.          (cond ((>= (string-match
  339.              (string-concatenate "(([^(]*"
  340.                          (re-quote-string name)
  341.                          "(.info)?))")
  342.              tem)
  343.             0)
  344.             (setq file (get-match tem 1)))))))
  345.     (cond (file
  346.        (let* ((na (namestring (truename file))))
  347.          (cond ((setq tem (assoc na *info-data* :test 'equal))
  348.             (setq *current-info-data* tem))
  349.            (t
  350.             (setq *current-info-data*
  351.               (list na (info-get-tags na) nil))
  352.             (setq *info-data* (cons *current-info-data* *info-data*))))))
  353.       (t
  354.        (format t "(not found ~s)" name)))
  355.     nil))
  356.               
  357. (defun get-info-choices (pat type)
  358.   (if (eql type 'index)
  359.       (nodes-from-index pat )
  360.       (get-nodes pat (car (nth 1 *current-info-data*)))))
  361.  
  362. (defun add-file (v file &aux (lis v))
  363.   (while lis
  364.     (setf (car lis) (list (car lis) file))
  365.     (setq lis (cdr lis)))
  366.   v)
  367.  
  368. (defun info-error (&rest l)
  369.   (apply #'error l))
  370.  
  371. ;; Cache the last file read to speed up lookup since it may be
  372. ;; gzipped. However, we don't support gzipped info files at this time.
  373. (defvar *last-info-file* nil)
  374.  
  375. (defun info-get-file (pathname)
  376.   (setq pathname
  377.     (if (stringp (car *current-info-data*))
  378.         (merge-pathnames pathname
  379.                  (car *current-info-data*))
  380.         pathname))
  381.   (cdr 
  382.    (cond ((equal (car *last-info-file*) pathname)
  383.       *last-info-file*)
  384.      (t (setq *last-info-file*
  385.           (cons pathname (file-to-string pathname)))))))
  386.  
  387. (defun info-subfile (n)
  388. ;  "For an index N return (START . FILE) for info subfile
  389. ; which contains N.   A second value bounding the limit if known
  390. ; is returned.   At last file this limit is nil."
  391.   (let ((lis (cdr (nth 1 *current-info-data*)))
  392.     ans lim)
  393.     (when (and lis (>= n 0))
  394.       (dolist (v lis)
  395.     (cond ((> (car v) n )
  396.            (setq lim (car v))
  397.            (return nil)))
  398.     (setq ans v)
  399.     ))
  400.     (values (or ans (cons 0 (car *current-info-data*))) lim)))
  401.  
  402. ;;used by search
  403. (let ((pat-marker (compile-regex #u"^_" :case-sensitive t))
  404.       (pat-node (compile-regex
  405.          #u"[\n ][^\n]*Node:[ \t]+([^\n\t,]+)[\n\t,][^\n]*\n"
  406.          :case-sensitive t))
  407.       (pat-marker2 (compile-regex "[ ]")))
  408. (defun info-node-from-position (n &aux  (i 0))
  409.   (let* ((info-subfile (info-subfile n))
  410.      (s (info-get-file (cdr info-subfile)))
  411.      (end (- n (car info-subfile))))
  412.     (while (>=  (string-match pat-marker s i end) 0)
  413.       (setq i (match-end 0)))
  414.     (setq i (- i 1))
  415.     (if (>= (string-match pat-node s i) 0)
  416.     (let* ((i (match-beginning 0))
  417.            (beg (match-end 0))
  418.            (name (get-match s 1))
  419.            (end (if (>= (string-match pat-marker2 s beg) 0)
  420.             (match-beginning 0)
  421.             (length s)))
  422.            (node (list* s beg end i name info-subfile
  423.                 *current-info-data*)))
  424.       node))))
  425. )
  426.     
  427. ;; SHOW-INFO is the main routine to find the desired documentation.
  428.  
  429. (let ((pat-file-node (compile-regex "^(\\([^(]+\\))([^)]*)"))
  430.       ;; This is the pattern for the beginning of a node
  431.       (pat-markers (compile-regex "[ ]"))
  432.       ;; This is the pattern for a subnode.  That is the documention
  433.       ;; for some function or variable.
  434.       (pat-subnode (compile-regex #u"\n - [a-zA-Z]"))
  435.       ;; This pattern is used to match where the documentation of a
  436.       ;; subnode starts.
  437.       (doc-start (compile-regex #u"\n   ")))
  438.   (defun show-info (name &optional position-pattern)
  439.     (let ((*match-data* nil)
  440.       (initial-offset 0)
  441.       (subnode -1)
  442.       info-subfile file)
  443.       (declare (fixnum subnode initial-offset))
  444.       (when (and (consp name) (consp (cdr name)))
  445.     (setq file (cadr name)
  446.           name (car name)))
  447.       (when (consp name)
  448.     (setq position-pattern (car name) name (cdr name)))
  449.       (unless (stringp name)
  450.     (info-error "bad arg"))
  451.       (when (>= (string-match pat-file-node name) 0)
  452.     ;; (file)node
  453.     (setq file (get-match name 1))
  454.     (setq name (get-match name 2))
  455.     (when (equal name "")
  456.       (setq name "Top")))
  457.       (when file
  458.     (setup-info file))
  459.       (let ((indirect-index (get-node-index name
  460.                         (car (nth 1 *current-info-data*)))))
  461.     (when (null indirect-index)
  462.       (format t "~%Sorry, Can't find node ~a" name)
  463.       (return-from show-info nil))
  464.     
  465.     (setq info-subfile (info-subfile indirect-index))
  466.  
  467.     (let* ((s (info-get-file (cdr info-subfile)))
  468.            (start (- indirect-index (car info-subfile))))
  469.       (unless (>= (string-match
  470.                (string-concatenate
  471.             #u"[\n ][^\n]*Node:[ \t]+"
  472.             (re-quote-string name)
  473.             #u"[,\t\n][^\n]*\n") 
  474.                (or s "") start)
  475.               0)
  476.         (info-error "Can't find node  ~a?" name))
  477.       (let* ((i (match-beginning 0))
  478.          (beg (match-end 0))
  479.          (end (if (>= (string-match pat-markers s beg) 0)
  480.               (match-beginning 0)
  481.               (length s))))
  482.  
  483.         (when position-pattern
  484.           (setq position-pattern (re-quote-string position-pattern))
  485.  
  486.           ;; This looks for the desired pattern.  A typical entry
  487.           ;; looks like
  488.           ;;
  489.           ;; " - Function: PLOT2D <random stuff>"
  490.           ;;
  491.           ;; So we look for the beginning of a line, the string " -
  492.           ;; ", followed by at least one letter or spaces and then a
  493.           ;; colon.  After that is our desired pattern and a space
  494.           ;; or new line.
  495.           (let (*case-fold-search*)
  496.         (when (or (>= (setq subnode
  497.                     (string-match
  498.                      (string-concatenate
  499.                       #u"\n - [A-Za-z ]+: "
  500.                       position-pattern
  501.                       #u"[ \n]"
  502.                       )
  503.                      s beg end))
  504.                   0)
  505.               (>= (string-match position-pattern s beg end)
  506.                   0))
  507.           (setq initial-offset
  508.             (- (match-beginning 0) beg)))))
  509.       
  510.         ;; We now need to find the end of the documentation.
  511.         ;; Usually, the end is where the next node begins. However,
  512.         ;; sometimes several nodes are given in a row without
  513.         ;; separate documentation for each, whereby the same
  514.         ;; documentation is used to describe these nodes.
  515.         ;;
  516.         ;; So, what we do is look for the beginning of the
  517.         ;; documentation, which starts on a new line with at least 4
  518.         ;; spaces.  Then we look for the next node.  The is where
  519.         ;; our documentation ends.  If there is no next node, the
  520.         ;; end is where the marker is.
  521.         (let ((e (if (minusp subnode)
  522.              end
  523.              (let* ((start-doc
  524.                  (string-match doc-start s
  525.                            (+ beg 1 initial-offset) end)))
  526.                ;;(format t "start-doc = ~A~%" start-doc)
  527.                (cond ((>= (string-match pat-subnode s
  528.                             (if (>= start-doc 0)
  529.                             start-doc
  530.                             (+ beg 1 initial-offset))
  531.                             end)
  532.                       0)
  533.                   ;;(format t "end at ~A~%" (match-beginning 0))
  534.                   (match-beginning 0))
  535.                  (t
  536.                   ;; No next node, so the end point we
  537.                   ;; found is really the end point we
  538.                   ;; want.
  539.                   end))))))
  540.  
  541.           (subseq s (+ initial-offset beg) e)))))))
  542.   )
  543.  
  544. (defvar *default-info-files* '( "gcl-si.info" "gcl-tk.info" "gcl.info"))
  545.  
  546. (defun info-aux (x dirs)
  547.   (loop for v in dirs
  548.     do
  549.     (setup-info v)
  550.     append (add-file (get-info-choices x 'node) v)
  551.     append (add-file (get-info-choices x 'index) v)))
  552.  
  553. (defun info-search (pattern &optional (start 0) end)
  554.   "search for PATTERN from START up to END where these are indices in
  555. the general info file.  The search goes over all files."
  556.   (let ((limit 0))
  557.     (while start
  558.       (multiple-value-bind
  559.         (file lim)
  560.       (info-subfile start)
  561.     (setq limit lim)
  562.     (and end limit (<  end limit) (setq limit end))
  563.  
  564.     (let* ((s  (info-get-file (cdr  file)))
  565.            (beg (car file))
  566.            (i (- start beg))
  567.            (leng (length s)))
  568.       (when (>= (string-match pattern s i (if limit (- limit beg) leng)) 0)
  569.         (return-from info-search (+ beg (match-beginning 0)))))
  570.     (setq start lim)))
  571.     -1))
  572.  
  573. #+debug ; try searching
  574. (defun try (pat &aux (tem 0) s )
  575.  (while (>= tem 0)
  576.   (cond ((>= (setq tem (info-search pat tem)) 0)
  577.      (setq s (cdr *last-info-file*))
  578.      (print (list
  579.          tem
  580.          (list-matches s 0 1 2)
  581.          (car *last-info-file*)
  582.          (subseq s
  583.              (max 0 (- (match-beginning 0) 50))
  584.              (min (+ (match-end 0) 50) (length s)))))
  585.      (setq tem (+ tem (- (match-end 0) (match-beginning 0))))))))
  586.    
  587. (defun idescribe (name)
  588.   (let* ((items (info-aux name *default-info-files*)))
  589.     (dolist (v items)
  590.       (when (cond ((consp (car v))
  591.            (equalp (caar v) name))
  592.           (t (equalp (car v) name)))
  593.     (format t "~%From ~a:~%" v)
  594.     (princ (show-info v nil))))))
  595.  
  596. ;; Main entry point.  This looks up the desired entry and prompts the
  597. ;; user to select the desired entries when multiple matches are found.
  598. (defun info (x &optional (dirs *default-info-files*) (info-paths *info-paths*)
  599.            &aux *current-info-data*)
  600.   (let (wanted
  601.     file
  602.     position-pattern
  603.     tem
  604.     (*info-paths* info-paths))
  605.     (setf tem (info-aux x dirs))
  606.     (when tem
  607.       (let ((nitems (length tem)))
  608.     (loop for i from 0 for name in tem with prev
  609.           do
  610.           (setq file nil
  611.             position-pattern nil)
  612.           (progn
  613.         ;; decode name
  614.         (when (and (consp name) (consp (cdr name)))
  615.           (setq file (cadr name)
  616.             name (car name)))
  617.         (when (consp name)
  618.           (setq position-pattern (car name) name (cdr name))))
  619.           (when (> nitems 1)
  620.         (format t "~% ~d: ~@[~a :~]~@[(~a)~]~a." i
  621.             position-pattern
  622.             (if (eq file prev) nil (setq prev file)) name)))
  623.     (if (> (length tem) 1)
  624.         (format t "~%Enter n, all, none, or multiple choices eg 1 3 : ")
  625.         (terpri))
  626.     (let ((line (if (> (length tem) 1)
  627.             (read-line)
  628.             "0"))
  629.           (start 0)
  630.           val)
  631.       (while (equal line "")
  632.         (setq line (read-line)))
  633.       (while (multiple-value-setq
  634.              (val start)
  635.            (read-from-string line nil nil :start start))
  636.         (cond ((numberp val)
  637.            (setq wanted (cons val wanted)))
  638.           (t
  639.            (setq wanted val)
  640.            (return nil))))
  641.       (cond ((consp wanted)
  642.          (setq wanted (nreverse wanted)))
  643.         ((symbolp wanted)
  644.          (setq wanted (and
  645.                    (equal (symbol-name wanted) "ALL")
  646.                    (loop for i below (length tem)
  647.                      collect i)))))
  648.       (when wanted
  649.         ;; Remove invalid (numerical) answers
  650.         (setf wanted (remove-if #'(lambda (x)
  651.                     (and (integerp x) (>= x nitems)))
  652.                     wanted))
  653.         (format t "~%Info from file ~a:" (car *current-info-data*)))
  654.       (loop for i in wanted
  655.         do (princ (show-info (nth i tem))))))))
  656.   (values))
  657.  
  658. #||         
  659. ;; idea make info_text window have previous,next,up bindings on keys
  660. ;; and on menu bar.    Have it bring up apropos menu. allow selection
  661. ;; to say spawn another info_text window.   The symbol that is the window
  662. ;; will carry on its plist the prev,next etc nodes, and the string-to-file
  663. ;; cache the last read file as well.   Add look up in index file, so that can
  664. ;; search an indtqex as well.   Could be an optional arg to show-node
  665. ;; 
  666.  
  667.  
  668.  
  669. (defun default-info-hotlist()
  670.   (namestring (merge-pathnames "hotlist" (user-homedir-pathname))))
  671.  
  672. (defun add-to-hotlist (node )
  673.   (if (symbolp node) (setq node (get node 'node)))
  674.   (cond
  675.    (node
  676.     (with-open-file
  677.      (st (default-info-hotlist)
  678.      :direction :output
  679.      :if-exists :append
  680.      :if-does-not-exist :create)
  681.      (cond ((< (file-position st) 10)
  682.         (princ  #u"\nFile:\thotlist\tNode: Top\n\n* Menu: Hot list of favrite info items.\n\n" st)))
  683.      (format st "* (~a)~a::~%" 
  684.          (node file node)(node name node))))))
  685.  
  686. (defun list-matches (s &rest l)
  687.   (loop for i in l 
  688.      collect
  689.      (and (>= (match-beginning i) 0)
  690.           (get-match s i))))
  691. ||#
  692.  
  693.  
  694.