namazu.el

namazu. 虽然是日语的,也适用于文件中单词索引后全文检索.

	  (namazu-prev-page)
	  (end-of-buffer)
	  (namazu-jump-prev)))))

(defun namazu-view-at-mouse (event)
  "mouse $B$r;H$C$F%V%i%&%:$7$?$j%Z!<%8$r0\F0$7$?$j$7$^$9!#(B"
  (interactive "e")
  (set-buffer (event-buffer event))
  (goto-char (event-point event))
  (let ((pos (point))
	pos-title pos-url)
    (end-of-line)
    (and (re-search-backward namazu-output-title-pattern nil t)
	 (setq pos-title (point))
	 (goto-char pos)
	 (re-search-forward namazu-output-title-pattern nil t)
	 (re-search-backward namazu-output-url-pattern nil t)
	 (> (point) pos-title)
	 (setq pos-url (point))
	 (setq pos (point)))
    (goto-char pos)
    (beginning-of-line)
    (and (not pos-url)
	 (re-search-forward namazu-output-url-pattern nil t)
	 (setq pos-url (point)))
    (goto-char pos)
    (cond
     ((and pos-title pos-url)
      (namazu-view))
     ((and pos-url (> namazu-current-page 0))
      (namazu-prev-page))
     ((and pos-title (< namazu-current-page namazu-max-page))
      (namazu-next-page))
     (t (message "nothing to do.")))))

