X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lsdb.el;h=330648b6fd5fcec4c7a499b682d92c74ccec8909;hb=cbeca0b29257118bce4e8cea52811a5a6314905f;hp=10aeb7377d82990a5d259295b6b69c4ff00b5738;hpb=d018d4737dbc5eedf43db9a1b9ac2ba7750d0501;p=elisp%2Flsdb.git

diff --git a/lsdb.el b/lsdb.el
index 10aeb73..330648b 100644
--- a/lsdb.el
+++ b/lsdb.el
@@ -43,7 +43,7 @@
 ;;;             (define-key wl-draft-mode-map "\M-\t" 'lsdb-complete-name)))
 ;;; (add-hook 'wl-summary-mode-hook
 ;;;           (lambda ()
-;;;             (define-key wl-summary-mode-map ":" 'lsdb-toggle-buffer)))
+;;;             (define-key wl-summary-mode-map ":" 'lsdb-wl-toggle-buffer)))
 
 ;;; For Mew, put the following lines into your ~/.mew:
 ;;; (autoload 'lsdb-mew-insinuate "lsdb")
@@ -53,7 +53,7 @@
 ;;;             (define-key mew-draft-header-map "\M-I" 'lsdb-complete-name)))
 ;;; (add-hook 'mew-summary-mode-hook
 ;;;           (lambda ()
-;;;             (define-key mew-summary-mode-map ":" 'lsdb-toggle-buffer)))
+;;;             (define-key mew-summary-mode-map "l" 'lsdb-toggle-buffer)))
 
 ;;; Code:
 
@@ -73,7 +73,7 @@
   :group 'lsdb
   :type 'file)
 
-(defcustom lsdb-file-coding-system (find-coding-system 'iso-2022-jp)
+(defcustom lsdb-file-coding-system (find-coding-system 'ctext)
   "Coding system for `lsdb-file'."
   :group 'lsdb
   :type 'symbol)
@@ -167,6 +167,12 @@ The updated record is passed to each function as the argument."
   :group 'lsdb
   :type 'integer)
 
+(defcustom lsdb-x-face-image-type nil
+  "A image type of displayed x-face.
+If non-nil, supersedes the return value of `lsdb-x-face-available-image-type'."
+  :group 'lsdb
+  :type 'symbol)
+
 (defcustom lsdb-x-face-command-alist
   '((pbm "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | pnmscale 0.5")
     (xpm "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | pnmscale 0.5 | ppmtoxpm"))
@@ -349,11 +355,11 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
 
 (eval-and-compile
   (condition-case nil
-      (progn
-	;; In XEmacs, hash tables can also be created by the lisp reader
-	;; using structure syntax.
-	(read-from-string "#s(hash-table)")
-	(defalias 'lsdb-read 'read))
+      (and
+       ;; In XEmacs, hash tables can also be created by the lisp reader
+       ;; using structure syntax.
+       (read-from-string "#s(hash-table)")
+       (defalias 'lsdb-read 'read))
     (invalid-read-syntax
      (defun lsdb-read (&optional marker)
        "Read one Lisp expression as text from MARKER, return as Lisp object."
@@ -461,7 +467,11 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
 
 (defun lsdb-extract-address-components (string)
   (let ((components (std11-extract-address-components string)))
-    (if (nth 1 components)
+    (if (and (nth 1 components)
+	     ;; When parsing a group address,
+	     ;; std11-extract-address-components is likely to return
+	     ;; the ("GROUP" "") form.
+	     (not (equal (nth 1 components) "")))
 	(if (car components)
 	    (list (funcall lsdb-canonicalize-full-name-function
 			   (car components))
@@ -483,10 +493,10 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
       (set-buffer-multibyte multibyte))))
 
 ;;;_. Record Management
-(defun lsdb-maybe-load-secondary-hash-tables ()
+(defun lsdb-rebuild-secondary-hash-tables (&optional force)
   (let ((tables lsdb-secondary-hash-tables))
     (while tables
-      (unless (symbol-value (car tables))
+      (when (or force (not (symbol-value (car tables))))
 	(set (car tables) (lsdb-make-hash-table :test 'equal))
 	(lsdb-maphash
 	 (lambda (key value)
@@ -502,7 +512,7 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
     (if (file-exists-p lsdb-file)
 	(lsdb-load-hash-tables)
       (setq lsdb-hash-table (lsdb-make-hash-table :test 'equal)))
-    (lsdb-maybe-load-secondary-hash-tables)))
+    (lsdb-rebuild-secondary-hash-tables)))
 
 ;;;_ : Fallback Lookup Functions
 ;;;_  , #1 Address Cache
@@ -725,6 +735,7 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
 (defvar lsdb-last-completion nil)
 (defvar lsdb-last-candidates nil)
 (defvar lsdb-last-candidates-pointer nil)
+(defvar lsdb-complete-marker nil)
 
 ;;;_ : Matching Highlight
 (defvar lsdb-last-highlight-overlay nil)
@@ -743,9 +754,10 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
 		     'underline))))
 
 (defun lsdb-complete-name-highlight-update ()
-  (unless (eq 'this-command 'lsdb-complete-name)
+  (unless (eq this-command 'lsdb-complete-name)
     (if lsdb-last-highlight-overlay
 	(delete-overlay lsdb-last-highlight-overlay))
+    (set-marker lsdb-complete-marker nil)
     (remove-hook 'pre-command-hook
 		 'lsdb-complete-name-highlight-update t)))
 
@@ -754,11 +766,14 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
   "Complete the user full-name or net-address before point"
   (interactive)
   (lsdb-maybe-load-hash-tables)
+  (unless (markerp lsdb-complete-marker)
+    (setq lsdb-complete-marker (make-marker)))
   (let* ((start
-	  (save-excursion
-	    (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
-	    (goto-char (match-end 0))
-	    (point)))
+	  (or (and (eq (marker-buffer lsdb-complete-marker) (current-buffer))
+		   (marker-position lsdb-complete-marker))
+	      (save-excursion
+		(re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
+		(set-marker lsdb-complete-marker (match-end 0)))))
 	 pattern
 	 (case-fold-search t)
 	 (completion-ignore-case t))
@@ -879,6 +894,7 @@ Modify whole identification by side effect."
     (define-key keymap "a" 'lsdb-mode-add-entry)
     (define-key keymap "d" 'lsdb-mode-delete-entry)
     (define-key keymap "e" 'lsdb-mode-edit-entry)
+    (define-key keymap "l" 'lsdb-mode-load)
     (define-key keymap "s" 'lsdb-mode-save)
     (define-key keymap "q" 'lsdb-mode-quit-window)
     (define-key keymap "g" 'lsdb-mode-lookup)
@@ -928,7 +944,7 @@ Modify whole identification by side effect."
   (let ((end (next-single-property-change (point) 'lsdb-record nil
 					  (point-max))))
     (narrow-to-region
-     (previous-single-property-change (point) 'lsdb-record nil (point-min))
+     (previous-single-property-change end 'lsdb-record nil (point-min))
      end)
     (goto-char (point-min))))
 
@@ -1060,11 +1076,20 @@ the current record."
       (message "(No changes need to be saved)")
     (when (or (interactive-p)
 	      dont-ask
-	      (y-or-n-p "Save the LSDB now?"))
+	      (y-or-n-p "Save the LSDB now? "))
       (lsdb-save-hash-tables)
       (setq lsdb-hash-tables-are-dirty nil)
       (message "The LSDB was saved successfully."))))
 
+(defun lsdb-mode-load ()
+  "Load LSDB hash table from `lsdb-file'."
+  (interactive)
+  (let (lsdb-secondary-hash-tables)
+    (lsdb-load-hash-tables))
+  (message "Rebuilding secondary hash tables...")
+  (lsdb-rebuild-secondary-hash-tables t)
+  (message "Rebuilding secondary hash tables...done"))
+
 (defun lsdb-mode-quit-window (&optional kill window)
   "Quit the current buffer.
 It partially emulates the GNU Emacs' of `quit-window'."
@@ -1078,7 +1103,7 @@ It partially emulates the GNU Emacs' of `quit-window'."
       (delete-window window))
     (if kill
 	(kill-buffer buffer)
-      (bury-buffer buffer))))
+      (bury-buffer (unless (eq buffer (current-buffer)) buffer)))))
 
 (defun lsdb-hide-buffer ()
   "Hide the LSDB window."
@@ -1290,7 +1315,7 @@ of the buffer."
   (add-hook 'wl-summary-toggle-disp-folder-on-hook 'lsdb-hide-buffer)
   (add-hook 'wl-summary-toggle-disp-folder-off-hook 'lsdb-hide-buffer)
   (add-hook 'wl-summary-toggle-disp-folder-message-resumed-hook
-	    'lsdb-show-buffer)
+	    'lsdb-wl-show-buffer)
   (add-hook 'wl-exit-hook 'lsdb-mode-save)
   (add-hook 'wl-save-hook 'lsdb-mode-save))
 
@@ -1305,6 +1330,24 @@ of the buffer."
 	       #'lsdb-wl-temp-buffer-show-function))
 	  (lsdb-display-record (car records)))))))
 
+(defun lsdb-wl-toggle-buffer (&optional arg)
+  "Toggle hiding of the LSDB window for Wanderlust.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+  (interactive
+   (list (if current-prefix-arg
+	     (prefix-numeric-value current-prefix-arg)
+	   0)))
+  (let ((lsdb-temp-buffer-show-function
+	 #'lsdb-wl-temp-buffer-show-function))
+    (lsdb-toggle-buffer arg)))
+
+(defun lsdb-wl-show-buffer ()
+  (when lsdb-pop-up-windows
+    (let ((lsdb-temp-buffer-show-function
+	   #'lsdb-wl-temp-buffer-show-function))
+      (lsdb-show-buffer))))
+
 (defvar wl-current-summary-buffer)
 (defvar wl-message-buffer)
 (defun lsdb-wl-temp-buffer-show-function (buffer)
@@ -1322,13 +1365,15 @@ of the buffer."
 	(set-window-buffer window buffer)
 	(lsdb-fit-window-to-buffer window)))))
 
-;;;_. Interface to Mew written by Hideyuki SHIRAI <shirai@rdmg.mgcs.mei.co.jp>
+;;;_. Interface to Mew written by Hideyuki SHIRAI <shirai@meadowy.org>
 (eval-when-compile
   (autoload 'mew-sinfo-get-disp-msg "mew")
   (autoload 'mew-current-get-fld "mew")
   (autoload 'mew-current-get-msg "mew")
   (autoload 'mew-frame-id "mew")
-  (autoload 'mew-cache-hit "mew"))
+  (autoload 'mew-cache-hit "mew")
+  (autoload 'mew-xinfo-get-decode-err "mew")
+  (autoload 'mew-xinfo-get-action "mew"))
 
 ;;;###autoload
 (defun lsdb-mew-insinuate ()
@@ -1340,22 +1385,33 @@ of the buffer."
 		(lsdb-hide-buffer))))
   (add-hook 'mew-suspend-hook 'lsdb-hide-buffer)
   (add-hook 'mew-quit-hook 'lsdb-mode-save)
-  (add-hook 'kill-emacs-hook 'lsdb-mode-save))
+  (add-hook 'kill-emacs-hook 'lsdb-mode-save)
+  (cond
+   ;; Mew 3
+   ((fboundp 'mew-summary-visit-folder)
+    (defadvice mew-summary-visit-folder (before lsdb-hide-buffer activate)
+      (lsdb-hide-buffer)))
+   ;; Mew 2
+   ((fboundp 'mew-summary-switch-to-folder)
+    (defadvice mew-summary-switch-to-folder (before lsdb-hide-buffer activate)
+      (lsdb-hide-buffer)))))
 
 (defun lsdb-mew-update-record ()
   (let* ((fld (mew-current-get-fld (mew-frame-id)))
 	 (msg (mew-current-get-msg (mew-frame-id)))
-	 (cache (mew-cache-hit fld msg 'must-hit))
+	 (cache (mew-cache-hit fld msg))
 	 records)
-    (save-excursion
-      (set-buffer cache)
-      (make-local-variable 'lsdb-decode-field-body-function)
-      (setq lsdb-decode-field-body-function
-	    (lambda (body name)
-	      (set-text-properties 0 (length body) nil body)
-	      body))
-      (when (setq records (lsdb-update-records))
-	(lsdb-display-record (car records))))))
+    (when cache
+      (save-excursion
+	(set-buffer cache)
+	(unless (or (mew-xinfo-get-decode-err) (mew-xinfo-get-action))
+	  (make-local-variable 'lsdb-decode-field-body-function)
+	  (setq lsdb-decode-field-body-function
+		(lambda (body name)
+		  (set-text-properties 0 (length body) nil body)
+		  body))
+	  (when (setq records (lsdb-update-records))
+	    (lsdb-display-record (car records))))))))
 
 ;;;_. Interface to MU-CITE
 (eval-when-compile
@@ -1506,7 +1562,8 @@ the user wants it."
 			   'lsdb-record record)))))
 
 (defun lsdb-insert-x-face-asynchronously (x-face)
-  (let* ((type (lsdb-x-face-available-image-type))
+  (let* ((type (or lsdb-x-face-image-type
+		   (lsdb-x-face-available-image-type)))
 	 (shell-file-name lsdb-shell-file-name)
 	 (shell-command-switch lsdb-shell-command-switch)
 	 (process-connection-type nil)
@@ -1542,7 +1599,7 @@ the user wants it."
 (provide 'lsdb)
 
 (product-provide 'lsdb
-  (product-define "LSDB" nil '(0 4)))
+  (product-define "LSDB" nil '(0 7)))
 
 ;;;_* Local emacs vars.
 ;;; The following `outline-layout' local variable setting: