[Date Prev] [Date Index] [Date Next]
[Thread Prev] [Thread Index] [Thread Next]

[xyzzy:00460] Re: info

須田 さん、こんにちは。

    Thu, 24 Sep 1998 12:19:46 +0900 の
   “[xyzzy:00458] Re: info”
    への返事です.

マーカの互換性がないことが分かりました(^^;
で、もしかしたらそこそこ動くかもしれない版です。


;; Info package for Emacs  -- could use a "create node" feature.
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; This file is 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
   Info-prev Info-exit Info-search Info-up Info Info-mode
   *Info-mode-map* *info-buffer* *Info-directory*))

(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 nil
  "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* "d:/usr/tmp/mule2/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.")

(defvar *info-buffer* nil)

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

;; Go to an info node specified as separate filename and nodename.
;; no-going-back is non-nil if recovering from an error in this function;
;; it says do not attempt further (recursive) error recovery.

(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))
  ;  (scan-buffer "File:")
  ;  (recenter 0)
)

(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))))

;; Select the info node that point is in.
(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 (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 (with-input-from-selected-buffer (read))
				       (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)))))

(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)
      (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-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)
;  (cd "d:/Meadow/1.00/info")
  (Info-find-node "dir" "top"))

(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 str i)
	(save-excursion
	  (goto-char (point-min))
	  (while (scan-buffer "\\*note[ \n\t]*\\([^:]*\\):" :regexp t)
	    (setq str (buffer-substring
		       (match-beginning 1)
		       (1- (point))))
	    (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)))
	    (setq completions
		  (cons (cons str nil)
			completions))))
	(if completions
	    (list (minibuffer-complete-and-exit "Follow reference named: " completions
						nil t))
	  (error "No cross-references in this node"))))
  (let (target beg i (str (concat "\\*note " 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-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-menu-item-sequence (list)
  (while list
    (Info-menu-item (car list))
    (setq list (cdr list))))

(defun Info-menu (menu-item)
  (interactive "sMenu item: ")
  (Info-goto-node (Info-extract-menu-item menu-item)))

(defun Info-extract-menu-item (menu-item)
  (save-excursion
    (goto-char (point-min))
    (or (scan-buffer "* Menu:")
	#|(or (scan-buffer "* menu:")|#
	(error "No menu in this node"))
    (or (scan-buffer (concat "* " menu-item))
	(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)))))

(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)))))

(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* #\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")
  ;  (setq *page-delimiter* #\C-_)
  (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)
  (or 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 (substitute-command-keys
	    "Editing: Type \\[Info-cease-edit] 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)
       (y-or-n-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")))
;--------------------------------------------------------------------------
(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))))

--
亀井哲弥(Tetsuya Kamei)
kamei@xxxxxxxxxxxx/JCA00343@xxxxxxxxxxx
Index Home