;; emacs $B8~$1$NDj5A(B
(eval-and-compile
  (or (fboundp 'event-buffer)
      (defun event-buffer (event)
	(window-buffer (posn-window (event-start event))))))

(eval-and-compile
  (or (fboundp 'event-point)
      (defun event-point (event)
	(posn-point (event-start event)))))

(eval-and-compile
  (or (fboundp 'match-string)
      (defun match-string (num &optional string)
	(if (match-beginning num)
	    (if string
		(substring string (match-beginning num) (match-end num))
	      (buffer-substring (match-beginning num) (match-end num)))))))

(defun namazu-view ()
  "$B%]%$%s%H$,0LCV$9$k9`L\$r%V%i%&%:$7$^$9!#(B"
  (interactive)
  (beginning-of-line)
  (if (re-search-forward namazu-output-url-pattern nil t)
      (let ((url (buffer-substring (match-beginning 1) (match-end 1))))
        (beginning-of-line)
        (sit-for 0)
        (and (string-match "^/\\([a-zA-Z]\\)|\\(/.*\\)$" url)
	     ;; if DOS/Windows /c|...
	     (setq url
		   (concat (substring url (match-beginning 1) (match-end 1))
			   ":"
			   (substring url (match-beginning 2) (match-end 2)))))
	(if (string-match namazu-url-regex url)
	    (namazu-browse-url url)
	  (let ((ext '("" ".gz" ".Z" "bz2"))
		(fl namazu-view-function-alist)
		(file (expand-file-name url)) (name "") path done)
	    (and (string-match "\\(.*\\)\\(#.*\\)$" url)
		 (setq file (substring url (match-beginning 1) (match-end 1)))
		 (setq name (substring url (match-beginning 2) (match-end 2))))
	    (while (and (null done) ext)
	      (setq path (concat file (car ext)))
	      (and (file-exists-p path)
		   (setq done t)
		   (while fl
		     (if (string-match (car (car fl)) path)
			 (progn
			   (funcall (cdr (car fl)) (concat path name))
			   (setq fl nil)))
                     (setq fl (cdr fl))))
	      (setq ext (cdr ext))))))))

(defun namazu-view-file (&optional file)
  "View file function."
  (interactive "fView message: ")
  (if (and window-system namazu-view-other-frame)
      (view-file-other-frame file)
    (if namazu-view-other-window
	(view-file-other-window file)
      (view-file file)))
  ;; xxx
  (if (and (boundp 'view-mode-map) view-mode-map)
      (define-key view-mode-map "," 'namazu-view-top))
  (if (and (boundp 'view-minor-mode-map) view-minor-mode-map)
      (define-key view-minor-mode-map "," 'namazu-view-top))
  (make-local-variable 'namazu-view-vismark))

(defun namazu-view-msg (&optional file)
  "View message function."
  (namazu-view-file file)
  (let ((buffer-read-only nil)
	(vis-head "")
	hspos)
    (goto-char (point-min))
    (if (not (re-search-forward "^$" nil t))
	()
      (save-excursion
	(save-restriction
	  (narrow-to-region (point-min) (point))
	  (mapcar (function
		   (lambda (head)
		     (goto-char (point-min))
		     (if (not (re-search-forward (concat "^" head ":") nil t))
			 ()
		       (beginning-of-line)
		       (setq hspos (point))
		       (forward-line 1)
		       (while (looking-at "^[ \t]+")
			 (forward-line 1))
		       (setq vis-head
			     (concat vis-head (buffer-substring hspos (point))))
		       (delete-region hspos (point)))))
		  namazu-msg-visible-field)
	  (goto-char (point-max))
	  (setq namazu-view-vismark (point-marker))
	  (insert vis-head)
	  (condition-case err
	      (cond
	       ((fboundp 'mew-header-decode-region)
		(mew-header-decode-region 'text (point-min) (point-max) t))
	       ((fboundp 'eword-decode-region)
		(eword-decode-region (point-min) (point-max) t)))
	    (error nil))
	  (widen)))
      (goto-char namazu-view-vismark)
      (recenter 0)
      (if namazu-msg-highlight-function
	  (funcall namazu-msg-highlight-function))
      (set-visited-file-name nil)
      (set-buffer-modified-p nil))))

(defun namazu-view-top ()
  "goto namazu view top point."
  (interactive)
  (if (and (boundp 'namazu-view-vismark)
	   (markerp namazu-view-vismark))
      (goto-char namazu-view-vismark)
    (goto-char (point-min)))
  (recenter 0))

(defun namazu-browse-url (url)
  "browse-url $B$r;H$C$FI=<($7$^$9!#(B
$B;HMQ$9$k(B browser $B$O(B browse-url-browser-function $B$G;XDj$7$^$9!#(B"
  (interactive)
  (setq url (browse-url-file-url url))
  (if (fboundp 'browse-url)
      (browse-url url)
    (funcall browse-url-browser-function url)))

(defun namazu-man (file)
  "manual $B$rI=<($7$^$9!#(B"
  (interactive)
  (require 'man)
  (let ((manual-program "nroff -man -h"))
    (Man-getpage-in-background file)))

(defun namazu-exit ()
  "namazu $B$r=*N;$7$^$9!#(B"
  (interactive)
  (if (and (get-buffer namazu-buffer)
	   (buffer-name (get-buffer namazu-buffer)))
      (kill-buffer namazu-buffer)))

(if namazu-mode-map
    nil
  (setq namazu-mode-map (make-keymap))
  (suppress-keymap namazu-mode-map)
  (define-key namazu-mode-map "P"     'namazu-prev-page)
  (define-key namazu-mode-map "p"     'namazu-jump-prev)
  (define-key namazu-mode-map "n"     'namazu-jump-next)
  (define-key namazu-mode-map "N"     'namazu-next-page)

  (define-key namazu-mode-map "\177"  'namazu-jump-prev)
  (define-key namazu-mode-map " "     'namazu-jump-next)

  (define-key namazu-mode-map "\M-\t" 'namazu-jump-prev)
  (define-key namazu-mode-map "\t"    'namazu-jump-next)

  (define-key namazu-mode-map "h"     'namazu-prev-page)
  (define-key namazu-mode-map "k"     'namazu-jump-prev)
  (define-key namazu-mode-map "j"     'namazu-jump-next)
  (define-key namazu-mode-map "l"     'namazu-next-page)

  (define-key namazu-mode-map [left]  'namazu-prev-page)
  (define-key namazu-mode-map [up]    'namazu-jump-prev)
  (define-key namazu-mode-map [down]  'namazu-jump-next)
  (define-key namazu-mode-map [right] 'namazu-next-page)

  (define-key namazu-mode-map "<"     'beginning-of-buffer)
  (define-key namazu-mode-map ">"     'end-of-buffer)
  (define-key namazu-mode-map "\r"    'namazu-view)
  (define-key namazu-mode-map "g"     'namazu-view)
  (define-key namazu-mode-map "r"     'namazu-re-search)
  (define-key namazu-mode-map "q"     'bury-buffer)
  (define-key namazu-mode-map "Q"     'namazu-exit)
  (define-key namazu-mode-map "?"     'describe-mode)

  (if (string-match "XEmacs" emacs-version)
      (define-key namazu-mode-map [(button2)] 'namazu-view-at-mouse)
    (define-key namazu-mode-map [mouse-2] 'namazu-view-at-mouse)))

(if namazu-minibuffer-map
    nil
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map "\t" 'namazu-dir-complete)
    (setq namazu-minibuffer-map map)))

(if namazu-minibuffer-field-map
    nil
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map "\t" 'namazu-field-complete)
    (setq namazu-minibuffer-field-map map)))

(cond
 ((featurep 'font-lock)
  (or (boundp 'font-lock-variable-name-face)
      (setq font-lock-variable-name-face font-lock-type-face))
  (or (boundp 'font-lock-reference-face)
      (setq font-lock-reference-face font-lock-function-name-face))
  (if (boundp 'font-lock-defaults)
      (progn
	(defvar namazu-font-lock-keywords
	  (list
	   (list namazu-output-title-pattern
		 '(1 font-lock-comment-face)
		 '(2 font-lock-keyword-face)
		 '(3 font-lock-reference-face))
	   (list namazu-output-header-pattern
		 1 'font-lock-variable-name-face)
	   (list namazu-output-url-pattern
		 '(1 (progn
		       (set-text-properties (match-beginning 1) (match-end 1)
					    '(mouse-face highlight))
		       font-lock-function-name-face))
		 '(3 font-lock-type-face))
	   (list namazu-output-current-list-pattern
		 0 'font-lock-comment-face)
	   (list namazu-output-pages-pattern 0 'font-lock-comment-face)))
	(add-hook
	 'namazu-display-hook
	 (lambda ()
	   (make-local-variable 'font-lock-defaults)
	   (setq font-lock-defaults
		 '((namazu-font-lock-keywords) t))
	   (font-lock-mode 1))))
    (defvar namazu-font-lock-keywords
      (list
       (list namazu-output-title-pattern 1 'font-lock-comment-face)
       (list namazu-output-title-pattern 2 'font-lock-keyword-face)
       (list namazu-output-title-pattern 3 'font-lock-reference-face)
       (list namazu-output-header-pattern 1 'font-lock-variable-name-face)
       (list namazu-output-url-pattern 1 'font-lock-function-name-face)
       (list namazu-output-url-pattern 3 'font-lock-type-face)
       (list namazu-output-current-list-pattern  0 'font-lock-comment-face)
       (list namazu-output-pages-pattern 0 'font-lock-comment-face))
      "Namazu $B$G$N8!:w7k2L$K$*2=>Q$r$9$k$?$a$N@_Dj$G$9(B. ")
    (add-hook 'namazu-display-hook
	      (lambda ()
		(setq font-lock-keywords namazu-font-lock-keywords)
		(font-lock-mode 1)))))
 ((featurep 'hilit19)
  (if (and (boundp 'hilit-background-mode)
	   (eq hilit-background-mode 'dark))
      (hilit-set-mode-patterns
       'namazu-mode
       (list
	(list namazu-output-title-pattern  1 'red-bold-underline)
	(list namazu-output-title-pattern  2 'yellow-bold)
	(list namazu-output-title-pattern  3 'grey80)
	(list namazu-output-header-pattern 1 'palegreen)
	(list namazu-output-url-pattern    1 'gold-underline)
	(list namazu-output-url-pattern    3 'grey80)))
    (hilit-set-mode-patterns
     'namazu-mode
     (list
      (list namazu-output-title-pattern  1 'red-bold-underline)
      (list namazu-output-title-pattern  2 'purple)
      (list namazu-output-title-pattern  3 'grey40)
      (list namazu-output-header-pattern 1 'DarkGoldenrod)
      (list namazu-output-url-pattern    1 'blue-bold-underline)
      (list namazu-output-url-pattern    3 'grey40))))
  (add-hook 'namazu-display-hook
	    'hilit-rehighlight-buffer-quietly)))

;; Message highlight functions. 
;; e.g. 
;; (setq namazu-msg-highlight-function 'namazu-msg-highlight-mew)

;;
;; for Mew freak.
(defun namazu-msg-highlight-mew ()
  "namazu message highlight use Mew functions (1.94 or later)."
  (save-excursion
    (condition-case err
	(progn
	  (if (not (and (boundp 'mew-version)
			mew-version))
	      (save-excursion
		(require 'mew)
		(mew-init)
		(if (get-buffer mew-buffer-hello)
		    (kill-buffer mew-buffer-hello))))
	  (goto-char (point-min))
	  (if (and (fboundp 'mew-highlight-header-region)
		   (re-search-forward "^$" nil t))
	      (progn
		(mew-highlight-header-region (point-min) (point))
		(put-text-property (point) (1+ (point)) 'read-only t))) ;; header-end
	  (cond
	   ((fboundp 'mew-cite-color)
	    (mew-cite-color))
	   ((fboundp 'mew-highlight-body)
	    (mew-highlight-body)))
	  (and (fboundp 'mew-highlight-url)
	       (mew-highlight-url)))
      (error nil))))

;; end here.