;;; -*- Mode: Lisp; Package: USER; Last updated: "2007/12/31 01:05:52" -*-
;;;
;;; This file is not part of xyzzy.
;;;
;;;   info-modoki-mode.l --- reference.txt 嶲徠梡儌乕僪
;;;
;;;     by HIE Masahiro <madoinu@ybb.ne.jp>
#|

仭奣梫

  reference.txt 傪嶲徠偟傑偡丅


仭僀儞僗僩乕儖

  1. info-modoki-mode.l 傪 site-lisp 偵僐僺乕偡傞丅

  2. 昁梫偵墳偠丆僶僀僩僐儞僷僀儖偡傞丅

       M-x byte-compile-file

  3. 乽reference.txt乿傪庤偵擖傟丆etc 僼僅儖僟偵僐僺乕偡傞丅

  4. 僉乕儚乕僪僼傽僀儖乽lisp乿傪庤偵擖傟丆etc 僼僅儖僟偵僐僺乕偡傞丅

  5. .xyzzy 偐 siteinit.l 偵埲壓偺婰弎傪捛壛偡傞丅

      (require "info-modoki-mode")

  乽reference.txt乿丆僉乕儚乕僪僼傽僀儖乽lisp乿偼丆

      http://hie.s64.xrea.com/xyzzy/note/use_reference.html

  偐傜擖庤偡傞偐丆reference.xml 偐傜嵅栰偝傫偺 xml2xxx.l 側偳傪巊偭偰嶌
  惉偡傞偐偟偰偔偩偝偄丅


仭巊偄曽

    M-x imm1 : 僙儗僋僔儑儞傑偨偼僇儗儞僩儚乕僪偱儕僼傽儗儞僗傪嶲徠
    M-x immr : 僞僀僩儖傪巜掕偟偰儕僼傽儗儞僗傪嶲徠
    M-x immf : 慡暥専嶕
    M-x imms : 僙僋僔儑儞専嶕
    M-x immt : 僉乕儚乕僪偵儅僢僠偡傞僞僀僩儖堦棗傪昞帵
    M-x immi : 栚揑暿嶕堷
    M-x immp : 婛懚偺儕僼傽儗儞僗僶僢僼傽傪昞帵
    M-x immg : 僙儗僋僔儑儞傑偨偼僇儗儞僩儚乕僪偱 lisp 僼僅儖僟傪 Grep乮偍傑偗乯
    C-x F1   : 億僢僾傾僢僾儊僯儏乕傪昞帵


仭僉乕僶僀儞僪

  info-modoki-mode

    F1  : 僙儗僋僔儑儞偺暥帤楍傑偨偼僇乕僜儖埵抲偺扨岅傪嶲徠
    F4  : 娭悢偺幚懺傊僞僌僕儍儞僾
    RET :     摨  忋
    r   : 僞僀僩儖傪巜掕偟偰儕僼傽儗儞僗傪嶲徠
    t   : 僉乕儚乕僪傪巜掕偟偰僞僀僩儖傪専嶕偟丆堦棗傪嶌惉
    T   : 僙儗僋僔儑儞偺暥帤楍傑偨偼僇乕僜儖埵抲偺扨岅偱僞僀僩儖傪専嶕偟丆堦棗傪嶌惉
    s   : 僙僋僔儑儞専嶕
    f   : 慡暥専嶕
    i   : 栚揑暿嶕堷昞帵
    M-left : 栠傞
    h   : 嶲徠棜楌傪億僢僾傾僢僾偱堦棗昞帵
    g   : 僞僀僩儖傪僉乕偵 lisp 僼僅儖僟傪 grep
    G   : 僇乕僜儖埵抲偺扨岅傪僉乕偵 lisp 僼僅儖僟傪 grep
    c   : 僞僀僩儖傪僉儖儕儞僌偵捛壛
    b   : info-modoki-mode 僶僢僼傽傪僩僌儖
    q   : 廔椆
    Q   : 廔椆仌僶僢僼傽嶍彍

    [慡暥専嶕/僙僋僔儑儞専嶕僶僢僼傽梡]
    l   : 慡暥専嶕偱僸僢僩偟偨慡僞僀僩儖傪億僢僾傾僢僾偱堦棗昞帵
    n   : 師偺崁栚傊堏摦
    p   : 慜偺崁栚傊堏摦
    SPC : 師儁乕僕傊堏摦
    C-h : 慜儁乕僕傊堏摦

  imm-summary-mode乮僞僀僩儖堦棗梡儅僀僫乕儌乕僪乯

    F1  : 尰嵼峴偺僞僀僩儖傪嶲徠
    RET : 尰嵼峴偺僞僀僩儖傪嶲徠
    TAB : 尰嵼峴偺僞僀僩儖傪嶲徠乮僼僅乕僇僗偼堏摦偟側偄乯
    SPC : 尰嵼峴偺僞僀僩儖傪嶲徠仌僗僋儘乕儖傑偨偼師峴偺僞僀僩儖傪嶲徠


