[xyzzy:00517] Re: info

["Seiya Suda" <EZU11330@xxxxxxxxxxxxxxxx>]

みなさん、こんにちは。
かなりのコマンドが動くようになった info.l です。

ところで亀井さん、関数 Info でなく 関数 info という
名前にすると、なぜ名前が衝突していると怒られる
のでしょうか？

須田誠也
EZU11330@xxxxxxxxxxx

--------------------
;;; info.l

;;; Is this file part of xyzzy?

(provide 'info)

(in-package "editor")

(export '(Info-first-menu-item Info-second-menu-item Info-third-menu-item
   Info-fourth-menu-item Info-fifth-menu-item Info-summary
   Info-directory Info-find-node Info-edit Info-follow-reference
   Info-goto-node Info-help Info-last Info-menu Info-next
   Inf-search-current-file Info-search-all-files Info-search
   Info-prev Info-exit Info-search Info-up Info Info-mode
   Info-follow-nearest-node Info-try-follow-nearest-node Info-next-preorder
   *Info-mode-map* *Info-directory* *Info-edit-map*
   Info-find-elisp-words Info-goto-elisp-word
   Info-current-subfile
  ))

(defvar Info-history nil
  "List of info nodes user has visited.
Each element of list is a list (FILENAME NODENAME BUFFERPOS).")

(defvar Info-enable-edit t
  "Non-nil means the \\[Info-edit] command in Info can edit the current
node.")

(defvar Info-enable-active-nodes t
  "Non-nil allows Info to execute Lisp code associated with nodes.
The Lisp code is executed when the node is selected.")

;; 適当に変えてください。
(defvar *Info-directory* "c:/Applications/xyzzy/info/"
  "Default directory for Info documentation files.")

(defvar Info-current-file ""
  "Info file that Info is now looking at, or nil.")

(defvar Info-current-subfile ""
  "Info subfile that is actually in the *info* buffer now,
or nil if current info file is not split into subfiles.")

(defvar Info-current-node ""
  "Name of node that Info is now looking at, or nil.")

(defvar Info-tag-table-marker (make-marker)
  "Marker pointing at beginning of current Info file's tag table.
Marker points nowhere if file has no tag table.")

(defun Info ()
  (interactive)
  (get-buffer-create "*info*")
  (switch-to-buffer-other-window "*info*")
  (Info-directory))

(defun Info-find-node (filename nodename &optional no-going-back)
  (when filename
    (let ((f (merge-pathnames filename *Info-directory*)))
      (unless (file-exist-p f)
 (error "Info file ~A does not exist" filename))
      (setq filename f)))
  (if (and Info-current-file (not no-going-back))
      (setq Info-history
     (cons (list Info-current-file Info-current-node (point))
    Info-history)))
  (switch-to-buffer "*info*")
  (or (eq buffer-mode 'Info-mode)
      (Info-mode))
  (widen)
  (setq Info-current-node nil)
  (unwind-protect
      (progn
 (or (null filename)
     (equal Info-current-file filename)
     (let ((buffer-read-only nil))
       (declare (special buffer-read-only))
       (setq Info-current-file ""
      Info-current-subfile "")
       (erase-buffer (selected-buffer))
       (insert-file-contents filename t)
       (set-buffer-file-name filename)
       (set-buffer-modified-p nil)
       ;(set-marker Info-tag-table-marker nil)
       (unset-marker Info-tag-table-marker)
       (goto-char (point-max))
       (forward-line -8)
       (or (equal nodename "*")
    (not (scan-buffer "\nEnd Tag Table\n" :case-fold t))
    (let (pos)
      (scan-buffer "\nTag Table:\n" :reverse t :case-fold t)
      (setq pos (point))
      (if (save-excursion
     (forward-line 2)
     (looking-at "(Indirect)\n"))
   (save-excursion
     (let ((buf (selected-buffer)))
       (set-buffer (get-buffer-create "*info tag table*"))
       (erase-buffer (selected-buffer))
       (insert-buffer-substring buf)
       (set-buffer-modified-p nil)
       (or (eq (marker-buffer Info-tag-table-marker)
        (selected-buffer))
    (setq Info-tag-table-marker (make-marker)))
       (set-marker Info-tag-table-marker
     (match-end 0))))
        (progn
   (or (eq (marker-buffer Info-tag-table-marker)
    (selected-buffer))
       (setq Info-tag-table-marker (make-marker)))
   (set-marker Info-tag-table-marker pos)))))
       (setq Info-current-file
      (file-name-sans-versions (get-buffer-file-name)))))
 (if (equal nodename "*")
     (progn (setq Info-current-node nodename)
       ;       (Info-set-mode-line)
     )
   (let ((guesspos (point-min))
  (regexp (concat "Node: *" (regexp-quote nodename) " *[,\t\n#\177]")))
     (if (marker-point Info-tag-table-marker)
  (save-excursion
    (set-buffer (marker-buffer Info-tag-table-marker))
    (goto-char Info-tag-table-marker)
    (if (scan-buffer regexp :regexp t :case-fold t :tail t)
        (progn
   (setq guesspos (with-input-from-selected-buffer (read)))
   (if (not (eq (selected-buffer) (find-buffer "*info*")))
       (setq guesspos
      (Info-read-subfile guesspos))))
      (error "No such node: ~A" nodename))))
     (goto-char (max (point-min) (- guesspos 1000)))
     (catch 'foo
       (while (scan-buffer "\n" :tail t)
  (forward-line 1)
  (let ((beg (point)))
    (forward-line 1)
    (if (scan-buffer regexp :regexp t :reverse t :case-fold t :tail t)
        (throw 'foo t))))
       (error "No such node: ~A" nodename))))
 (Info-select-node))
    (or Info-current-node no-going-back
 (let ((hist (car Info-history)))
   (setq Info-history (cdr Info-history))
   (Info-find-node (nth 0 hist) (nth 1 hist) t)
   (goto-char (nth 2 hist)))))
  (goto-char (point-min))
)

(defun Info-read-subfile (nodepos)
  (set-buffer (marker-buffer Info-tag-table-marker))
  (goto-char (point-min))
  (scan-buffer "\n" :tail t)
  (let (lastfilepos lastfilename)
    (forward-line 2)
    (catch 'foo
      (while (not (looking-at ""))
 (let ((beg (point))
       thisfilepos thisfilename)
   (scan-buffer ": " :tail t)
   (setq thisfilename  (buffer-substring beg (- (point) 2)))
   (setq thisfilepos (with-input-from-selected-buffer (read)))
   (if (> thisfilepos nodepos)
       (throw 'foo t))
   (setq lastfilename thisfilename)
   (setq lastfilepos thisfilepos))))
    (set-buffer (find-buffer "*info*"))
    (or (equal Info-current-subfile lastfilename)
 (let ((buffer-read-only nil))
   (declare (special buffer-read-only))
   (set-buffer-file-name nil)
   (widen)
   (erase-buffer (selected-buffer))
   (insert-file-contents lastfilename)
   (set-buffer-modified-p nil)
   (setq Info-current-subfile lastfilename)))
    (goto-char (point-min))
    (scan-buffer "\n" :tail t)
    (+ (- nodepos lastfilepos) (point))))

(defun Info-select-node ()
  (save-excursion
    ;; Find beginning of node.
    (scan-buffer "\n" :reverse t :tail t)
    (forward-line 2)
    ;; Get nodename spelled as it is in the node.
    (scan-buffer "Node:[ \t]*" :regexp t :reverse t :case-fold t :tail t)
    (setq Info-current-node
   (buffer-substring (point)
       (progn
         (skip-chars-forward "^,\t\n")
         (point))))
;   (Info-set-mode-line)
    ;; Find the end of it, and narrow.
    (beginning-of-line)
    (let (active-expression)
      (narrow-to-region (point)
   (if (scan-buffer "\n[\f]" :regexp t :tail t)
       (prog1
    (1- (point))
         (if (looking-at "[\n\f]*execute: " t)
      (progn
        (goto-char (match-end 0))
        (setq active-expression
       (with-input-from-selected-buffer (read))))))
     (point-max)))
      (if Info-enable-active-nodes (eval active-expression)))))

(defun Info-set-mode-line ()
  (setq mode-line-format
 (concat
  "Info:  ("
  (if Info-current-file
      (file-name-nondirectory Info-current-file)
    "")
  ")"
  (or Info-current-node ""))))

(defun Info-goto-node (nodename)
  "Go to info node named NAME.  Give just NODENAME or (FILENAME)NODENAME."
  (interactive "sGoto node: ")
  (let (filename)
    (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
    nodename)
    (setq filename (if (= (match-beginning 1) (match-end 1))
         ""
       (subseq nodename (match-beginning 2) (match-end 2)))
   nodename (subseq nodename (match-beginning 3) (match-end 3)))
    (let ((trim (string-match "\\s *\\'" filename)))
      (if trim (setq filename (substring filename 0 trim))))
    (let ((trim (string-match "\\s *\\'" nodename)))
      (if trim (setq nodename (subseq nodename 0 trim))))
    (Info-find-node (if (equal filename "") nil filename)
      (if (equal nodename "") "Top" nodename))))

(defvar Info-last-search nil
  "Default regexp for Info S command to search for.")

(defun Info-search (regexp)
  "Search for REGEXP, starting from point, and select node it's found in."
  (interactive "sSearch (regexp): ")
  (if (equal regexp "")
      (setq regexp Info-last-search)
    (setq Info-last-search regexp))
  (let ((found ())
 (current)
 (onode Info-current-node)
 (ofile Info-current-file)
 (opoint (point))
 (osubfile Info-current-subfile))
    (save-excursion
      (save-restriction
 (widen)
 (if (null Info-current-subfile)
     (progn
       (re-search-forward regexp)
       (setq found (point))))))
    (if (not found)
 (unwind-protect
     (let ((list ()))
       (set-buffer (marker-buffer Info-tag-table-marker))
       (goto-char (point-min))
       (search-forward "\n\nIndirect:")
       (save-restriction
  (narrow-to-region (point)
      (progn (search-forward "\n")
      (1- (point))))
  (goto-char (point-min))
  (search-forward (concat "\n" osubfile ": "))
  (beginning-of-line)
  (while (not (eobp))
    (re-search-forward "\\(^.*\\): [0-9]+$")
    (goto-char (+ (match-end 1) 2))
    (setq list (cons (cons (read (selected-buffer))
      (buffer-substring (match-beginning 1)
          (match-end 1)))
       list))
    (goto-char (1+ (match-end 0))))
  (setq list (nreverse list)
        current (car (car list))
        list (cdr list)))
       (while list
  (message "Searching subfile ~A ..." (cdr (car list)))
  (Info-read-subfile (car (car list)))
  (setq list (cdr list))
  (goto-char (point-min))
  (if (re-search-forward regexp t)
      (setq found (point) list ())))
       (if found
    (message "")
  (error "Search failed")))
   (if (not found)
       (progn (Info-read-subfile opoint)
       (goto-char opoint)
  (Info-select-node)))))
    (widen)
    (goto-char found)
    (Info-select-node)
    (or (and (equal onode Info-current-node)
      (equal ofile Info-current-file))
 (setq Info-history (cons (list ofile onode opoint) Info-history))
    )))

(defun Info-extract-pointer (name &optional errorname)
  (save-excursion
    (goto-char (point-min))
    (forward-line 1)
    (unless (scan-buffer (concat name ":") :reverse t :case-fold t :regexp
t)
      (error (concat "Node has no " (string-capitalize (or errorname
name)))))
    (goto-char (match-end 0))
    (Info-following-node-name)))

(defun Info-following-node-name (&optional allowedchars)
  (skip-chars-forward " \t")
  (buffer-substring
   (point)
   (progn
     (while (looking-at (concat "[" (or allowedchars "^,\t\n") "]"))
       (skip-chars-forward (concat (or allowedchars "^,\t\n") "("))
       (if (looking-at "(")
    (skip-chars-forward "^)")))
     (skip-chars-backward " ")
     (point))))

(defun Info-get-token (pos start all &optional errorstring)
  "Return the token around POS, POS must be somewhere inside the token START
is a regular expression which will match the beginning of the tokens
delimited string ALL is a regular expression with a single parenthesized
subpattern which is the token to be returned. E.g. '{\(.*\)}' would return
any string enclosed in braces around POS.  SIG optional fourth argument,
controls action on no match nil: return nil t: beep a string: signal an
error, using that string."
  (save-excursion
    (goto-char pos)
    ;; First look for a match for START that goes across POS.
    (while (and (not (bobp)) (> (point) (- pos (length start)))
  (not (looking-at start)))
      (forward-char -1))
    ;; If we did not find one, search back for START
    ;; (this finds only matches that end at or before POS).
    (or (looking-at start)
 (progn
   (goto-char pos)
   (scan-buffer start :regexp t :reverse t :tail t)))
    (let (found)
      (while (and (scan-buffer all :regexp t :tail t)
    (not (setq found (and (<= (match-beginning 0) pos)
     (> (match-end 0) pos))))))
      (if (and found (<= (match-beginning 0) pos)
        (> (match-end 0) pos))
   (buffer-substring (match-beginning 1) (match-end 1))
 (cond ((null errorstring)
        nil)
       ((eq errorstring t)
        (beep)
        nil)
       (t
        (error "No ~A around position ~D" errorstring pos)))))))

(defun Info-next ()
  "Go to the next node of this node."
  (interactive)
  (Info-goto-node (Info-extract-pointer "next")))

(defun Info-prev ()
  "Go to the previous node of this node."
  (interactive)
  (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous")))

(defun Info-up ()
  "Go to the superior node of this node."
  (interactive)
  (Info-goto-node (Info-extract-pointer "up")))

(defun Info-last ()
  "Go back to the last node visited."
  (interactive)
  (or Info-history
      (error "This is the first Info node you looked at"))
  (let (filename nodename opoint)
    (setq filename (car (car Info-history)))
    (setq nodename (car (cdr (car Info-history))))
    (setq opoint (car (cdr (cdr (car Info-history)))))
    (setq Info-history (cdr Info-history))
    (Info-find-node filename nodename)
    (setq Info-history (cdr Info-history))
    (goto-char opoint)))

(defun Info-directory ()
  "Go to the Info directory node."
  (interactive)
  (Info-find-node "dir" "top")
)

(defun Info-extract-menu-node-name (&optional errmessage)
  (skip-chars-forward " \t\n")
  (let ((beg (point)) str i)
    (skip-chars-forward "^:")
    (forward-char 1)
    (setq str
   (if (looking-at ":")
       (buffer-substring beg (1- (point)))
     (Info-following-node-name "^.,\t\n")))
    (while (setq i (string-match "\n" str i))
      (aset str i #\SPC))
    ;      (aset str i ?\ ))
  str))

;(defun Info-extract-menu-node-name (&optional errmessage multi-line)
;  (skip-chars-forward " \t\n")
;  (let ((beg (point))
; str i)
;    (skip-chars-forward "^:")
;    (forward-char 1)
;    (setq str
;   (if (looking-at ":")
;       (buffer-substring beg (1- (point)))
;     (skip-chars-forward " \t\n")
;     (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n"))))
;    (while (setq i (string-match "\n" str i))
;      (aset str i #\SPC))
;    ;; Collapse multiple spaces.
;    (while (string-match "  +" str)
;      (setq str (replace-match " " :literal literal)))
;    str))

(defun Info-menu-item-sequence (list)
  (while list
    (Info-menu-item (car list))
    (setq list (cdr list))))

(defun Info-menu (menu-item)
  (interactive
      (let ((completions '())
     (default)
     (last)
     (p (point)))
 (save-excursion
   (goto-char (point-min))
   (if (not (scan-buffer "\n* Menu:"))
       (error "No menu in this node"))
   (while (scan-buffer "\n\\* \\([^:\t\n]*\\):" :regexp t :tail t :case-fold
t)
     (if (and (null default)
       (prog1 (when last (< last p))
         (setq last (match-beginning 0)))
       (<= p last))
  (setq default (car completions)))
     (push (buffer-substring (match-beginning 1)
        (match-end 1))
    completions))
   (if (and (null default) last
     (< last p)
     (<= p (progn (end-of-line) (point))))
       (setq default (car completions))))
 (let (item)
   (while (null item)
     (setq item (completing-read "Menu item: " completions
     :default default
     :must-match completions
         ))
     (if (string= item "")
  (if default
      (setq item default)
    (setq item nil))))
   (list item))))
  (Info-goto-node (Info-extract-menu-item menu-item)))

(defun Info-follow-nearest-node ()
  "Follow a node reference near point. Like Info-menu,
Info-follow-reference, Info-next, depending on where point is. If no
reference to follow, moves to the next node, or up if none."
  (interactive)
  (or (Info-try-follow-nearest-node)
      (Info-next-preorder)))

(defun Info-try-follow-nearest-node ()
  "Follow a node reference near point.  Return non-nil if successful."
  (let (node)
    (cond
     ((setq node (Info-get-token (point) "\\*Note[ \n]"
     "\\*Note[ \n]\\([^:]*\\):"))
      (Info-follow-reference node))
     ((setq node (Info-get-token (point) "\\* " "\\* \\([^:]*\\)::"))
      (Info-goto-node node))
     ((setq node (Info-get-token (point) "\\* " "\\* \\([^:]*\\):"))
      (Info-menu node))
     ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)"))
      (Info-goto-node node))
     ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)"))
      (Info-goto-node node))
     ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)"))
      (Info-goto-node "Top"))
     ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)"))
      (Info-goto-node node)))
    node))

(defun Info-next-preorder ()
  "Go to the next subnode or the next node, or go up a level."
  (interactive)
  (cond ((Info-no-error (Info-next-menu-item)))
 ((Info-no-error (Info-next)))
 ((Info-no-error (Info-up))
  ;; Since we have already gone thru all the items in this menu,
  ;; go up to the end of this node.
  (goto-char (point-max))
  ;; Since logically we are done with the node with that menu,
  ;; move on from it.
  (Info-next-preorder))
 (t
  (error "No more nodes"))))

(defmacro Info-no-error (&rest body)
  (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil)))

(defun Info-extract-menu-item (menu-item)
  (setq menu-item (regexp-quote menu-item))
  (save-excursion
    (goto-char (point-min))
    (or (scan-buffer "\n* Menu:" :regexp t :tail t)
 #|(or (scan-buffer "* menu:")|#
 (error "No menu in this node"))
    (or (scan-buffer (concat "\n\\* " menu-item ":") :regexp t :tail t)
 (scan-buffer (concat "\n\\* " menu-item) :regexp t :tail t)
 (error "No such item in menu"))
    (beginning-of-line)
    (forward-char 2)
    (Info-extract-menu-node-name)))

(defun Info-extract-menu-counting (count)
  (save-excursion
    (goto-char (point-min))
    (or (scan-buffer "* Menu:" :tail t :case-fold t)
 (error "No menu in this node"))
;    (or (search-forward "\n* " nil t count)
;      (error "Too few items in menu"))
    (dotimes (i count)
      (unless (scan-buffer "\n* " :tail t)
 (error "Too few items in menu")))
    (Info-extract-menu-node-name)))

(defun Info-first-menu-item ()
  "Go to the node of the first menu item."
  (interactive)
  (Info-goto-node (Info-extract-menu-counting 1)))

(defun Info-second-menu-item ()
  "Go to the node of the second menu item."
  (interactive)
  (Info-goto-node (Info-extract-menu-counting 2)))

(defun Info-third-menu-item ()
  "Go to the node of the third menu item."
  (interactive)
  (Info-goto-node (Info-extract-menu-counting 3)))

(defun Info-fourth-menu-item ()
  "Go to the node of the fourth menu item."
  (interactive)
  (Info-goto-node (Info-extract-menu-counting 4)))

(defun Info-fifth-menu-item ()
  "Go to the node of the fifth menu item."
  (interactive)
  (Info-goto-node (Info-extract-menu-counting 5)))

(defun Info-exit ()
  "Exit Info by selecting some other buffer."
  (interactive)
  (switch-to-buffer (prog1 (other-buffer (selected-buffer))
      (bury-buffer (selected-buffer))))
  (if (find-buffer "*info tag table*")
      (kill-buffer "*info tag table*"))
  (kill-buffer "*info*")
)

(defun Info-undefined ()
  "Make command be undefined in Info."
  (interactive)
  (ding))

(defun Info-help ()
  "Enter the Info tutorial."
  (interactive)
  (Info-find-node "info"
  (if (< (window-height) 23)
      "Help-Small-Screen"
    "Help")))

(defun Info-summary ()
  "Display a brief summary of all Info commands."
  (interactive)
  (save-window-excursion
    (switch-to-buffer "*Help*")
    (erase-buffer (selected-buffer))
    (insert (documentation 'Info-mode))
    (goto-char (point-min))
    (let (ch flag)
      (while (progn (setq flag (not (pos-visible-in-window-p (point-max))))
       (message (if flag "Type Space to see more"
  "Type Space to return to Info"))
       (if (/= ?\  (setq ch (read-char)))
   (progn (setq unread-command-char ch) nil)
flag))
(scroll-up)))))

(defun Info-follow-reference (footnotename)
  "Follow cross reference named NAME to the node it refers to.
NAME may be an abbreviation of the reference name."
  (interactive
   (let ((completion-ignore-case t)
  completions default alt-default (start-point (point)) str i bol eol)
     (save-excursion
       ;; Store end and beginning of line.
       (end-of-line)
       (setq eol (point))
       (beginning-of-line)
       (setq bol (point))

       (goto-char (point-min))
       (while (scan-buffer "\\*Note[ \n\t]*\\([^:]*\\):" :regexp t :tail t)
  (setq str (buffer-substring
      (match-beginning 1)
      (1- (point))))
  ;; See if this one should be the default.
  (and (null default)
       (<= (match-beginning 0) start-point)
       (<= start-point (point))
       (setq default t))
  ;; See if this one should be the alternate default.
  (and (null alt-default)
       (and (<= bol (match-beginning 0))
     (<= (point) eol))
       (setq alt-default t))
  (setq i 0)
  (while (setq i (string-match "[ \n\t]+" str i))
    (setq str (concat (subseq str 0 i) " "
        (subseq str (match-end 0))))
    (setq i (1+ i)))
  ;; Record as a completion and perhaps as default.
  (if (eq default t) (setq default str))
  (if (eq alt-default t) (setq alt-default str))
  ;; Don't add this string if it's a duplicate.
  ;; We use a loop instead of "(assoc str completions)" because
  ;; we want to do a case-insensitive compare.
  (let ((tail completions)
        (tem (string-downcase str)))
    (while (and tail
         (not (string-equal tem (string-downcase (car (car tail))))))
      (setq tail (cdr tail)))
    (or tail
        (setq completions
       (cons (cons str nil)
      completions))))))
     ;; If no good default was found, try an alternate.
     (or default
  (setq default alt-default))
     ;; If only one cross-reference found, then make it default.
     (if (eq (length completions) 1)
  (progn
    (setq default (car (car completions)))
    (setq default (subseq default 1)))

     )
    (if completions
  (let ((input (completing-read (if default
        (concat "Follow reference named: [" default "] ")
      "Follow reference named: ")
           completions nil t)))
    (list (if (equal input "")
       default input)))
       (error "No cross-references in this node"))))
  (let (target beg i (str (concat "\\*Note " (regexp-quote footnotename))))
    (while (setq i (string-match " " str i))
      (setq str (concat (subseq str 0 i) "[ \t\n]+" (subseq str (1+ i))))
      (setq i (+ i 6)))
    (save-excursion
      (goto-char (point-min))
      (or (scan-buffer str :regexp t)
   (error "No cross-reference named ~A" footnotename))
      (goto-char (+ (match-beginning 0) 5))
      (setq target
     (Info-extract-menu-node-name "Bad format cross reference")))
    (while (setq i (string-match "[ \t\n]+" target i))
      (setq target (concat (subseq target 0 i) " "
      (subseq target (match-end 0))))
      (setq i (+ i 1)))
    (Info-goto-node target)))

(defun Info-search (regexp)
  "Search for REGEXP, starting from point, and select node it's found in."
  (interactive "sSearch (regexp): ")
  (if (equal regexp "")
      (setq regexp Info-last-search)
    (setq Info-last-search regexp))
  (let ((found ()) current
 (onode Info-current-node)
 (ofile Info-current-file)
 (opoint (point))
 (osubfile Info-current-subfile))
    (save-excursion
      (save-restriction
 (widen)
 (if (null Info-current-subfile)
     (progn (scan-buffer regexp :regexp t) (setq found (point)))
;   (condition-case err
     (progn (scan-buffer regexp :regexp t) (setq found (point))
;       (search-failed nil)
     )
;   )
      )
      ))
    (if (not found) ;can only happen in subfile case -- else would have
erred
      (unwind-protect
   (let ((list ()))
     (set-buffer (marker-buffer Info-tag-table-marker))
     (goto-char (point-min))
     (scan-buffer "\n\nIndirect:")
     (save-restriction
       (narrow-to-region (point)
    (progn (scan-buffer "\n")
      (1- (point))))
       (goto-char (point-min))
       (scan-buffer (concat "\n" osubfile ": "))
       (beginning-of-line)
       (while (not (eobp))
  (scan-buffer "\\(^.*\\): [0-9]+$" :regexp t)
  (goto-char (+ (match-end 1) 2))
  (setq list (cons (cons (read (selected-buffer))
           (buffer-substring (match-beginning 1)
        (match-end 1)))
     list))
  (goto-char (1+ (match-end 0))))
       (setq list (nreverse list)
      current (car (car list))
      list (cdr list)))
     (while list
       (message "Searching subfile ~A..." (cdr (car list)))
       (Info-read-subfile (car (car list)))
       (setq list (cdr list))
       (goto-char (point-min))
       (if (scan-buffer regexp :regexp t)
    (setq found (point) list ())))
     (if found
  (message "")
       (signal 'search-failed (list regexp))))
 (if (not found)
     (progn (Info-read-subfile opoint)
       (goto-char opoint)
       (Info-select-node)))))
    (widen)
    (goto-char found)
    (Info-select-node)
    (or (and (equal onode Info-current-node)
      (equal ofile Info-current-file))
 (setq Info-history (cons (list ofile onode opoint)
     Info-history)))))

(defvar *Info-mode-map* nil
  "Keymap containing Info commands.")
(unless *Info-mode-map*
  (setq *Info-mode-map* (make-sparse-keymap))
  ;  (suppress-keymap Info-mode-map)
  (define-key *Info-mode-map* #\. 'beginning-of-buffer)
  (define-key *Info-mode-map* #\SPC  'next-page)
  (define-key *Info-mode-map* #\RET  'Info-follow-nearest-node)
  (define-key *Info-mode-map* #\1 'Info-first-menu-item)
  (define-key *Info-mode-map* #\2 'Info-second-menu-item)
  (define-key *Info-mode-map* #\3 'Info-third-menu-item)
  (define-key *Info-mode-map* #\4 'Info-fourth-menu-item)
  (define-key *Info-mode-map* #\5 'Info-fifth-menu-item)
  (define-key *Info-mode-map* #\6 'undefined)
  (define-key *Info-mode-map* #\7 'undefined)
  (define-key *Info-mode-map* #\8 'undefined)
  (define-key *Info-mode-map* #\9 'undefined)
  (define-key *Info-mode-map* #\0 'undefined)
  (define-key *Info-mode-map* #\? 'Info-summary)
  (define-key *Info-mode-map* #\b 'beginning-of-buffer)
  (define-key *Info-mode-map* #\d 'Info-directory)
  (define-key *Info-mode-map* #\e 'Info-edit)
  (define-key *Info-mode-map* #\f 'Info-follow-reference)
  (define-key *Info-mode-map* #\g 'Info-goto-node)
  (define-key *Info-mode-map* #\h 'Info-help)
  (define-key *Info-mode-map* #\l 'Info-last)
  (define-key *Info-mode-map* #\m 'Info-menu)
  (define-key *Info-mode-map* #\n 'Info-next)
  (define-key *Info-mode-map* #\p 'Info-prev)
  (define-key *Info-mode-map* #\q 'Info-exit)
  (define-key *Info-mode-map* #\s 'Info-search)
  (define-key *Info-mode-map* #\u 'Info-up)
; (define-key *Info-mode-map* #\177 'scroll-down)
)

(defun Info-mode ()
  (kill-all-local-variables)
  (setq buffer-mode 'Info-mode)
  (setq mode-name "Info")
  (use-keymap *Info-mode-map*)
;  (set-syntax-table *text-mode-syntax-table*)
  (setq local-abbrev-table *text-mode-abbrev-table*)
  ;(setq case-fold-search t)
  ;  (setq buffer-read-only t)
  (setq buffer-read-only t)
  (setq hide-restricted-region t)
  (make-local-variable 'Info-current-file)
  (setq Info-current-file "")
  (make-local-variable 'Info-current-subfile)
  (setq Info-current-subfile "")
  (make-local-variable 'Info-current-node)
  (setq Info-current-node "")
  ;(make-local-variable 'Info-tag-table-marker)
  ;(setq Info-tag-table-marker (make-marker))
  (make-local-variable 'Info-history)
  (setq Info-history nil)
;  (Info-set-mode-line)
)

(defvar *Info-edit-map* nil
  "Local keymap used within `e' command of Info.")

(unless *Info-edit-map*
  (setq *Info-edit-map* (copy-keymap *text-mode-map*))
  (define-key *Info-edit-map* #\C-g 'Info-cease-edit))

(defun Info-edit-mode ()
  "Major mode for editing the contents of an Info node.
Like text mode with the addition of Info-cease-edit
which returns to Info mode for browsing.
\\{Info-edit-map}"
)

(defun Info-edit ()
  "Edit the contents of this Info node.
Allowed only if variable Info-enable-edit is non-nil."
  (interactive)
  (if (not Info-enable-edit)
      (error "Editing info nodes is not enabled"))
  (use-keymap *Info-edit-map*)
  (setq buffer-mode 'Info-edit-mode)
  (setq mode-name "Info Edit")
;  (kill-local-variable 'mode-line-format)
  (setq buffer-read-only nil)
  ;; Make mode line update.
  (set-buffer-modified-p (buffer-modified-p))
  (message "Editing: Type C-g to return to info"))

(defun Info-cease-edit ()
  "Finish editing Info node; switch back to Info proper."
  (interactive)
  ;; Do this first, so nothing has changed if user C-g's at query.
  (and (buffer-modified-p)
       (yes-or-no-p "Save the file? ")
       (save-buffer))
  (use-keymap *Info-mode-map*)
  (setq buffer-mode 'Info-mode)
  (setq mode-name "Info")
  ;  (Info-set-mode-line)
  (setq buffer-read-only t)
  ;; Make mode line update.
  (set-buffer-modified-p (buffer-modified-p))
  (and (marker-point Info-tag-table-marker)
       (buffer-modified-p)
       (message "Tags may have changed.  Use Info-tagify if necessary")))


;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;-------------------------------------------------------------------
(defun aset (array indexes value)
  (setf (aref array indexes) value))

(defun file-name-directory (filename)
  (directory-namestring filename))

(defun file-name-nondirectory (filename)
  (file-namestring filename))

(defun file-name-sans-versions (name)
  "Return FILENAME sans backup versions or strings.
This is a separate procedure so your site-init or startup file can
redefine it."
  (substring name 0
      (or (string-match "\\.~[0-9]+~\\'" name)
  (string-match "~\\'" name)
  (length name))))