namazu-dev(ring)
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
new patch for namazu.el (Re: namazu.el patch for GNU Emacs 19.28)
>>>>> <200001260333.MAA22299@xxxxxxxxxxxxxx> にて、
>>>>> "白井" = <shirai@xxxxxxxxxxxxxxxxxxx> さんは書きました:
白井> 三好さんのパッチ(と mouse-face) + 若干のバグ修正をしておきました。
mouse-face の設定に若干問題があります。ついでに、ほかの手直しも考
えました。
問題ないようでしたら、commit して頂ければと思います。
;; .emacs 以外の lisp のコードを書くのは、ほとんど初めてです。変なこと
;; をしていたら、指摘してください。
変更点は次のとおりです。
・font-lock の再変更：mouse-face の設定方法は、Emacs 19.28 付属の
font-lock では無効です。font-lock のバージョンに応じて、
namazu-font-lock-keywords の設定方法を変更するようにしました。あわせ
て、font-lock 時に実行される検索回数が少なくなる(と思われる)ように設
定を変更しました。
・namazu-field-complete のエラーの回避：namazu-default-dir が nil の場
合に発生するエラーを回避するようにしました。また、なにも入力しないで、
namazu-field-complete を起動したときに発生するエラーも回避するように
しました。
・namazu-default-dir のデフォルト値の設定：namazu.el 起動時に、
namazu-default-dir が nil の場合は、Namazu の設定ファイル(.namazurc
等)を読んで、デフォルト値を決定するようにしました。現状では、Namazu
とnamazu-field-complete で、namazu-default-dir が nil の場合の解釈が
異なるのが気になったので、このように変更しました。
Mule for Windows(19.28)
GNU Emacs 19.34
Meadow 1.10(20.4)
XEmacs 20.4
で一応、確認しました。
*** ChangeLog.orig Wed Jan 26 18:37:20 2000
--- ChangeLog Wed Jan 26 21:52:16 2000
***************
*** 1,3 ****
--- 1,15 ----
+ 2000-01-26 MIYOSHI Masanori <miyoshi@xxxxxxxxx>
+
+ * namazu.el (namazu-font-lock-keywords): Support font-lock for Emacs 19.28.
+ (namazu-config-file-path): New variable for configuration file.
+ (namazu-make-field-completion-alist): Avoid error when namazu-default-dir is nil.
+ (namazu-field-complete): Avoid completion error at beginning of buffer.
+ (match-string): Supplemental definition of match-string.
+ (namazu-search-config-file): New function. Search Namazu configuration file.
+ (namazu-read-config-file): New function. Read Namazu configuration file.
+ (namazu-get-default-index-dir): New function. Get default value for namazu-default-dir.
+ (namazu-default-dir): Get default value from configuration file.
+
2000-01-25 Hideyuki SHIRAI <shirai@xxxxxxxxxxxxxxxxxxx>
* namazu.el (namazu-version): namazu.el 1.0.3
*** namazu.el.orig Wed Jan 26 18:37:20 2000
--- namazu.el Wed Jan 26 22:53:06 2000
***************
*** 157,162 ****
--- 157,171 ----
(if (> emacs-major-version 19) 'euc-jp '*euc-japan*))
"*OS の内部コードと異なり、かつ動かない場合に変更してみてください。")
+ (defvar namazu-config-file-path
+ (list (getenv "NAMAZUCONFPATH")
+ (getenv "NAMAZUCONF") ; obsolete?
+ "./.namazurc"
+ "~/.namazurc"
+ "/usr/local/etc/namazu/namazurc"
+ "/usr/local/namazu/lib/namazurc") ;obsolete?
+ "*Search path for a Namazu configuration file.")
+
;;
;; ここから先をいじって、素敵になったら教えてくださいね。
;;
***************
*** 434,444 ****
(completion-buffer "*Competions*")
word start result)
(save-excursion
! (skip-chars-backward "^\n+")
! (backward-char 1)
! (setq start (point))
! (setq word (buffer-substring start p)))
! (setq result (try-completion word alist))
(cond
((eq result t)
(ding))
--- 443,453 ----
(completion-buffer "*Competions*")
word start result)
(save-excursion
! (if (re-search-backward "\\+[^ \t]*" nil t)
! (progn
! (setq start (match-beginning 0))
! (setq word (match-string 0))
! (setq result (try-completion word alist)))))
(cond
((eq result t)
(ding))
***************
*** 457,468 ****
(defun namazu-make-field-completion-alist (namazu-dir)
"make \'+files:\' completion alist."
! (let* ((dir (expand-file-name
! (if (null namazu-dir)
namazu-default-dir
(or (cdr (assoc namazu-dir namazu-dir-alist))
! namazu-dir))))
! (fl (and (file-exists-p dir)
(directory-files dir)))
fields file)
(while (setq file (car fl))
--- 466,478 ----
(defun namazu-make-field-completion-alist (namazu-dir)
"make \'+files:\' completion alist."
! (let* ((dir (if (null namazu-dir)
namazu-default-dir
(or (cdr (assoc namazu-dir namazu-dir-alist))
! namazu-dir)))
! (fl (and dir
! (setq dir (expand-file-name dir))
! (file-exists-p dir)
(directory-files dir)))
fields file)
(while (setq file (car fl))
***************
*** 472,477 ****
--- 482,555 ----
(setq fl (cdr fl)))
fields))
+ (defun namazu-search-config-file ()
+ "Search namazu-config-file-path for a Namazu configuration file.
+ Return the abosolute file name of the configuration. When the file is
+ not found, return nil "
+ (let ((config-file-list namazu-config-file-path) config-file)
+ (setq config-file-list (delq nil config-file-list))
+ (if (catch 'found
+ (while config-file-list
+ (setq config-file (expand-file-name (car config-file-list)))
+ (and (file-exists-p config-file)
+ (throw 'found t))
+ (setq config-file-list (cdr config-file-list))))
+ config-file
+ nil)))
+
+ (defun namazu-read-config-file (file)
+ "Read a namazu configuration file and return an alist of directive
+ and value(s) pairs.
+ FILE indicates the absolute file name of the configuration file. FILE
+ must exists."
+ (let* (conf-alist
+ (buffer (get-file-buffer file))
+ (buffer-already-there-p buffer))
+ (or buffer-already-there-p
+ (setq buffer (find-file-noselect file)))
+ (unwind-protect
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min))
+ (let (directive value1 value2)
+ (while (re-search-forward "\\(^[ \t]*\\(INDEX\\|BASE\\|\
+ LOGGING\\|LANG\\|SCORING\\)[ \t]+\\([^ \t\n#]+\\)\\)\\|\
+ \\(^[ \t]*\\(REPLACE\\)[ \t]+\\([^ \t\n#]+\\)[ \t]+\\([^ \t\n#]+\\)\\)" nil t)
+ (cond ((match-string 1) ; only 1 value
+ (setq directive (match-string 2))
+ (setq value1 (match-string 3))
+ (setq conf-alist
+ (delete (assoc directive conf-alist) conf-alist))
+ (setq conf-alist
+ (cons (cons directive value1) conf-alist)))
+ ((match-string 4) ; 2 values
+ (setq directive (match-string 5))+ (setq value1 (match-string 6))
+ (setq value2 (match-string 7))
+ (setq conf-alist
+ (delete (assoc directive conf-alist) conf-alist))
+ (setq conf-alist
+ (cons (list directive value1 value2)
+ conf-alist)))))))
+ (if (not buffer-already-there-p)
+ (kill-buffer buffer)))
+ conf-alist))
+
+ (defun namazu-get-default-index-dir ()
+ "Get a Namazu default index directory from a Namazu configuration file.
+ Return \"/usr/local/namazu/index\" if the configuration file is not
+ found."
+ (let (config-file conf-alist cell dir)
+ (setq config-file (namazu-search-config-file))
+ (if config-file
+ (progn
+ (setq conf-alist (namazu-read-config-file config-file))
+ (setq cell (assoc "INDEX" conf-alist))
+ (and cell
+ (setq dir (cdr cell)))
+ dir)
+ "/usr/local/namazu/index")))
+
(defun namazu-mode ()
"Namazu の検索結果を閲覧するためのモードです。
***************
*** 577,582 ****
--- 655,668 ----
(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 ()
"ポイントが位置する項目をブラウズします。"
(interactive)
***************
*** 690,721 ****
(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))
! (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 '(progn (set-text-properties (match-beginning 1) (match-end 1)
! '(mouse-face highlight))
! '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 での検索結果にお化粧をするための設定です. ")
! (if (boundp 'font-lock-defaults)
(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)))
! (add-hook 'namazu-display-hook
! (lambda ()
! (setq font-lock-keywords namazu-font-lock-keywords)
! (font-lock-mode 1)))))
((featurep 'hilit19)
(hilit-set-mode-patterns
'namazu-mode
--- 776,823 ----
(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))
! "Namazu での検索結果にお化粧をするための設定です. ")
(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 での検索結果にお化粧をするための設定です. ")
! (add-hook 'namazu-display-hook
! (lambda ()
! (setq font-lock-keywords namazu-font-lock-keywords)
! (font-lock-mode 1)))))
((featurep 'hilit19)
(hilit-set-mode-patterns
'namazu-mode
***************
*** 728,732 ****
--- 830,837 ----
(list namazu-output-url-pattern 3 'grey40)))
(add-hook 'namazu-display-hook
'hilit-rehighlight-buffer-quietly)))
+
+ (or namazu-default-dir
+ (setq namazu-default-dir (namazu-get-default-index-dir)))
;; end here.
--
三好 雅則 mailto:miyoshi@xxxxxxxxx
http://www.ask.ne.jp/~miyoshi/ (Meadow のページ作成中)