仭愝掕椺

  F1 僉乕偱丆僇乕僜儖埵抲偺扨岅乮傑偨偼僙儗僋僔儑儞偺暥帤楍乯傪
  reference.txt 偐傜堷偔丅

    (define-key ed::*lisp-mode-map* #\F1 'imm-refer-selection)
    (define-key ed::*lisp-interaction-mode-map* #\F1 'imm-refer-selection)


仭峏怴棜楌

  [Version 2.05] 2007-12-31 (寧)
  丒MIT儔僀僙儞僗偵偟偨丅

  [Version 2.04] 2006-10-14 (Sat)
  丒reference.txt 20061001斉偺僼僅乕儅僢僩偵懳墳丅
  丒*imm-section-list* 峏怴丅

  [Version 2.03] 2005-06-12 (Sun)
  丒僞僌僕儍儞僾偺懳徾専嶕曽朄偺(庤敳偒側)廋惓摍丅

  [Version 2.02] 2005-06-11 (Sat)
  丒嵅栰偝傫偐傜捀偄偨丆娭悢偺幚懺傊僞僌僕儍儞僾偱偒傞僷僢僠傪
    庢傝崬傒丅姶幱偱偡丅m(_ _)m

  [Version 2.01] 2004-11-28 (Sun)
  丒OHKUBO偝傫偺慺憗偄屼巜揈偵傛傝imm-refer-selection 偺 alias 
    傪 imm1 偵曄峏偟偨丅(^^;

  [Version 2.00] 2004-11-27 (Sat)
  丒imm-refer 傪彂偒捈偟偨丅乮info-modoki.l 偐傜偺堷梡傪側偔偟偨丅乯
  丒儔僀僙儞僗傪 NYSL 偲偟偨丅
  丒慡暥専嶕偑偱偒傞傛偆偵偟偨丅
  丒巜掕僙僋僔儑儞拪弌偑偱偒傞傛偆偵偟偨丅
  丒栚揑暿嶕堷傪昁梫側晹暘偩偗昞帵偡傞傛偆偵偟偨丅
  丒巊傢側偝偘側婡擻傪嶍彍偟偨丅
  丒僉乕僶僀儞僪傪偄偔傜偐曄峏偟偨丅
  丒偦偺懠偄傠偄傠側曄峏丅

  [Version 1.04] 2003/07/04 22:28:32 +0900
  丒imm-search 偱壗傕僸僢僩偟側偐偭偨偲偒偼丆僶僢僼傽傪昞帵偟側
    偄傛偆偵偟偨丅
  丒apropos, describe-* 側娭悢傪 info-modoki-mode 偱巊偭偰傒偨丅

  [Version 1.03] 2003/06/19 18:01:26 +0900
  丒imm-copy-title 傪捛壛偟偨丅
  丒imm-grep 偁偨傝偺摦嶌傪彮偟曄峏偟偨丅

  [Version 1.02] 2003/06/11 23:08:46 +0900
  丒imm-grep-title 偼丆info-modoki-mode 偱偟偐巊傢側偄偺偱偦偺傛
    偆偵丆崌傢偣偰 imm-grep 傕曄峏偟偨丅
  丒imm-grep-title 幚峴帪偵僙儗僋僔儑儞偑懚嵼偟偰偄傞偲丆偆傑偔
    摦嶌偟偰偄側偐偭偨偺傪廋惓偟偨丅
  丒imm-history-back 傪 M-left 偵傕僶僀儞僪偟偨丅
  丒偦偺懠嵶偐偄曄峏丅

  [Version 1.01] 2003/06/11 00:10:22 +0900
  丒(require "grepd") 傪捛壛偟偨丅

  [Version 1.00] 2003/06/10 06:19:12 +0900
  丒弶斉


仭儔僀僙儞僗

  info-modoki-mode.l 偼MIT儔僀僙儞僗偵婎偯偄偰棙梡壜擻偱偡丅
  <http://www.opensource.org/licenses/mit-license.php>

Copyright (c) 2007 HIE Masahiro

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

|#

(provide "info-modoki-mode")

;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 曄悢愝掕乮揔摉偵僇僗僞儅僀僘偡傞偁偨傝乯
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

;;; reference.txt 偺僷僗
(defvar *imm-reference-file* (merge-pathnames "etc/reference.txt"
					      (si:system-root)))

(defvar *info-modoki-mode-keyword-file* "lisp")

;;; imm-full-search 梡僉乕儚乕僪偺怓乮set-text-attribute乯
(defvar *imm-atter-full-search* '(:foreground 1))

;;; imm-full-search 梡僙僷儗乕僞
(defvar *imm-full-search-sep*
  "#|((((((((((((((((((((((((((((((((( 婽 )))))))))))))))))))))))))))))))))|#")

;;; 儕僼傽儗儞僗偺僙僋僔儑儞堦棗
(defvar *imm-section-list*
  '("僨乕僞宆" "曄悢偲掕悢" "惂屼峔憿" "僷僢働乕僕" "娭悢" "儅僋儘"
    "僔儞儃儖" "悢抣" "暥帤" "暥帤僄儞僐乕僨傿儞僌" "暥帤楍" "僔乕働儞僗" "儕僗僩"
    "僴僢僔儏" "攝楍" "僠儍儞僋" "昡壙" "擖弌椡" "僼傽僀儖僔僗僥儉" "僄儔乕"
    "僂傿儞僪僂" "僶僢僼傽" "儈僯僶僢僼傽" "儕乕僕儑儞" "儌乕僪"
    "僔儞僞僢僋僗" "僉乕儅僢僾" "僥僉僗僩" "専嶕丒惓婯昞尰" "僟僀傾儘僌"
    "擔晅丒帪娫" "儊僯儏乕" "僼傽僀儔" "億僕僔儑儞" "僾儘僙僗"
    "僔僗僥儉" "偦偺懠" "枹暘椶"))

;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 偦偺懠偺曄悢愝掕
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defvar *imm-buffer* " *imm*")
(defvar *imm-buffer-refer* " *imm-refer*")
(defvar *imm-buffer-titles* " *imm-titles*")
(defvar *imm-buffer-search* " *imm-full-search*")

(defvar *info-modoki-mode-keyword-hash-table* nil)
(defvar *info-modoki-mode-hook* nil)
(defvar *info-modoki-mode-quit-hook* nil)
(defvar *info-modoki-mode-map* nil)

(defvar-local *imm-summary-mode* nil)
(defvar *imm-summary-mode-map* nil)

(defvar *imm-full-search-title-list* nil)
(defvar *imm-history* nil)
(defvar *imm-history-pointer* nil)
(defvar *imm-menu* nil)


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 儕僼傽儗儞僗嶲徠
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defun imm-refer-selection ()
  "info-modoki-mode 僙儗僋僔儑儞偺暥帤楍傑偨偼僇儗儞僩儚乕僪傪嶲徠"
  (interactive)
  (let (str)
    (if (save-excursion
	  (goto-bol)
	  (and (eq buffer-mode 'info-modoki-mode)
	       (looking-at "^\\(仭\\|  - \\)")))
	(imm-refer-from-title)
      (when (setf str (imm-keyword))
	(imm-refer str)))))

(defun imm-refer (str &optional nohistory otherwindow)
  "info-modoki-mode 儕僼傽儗儞僗徠夛"
  (interactive "sReference(regexp): ")
  (unless (equal str "")
    (let (b r)
      (save-excursion
	(setf b (imm-erase-buffer *imm-buffer-refer*))
	(imm-load)
	(with-output-to-buffer (b)
	  (when (scan-buffer (compile-regexp (concat "^仭" (regexp-quote str) "[ \t]*$")))
	    (setf from (point))
	    (format t "~A"
		    (buffer-substring
		     (point)
		     (progn
		       (or (scan-buffer "^仭" :regexp t :no-dup t)
			   (goto-char (point-max)))
		       (- (point) 2))))))
	(set-buffer b)
	(unless (eq (point-min) (point-max))
	  (unless nohistory
	    (setf *imm-history* (remove str *imm-history* :test #'equal))
	    (push str *imm-history*))
	  (setf r t)))
      (unless r
	(imm-msgbox str)
	(return-from imm-refer nil))
      (if (and (not otherwindow)
	       (eq buffer-mode 'info-modoki-mode))
	  (set-buffer b)
	(pop-to-buffer b t))
      (info-modoki-mode t)
      (goto-char (point-min)))))

(defun imm-show-index ()
  "info-modoki-mode 栚揑暿嶕堷昞帵"
  (interactive)
  (imm-refer "栚揑暿嶕堷"))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 僞僀僩儖専嶕
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

;;; 仭偮偐偭偰側乕偄
;;; 僙儗僋僔儑儞偑側偗傟偽僇儗儞僩儚乕僪傪嶲徠
(defun imm-titles-selection ()
  "info-modoki-mode 僙儗僋僔儑儞偺暥帤楍偐傜僞僀僩儖専嶕仌堦棗傪嶌惉"
  (interactive)
  (let (str)
    (when (setf str (imm-keyword))
      (imm-titles str))))

(defun imm-titles (pattern)
  "info-modoki-mode 僞僀僩儖専嶕仌堦棗傪嶌惉"
  (interactive "sReference Titles (regexp): ")
  (unless (zerop (length pattern))
    (let (ptn b r)
      (setf ptn pattern)
      ;; 愭摢堦抳偺応崌偺張棟
      (if (string-match "\\(\\^\\)\\(.*\\)" pattern)
	  (setf pattern (string-replace-match pattern "^仭\\2"))
	(setf pattern (concat "^仭.*" pattern)))
      (save-excursion
	(setf b (imm-erase-buffer *imm-buffer-titles*))
	(imm-load)
	(with-output-to-buffer (b)
	  (while (scan-buffer (compile-regexp pattern) :regexp t)
	    (format t "~A~%" (buffer-substring (progn (goto-bol)(point))
					       (progn (goto-eol)(point))))))
	(set-buffer b)
	(unless (eq (point-min) (point-max))
	  (setf r t)))
      (unless r
	(imm-msgbox ptn)
	(return-from imm-titles nil))
      (if (eq buffer-mode 'info-modoki-mode)
	  (set-buffer b)
	(pop-to-buffer b t))
      (info-modoki-mode)
      (imm-summary-mode))))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 慡暥専嶕
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defun imm-full-search (pattern &optional nocolor)
  "info-modoki-mode 慡暥専嶕"
  (interactive "sReference Full-text search (regexp): ")
  (setf *imm-full-search-title-list* nil)
  (let (b r)
    (save-excursion
      (setf b (imm-erase-buffer *imm-buffer-search*))
      (imm-load)
      (with-output-to-buffer (b)
	(while (scan-buffer pattern :regexp t)
	  (scan-buffer "^仭" :regexp t :reverse t)
	  (if (looking-at "^仭娭悢堦棗")
	      (return)
	    (pushnew (save-excursion
		       (buffer-substring (1+ (point))
					 (progn (goto-eol) (point))))
		     *imm-full-search-title-list* :test #'equal))
	  (format t "~A~%~A" *imm-full-search-sep*
		  (buffer-substring
		   (point)
		   (progn
		     (or (scan-buffer "^仭" :regexp t :no-dup t)
			 (goto-char (point-max)))
		     (point))))))
      (set-buffer b)
      (unless (eq (point-min) (point-max))
	(setf r t)))
    (unless r
      (imm-msgbox pattern)
      (return-from imm-full-search nil))
    (if (eq buffer-mode 'info-modoki-mode)
	(set-buffer b)
      (pop-to-buffer b t))
    (info-modoki-mode t)
    (goto-char (point-min))
    ;; 僉乕儚乕僪偵拝怓
    (unless nocolor
      (save-excursion
	(while (scan-buffer pattern :regexp t :no-dup t)
	  (when (looking-at pattern)
	    (apply #'set-text-attribute (match-beginning 0) (match-end 0)
		   'imm
		   *imm-atter-full-search*)))))))

(defun imm-query-section ()
  "info-modoki-mode 僙僋僔儑儞専嶕"
  (interactive)
  (popup-list *imm-section-list*
	      #'(lambda (s)
		  (imm-full-search (regexp-quote (concat "[    section]: " s)) t)
		  (refresh-screen))))

(defun imm-popup-title-list (&optional arg)
  "info-modoki-mode 慡暥専嶕偵僸僢僩偟偨僞僀僩儖堦棗"
  (interactive "p")
  (when (equal (buffer-name (selected-buffer))
	       *imm-buffer-search*)
    (let ((menu (create-popup-menu)) lst p)
      (setf lst (if arg
		    (sort (copy-tree *imm-full-search-title-list*)
			  #'string-lessp)
		  (reverse (copy-tree *imm-full-search-title-list*))))
      (save-excursion
	(goto-bol)
	(when (looking-for *imm-full-search-sep*)
	  (next-line))
	(scan-buffer "^仭" :regexp t :reverse t :tail t)
	(setf p (string-right-trim " \t" (buffer-substring (point) (progn (goto-eol) (point))))))
      (dolist (item lst)
	(let ((s item))
	  (add-menu-item menu nil s
			 #'(lambda () (interactive)
			     (goto-char (point-min))
			     (scan-buffer
			      (compile-regexp (concat "^仭" (regexp-quote s) "[ \t]*$")))
			     (previous-line)
			     (recenter 0))
			 #'(lambda ()
			     (when (string= s p) :check))
			 )))
      (track-popup-menu menu))))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 info-modoki-mode
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(unless *info-modoki-mode-map*
  (setf *info-modoki-mode-map* (make-sparse-keymap))
  (define-key *info-modoki-mode-map* '#\F1  'imm-refer-selection)
  (define-key *info-modoki-mode-map* '#\RET 'imm-refer-selection)
  (define-key *info-modoki-mode-map* '#\r   'imm-refer)
  (define-key *info-modoki-mode-map* '#\f   'imm-full-search)
  (define-key *info-modoki-mode-map* '#\t   'imm-titles)
  (define-key *info-modoki-mode-map* '#\T   'imm-titles-selection)
  (define-key *info-modoki-mode-map* '#\s   'imm-query-section)
  (define-key *info-modoki-mode-map* '#\i   'imm-show-index)
  (define-key *info-modoki-mode-map* '#\M-Left 'imm-history-back)
  (define-key *info-modoki-mode-map* '#\h   'imm-popup-history)
  (define-key *info-modoki-mode-map* '#\l   'imm-popup-title-list)
  (define-key *info-modoki-mode-map* '#\g   'imm-grep-title)
  (define-key *info-modoki-mode-map* '#\G   'imm-grep)
  (define-key *info-modoki-mode-map* '#\c   'imm-copy-title)
  (define-key *info-modoki-mode-map* '#\q   'imm-quit)
  (define-key *info-modoki-mode-map* '#\Q   'imm-quit-and-delete-buffer)
  (define-key *info-modoki-mode-map* '#\n   'imm-next-node)
  (define-key *info-modoki-mode-map* '#\p   'imm-previous-node)
  (define-key *info-modoki-mode-map* '#\SPC 'next-page)
  (define-key *info-modoki-mode-map* '#\C-h 'previous-page)
  (define-key *info-modoki-mode-map* '#\b   'imm-switch-to-buffer)
  )

(defun info-modoki-mode (&optional full-search)
  (interactive)
  (kill-all-local-variables)
  (setf buffer-mode 'info-modoki-mode)
  (setf mode-name "info-modoki-mode")
  (use-keymap *info-modoki-mode-map*)
  (use-syntax-table ed::*lisp-mode-syntax-table*)
  (and *info-modoki-mode-keyword-file*
       (null *info-modoki-mode-keyword-hash-table*)
       (setf *info-modoki-mode-keyword-hash-table*
	     (load-keyword-file *info-modoki-mode-keyword-file* t)))
  (when *info-modoki-mode-keyword-hash-table*
    (make-local-variable 'keyword-hash-table)
    (setf keyword-hash-table *info-modoki-mode-keyword-hash-table*))
  ;; 僞僌僕儍儞僾梡
  (set-default-directory (merge-pathnames "lisp" (si:system-root)))
  (make-local-variable 'tags-find-target)
  (setf tags-find-target #'imm-tags-find-target)
  (make-local-variable 'tags-find-point)
  (setf tags-find-point #'ed::lisp-tags-find-point)
  ;; 僶僢僼傽偺忬懺傪挷惍
  (setf need-not-save t)
  (setf kept-undo-information nil)
  (setf auto-save nil)
  (setf hide-restricted-region t)
  (set-buffer-modified-p nil)
  (setf buffer-read-only t)
  ;(setf ed::*paren-status* nil)
  (when (member "paren" *modules* :test #'string=)
    (setf ed::*paren-status* nil))
  (let ((buf (selected-buffer)))
    (set-local-window-flags buf (+ *window-flag-newline*
				   *window-flag-tab*
				   *window-flag-full-width-space*
				   *window-flag-eof*
				   *window-flag-line-number*
				   *window-flag-half-width-space*
				   *window-flag-scrolling*)
			    nil)
    (set-local-window-flags buf (+ (if (boundp '*window-flag-fold-mark*)
				       *window-flag-fold-mark*
				     *window-flag-fold-line*))
			    t))
  (run-hooks '*info-modoki-mode-hook*))

;;; 尰嵼抧揰偲娭楢偡傞娭悢柤偺愗傝弌偟
(defun imm-tags-find-target ()
  (let* ((opoint (point))
	 (name (progn
		 (scan-buffer "仭\\(.+\\)$" :regexp t :reverse t)
		 (match-string 1)
		 ))
	 (functionp (progn
		      (scan-buffer "\\[       type\\]: \\(.+\\)$" :regexp t)
		      (when (member (match-string 1)
				    '("Special Form" "Accessor" "Macro" "Function")
				    :test 'equal) t))
		    ))
    (goto-char opoint)
    (values nil name functionp)))

(defun imm-history-back ()
  "info-modoki-mode 儕僼傽儗儞僗嶲徠棜楌傪慿傞"
  (interactive)
  (let (h p s)
    (setf h *imm-history*)
    (if (eq *last-command* 'imm-history-back)
	(setf p (cdr *imm-history-pointer*))
      (setf p (cdr h)))
    (save-excursion
      (goto-char (point-min))
      (if (looking-at "^仭栚揑暿嶕堷")
	  (setf s (car h)
		*imm-history-pointer* h)
	(setf s (car p)
	      *imm-history-pointer* p)))
    (if (zerop (length s))
	(message "側偄傛傫")
      (imm-refer s t))))

(defun imm-popup-history ()
  "info-modoki-mode 儕僼傽儗儞僗嶲徠棜楌堦棗"
  (interactive)
  (let ((menu (create-popup-menu nil))
	(i 0))
    (dolist (item *imm-history*)
      (when (> i 15)
	(return nil))
      (let ((title item))
	(add-menu-item menu nil
		       title
		       #'(lambda () (interactive)
			   (imm-refer title t))))
      (setf i (1+ i)))
    (track-popup-menu menu)))

(defun imm-copy-title ()
  "info-modoki-mode 僞僀僩儖傪僉儖儕儞僌偵捛壛"
  (interactive)
  (when (eq buffer-mode 'info-modoki-mode)
    (let ((str (imm-title)))
      (unless (zerop (length str))
	(ed::kill-new str)
	(message "title copied")))))

(defun imm-quit (&optional arg)
  "info-modoki-mode 廔椆"
  (interactive "p")
  (when (eq buffer-mode 'info-modoki-mode)
    (when arg
      (close-selected-buffer))
    (if (> (count-windows) 1)
	(delete-window)
      (unless arg
	(previous-buffer)))
    (run-hooks '*info-modoki-mode-quit-hook*)))

(defun imm-quit-and-delete-buffer ()
  "info-modoki-mode 廔椆仌僶僢僼傽嶍彍"
  (interactive)
  (imm-quit t))

(defun imm-next-node (&optional previous)
  "info-modoki-mode 慡暥専嶕僶僢僼傽偱師偺崁栚偵堏摦"
  (interactive)
  (scan-buffer *imm-full-search-sep* :no-dup t :reverse previous)
  (recenter 0))

(defun imm-previous-node (&optional previous)
  "info-modoki-mode 慡暥専嶕僶僢僼傽偱慜偺崁栚偵堏摦"
  (interactive)
  (imm-next-node t))

(defun imm-switch-to-buffer ()
  "info-modoki-mode 儕僼傽儗儞僗僶僢僼傽傪愗懼"
  (interactive)
  (let ((lst (list *imm-buffer-refer* *imm-buffer-titles* *imm-buffer-search*)))
    (if (eq buffer-mode 'info-modoki-mode)
	;; 儕僼傽儗儞僗僶僢僼傽傪愗懼
	(progn
	  (while (not (equal (buffer-name (selected-buffer)) (car lst)))
	    (let ((x (pop lst)))
	      (setf lst (nconc lst (list x)))))
	  (dolist (b (cdr lst))
	    (when (find-buffer b)
	      (set-buffer b)
	      (return))))
      ;; 婛懚偺儕僼傽儗儞僗僶僢僼傽傪昞帵
      (dolist (b lst)
	(when (find-buffer b)
	  (pop-to-buffer b t)
	  (return))))))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 imm-summary-mode
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(unless *imm-summary-mode-map*
  (setf *imm-summary-mode-map* (make-sparse-keymap))
  (define-key *imm-summary-mode-map* '#\TAB 'imm-view)
  (define-key *imm-summary-mode-map* '#\SPC 'imm-view-next))

(defun imm-summary-mode (&optional (arg nil sv))
  (interactive "p")
  (ed::toggle-mode '*imm-summary-mode* arg sv)
  (update-mode-line t)
  (if *imm-summary-mode*
      (set-minor-mode-map *imm-summary-mode-map*)
    (unset-minor-mode-map *imm-summary-mode-map*))
  t)

(pushnew '(*imm-summary-mode* . "imm-titles") *minor-mode-alist* :key #'car)

(defun imm-view ()
  "info-modoki-mode 尰嵼峴偺僞僀僩儖傪嶲徠"
  (interactive)
  (when (imm-refer-from-title t)
    (other-window -1)))

(defun imm-view-next ()
  "info-modoki-mode 尰嵼峴偺僞僀僩儖傪嶲徠仌僗僋儘乕儖傑偨偼師峴偺僞僀僩儖傪嶲徠"
  (interactive)
  (let ((s (imm-title)))
    (if (eq *last-command* 'imm-view-next)
	(progn
	  (other-window 1)
	  (let ((r (next-page)))
	    (recenter)
	    (other-window -1)
	    (unless r
	      (next-line)
	      (imm-view))))
      (imm-view))))

;;; 嶕堷柤傑偨偼僞僀僩儖傪嶲徠
(defun imm-refer-from-title (&optional otherwindow)
  (let (beg end)
    (save-excursion
      (setf end (progn
		  (goto-eol)
		  (point)))
      (setf beg (progn
		  (goto-bol)
		  (cond ((looking-at "^  - ")
			 (forward-char 4))
			((looking-at "^仭")
			 (forward-char 1))
			(t
			 (return-from imm-refer-from-title nil)))
		  (point))))
    (unless (= beg end)
      (imm-refer (buffer-substring beg end) nil otherwindow)))
  t)


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 Grep
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(require "grepd")

(defun imm-grep (&optional keyword)
  "info-modoki-mode lisp 僼僅儖僟傪 Grep"
  (interactive)
  (let ((key (if keyword keyword (imm-keyword))))
    (ed::scan-files key "*.l" (merge-pathnames "lisp" (si:system-root)))))

(defun imm-grep-title ()
  "info-modoki-mode 僞僀僩儖傪僉乕偵 lisp 僼僅儖僟傪 Grep"
  (interactive)
  (when (eq buffer-mode 'info-modoki-mode)
    (imm-grep (imm-title))))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 apropos, describe
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defun imm-apropos ()
  (interactive)
  (call-interactively #'apropos)
  (info-modoki-mode))

(defun imm-command-apropos ()
  (interactive)
  (call-interactively #'command-apropos)
  (info-modoki-mode))

(defun imm-describe-key ()
  (interactive)
  (call-interactively #'describe-key)
  (when (equal (buffer-name (selected-buffer)) "*Help*")
    (info-modoki-mode)))

(defun imm-describe-bindings ()
  (interactive)
  (call-interactively #'describe-bindings)
  (info-modoki-mode))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 曗彆娭悢
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

;;; 僇乕僜儖埵抲偺扨岅傑偨偼僙儗僋僔儑儞偺暥帤楍傪曉偡
(defun imm-keyword ()
  (let ((str nil)
	beg end)
    (if (pre-selection-p)
	(selection-start-end (b e)
	  (setf beg b
		end e))
      (save-excursion
	(setf end (progn
		    (or (skip-syntax-spec-forward "w_")
			(skip-syntax-spec-backward "^w_"))
		    (point)))
	(setf beg (progn
		    (skip-syntax-spec-backward "w_")
		    (point)))))
    (setf str (if (= beg end) "" (buffer-substring beg end)))
    str))

;;; 僞僀僩儖傪曉偡
(defun imm-title ()
  (save-excursion
    (stop-selection)
    (goto-char (point-min))
    (forward-char 1)
    (imm-keyword)))

;;; 儕僼傽儗儞僗偺儘乕僪
(defun imm-load ()
  (set-buffer (or (find-buffer *imm-buffer*)
		  (let ((b (create-new-buffer *imm-buffer*)))
		    (set-buffer b)
		    (insert-file-contents *imm-reference-file*)
		    b)))
  (goto-char (point-min)))

;;; 巜掕偟偨僶僢僼傽偺撪梕傪嶍彍
(defun imm-erase-buffer (buffer)
  (let ((b (switch-to-buffer buffer)))
    (setf buffer-read-only nil)
    (erase-buffer b)
    b))

;;; 僉乕儚乕僪偑尒偮偐傜側偐偭偨応崌偺儊僢僙乕僕
(defun imm-msgbox (str)
  (case (apply 'message-box
	       `(,(concat str "\n\n僉乕儚乕僪偑尒偮偐傜傫偗偳丆側傫偐偡傞丠")
		 "info-modoki-mode" nil
		 :button1 "偟側偄(&C)"
		 :button2 "僞僀僩儖専嶕(&T)"
		 :button3 "慡暥専嶕(&F)"
		 :button4 "栚揑暿嶕堷(&I)"
		 ))
    (:button1 nil)
    (:button2 (imm-titles str))
    (:button3 (imm-full-search str))
    (:button4 (imm-show-index))))


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 Menu
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(defun imm-menu ()
  (interactive)
  (unless *imm-menu*
    (setf *imm-menu*
	  (define-popup-menu
	    (:item nil "儕僼傽儗儞僗嶲徠(&R)"                 'imm-refer)
	    (:item nil "儕僼傽儗儞僗慡暥専嶕(&F)"             'imm-full-search)
	    (:item nil "儕僼傽儗儞僗僙僋僔儑儞専嶕(&S)"       'imm-query-section)
	    (:item nil "儕僼傽儗儞僗僞僀僩儖専嶕(&T)"         'imm-titles)
	    (:item nil "僙儗僋僔儑儞偺暥帤楍傪嶲徠(&1)"       'imm-refer-selection)
	    (:item nil "婛懚偺儕僼傽儗儞僗僶僢僼傽傪昞帵(&P)" 'imm-switch-to-buffer)
	    :sep
	    (:item nil "僙儗僋僔儑儞偺暥帤楍偱Lisp僼僅儖僟傪Grep(&G)" 'imm-grep)
	    :sep
	    (:item nil "apropos(&A)"         'imm-apropos)
	    (:item nil "command-apropos(&C)" 'imm-command-apropos)
	    (:item nil "describe-key(&K)"    'imm-describe-key)
	    (:item nil "describe-describe-bindings(&B)" 'imm-describe-bindings)
	    )))
  (track-popup-menu *imm-menu*))

(global-set-key '(#\C-x #\F1) 'imm-menu)


;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;
;;;  仭 alias
;;; 劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅劅 ;;;

(setf (symbol-function 'imm1) #'imm-refer-selection)
(setf (symbol-function 'immr) #'imm-refer)
(setf (symbol-function 'immf) #'imm-full-search)
(setf (symbol-function 'imms) #'imm-query-section)
(setf (symbol-function 'immt) #'imm-titles)
(setf (symbol-function 'immi) #'imm-show-index)
(setf (symbol-function 'immp) #'imm-switch-to-buffer)
(setf (symbol-function 'immg) #'imm-grep)


;;; info-modoki-mode.l ends here.
