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

diff --git a/lsdb.el b/lsdb.el
index 106b56c..330648b 100644
--- a/lsdb.el
+++ b/lsdb.el
@@ -31,6 +31,9 @@
 ;;; (add-hook 'message-setup-hook
 ;;;           (lambda ()
 ;;;             (define-key message-mode-map "\M-\t" 'lsdb-complete-name)))
+;;; (add-hook 'gnus-summary-mode-hook
+;;;           (lambda ()
+;;;             (define-key gnus-summary-mode-map ":" 'lsdb-toggle-buffer)))
 
 ;;; For Wanderlust, put the following lines into your ~/.wl:
 ;;; (require 'lsdb)
@@ -38,6 +41,9 @@
 ;;; (add-hook 'wl-draft-mode-hook
 ;;;           (lambda ()
 ;;;             (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-wl-toggle-buffer)))
 
 ;;; For Mew, put the following lines into your ~/.mew:
 ;;; (autoload 'lsdb-mew-insinuate "lsdb")
@@ -45,6 +51,9 @@
 ;;; (add-hook 'mew-draft-mode-hook
 ;;;           (lambda ()
 ;;;             (define-key mew-draft-header-map "\M-I" 'lsdb-complete-name)))
+;;; (add-hook 'mew-summary-mode-hook
+;;;           (lambda ()
+;;;             (define-key mew-summary-mode-map "l" 'lsdb-toggle-buffer)))
 
 ;;; Code:
 
@@ -64,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)
@@ -105,7 +114,8 @@ where the last three elements are optional."
     (mailing-list 4 ?,)
     (attribution 4 ?.)
     (organization 4)
-    (www 1)
+    (www 4)
+    (aka 4 ?,)
     (score -1)
     (x-face -1))
   "Alist of entry types for presentation.
@@ -132,11 +142,37 @@ entry cannot be modified."
   :group 'lsdb
   :type 'function)
 
+(defcustom lsdb-lookup-full-name-functions
+  '(lsdb-lookup-full-name-from-address-cache)
+  "List of functions to pick up the existing full-name of the sender.
+The sender is passed to each function as the argument."
+  :group 'lsdb
+  :type 'hook)
+
+(defcustom lsdb-update-record-functions
+  '(lsdb-update-address-cache)
+  "List of functions called after a record is updated.
+The updated record is passed to each function as the argument."
+  :group 'lsdb
+  :type 'hook)
+
+(defcustom lsdb-secondary-hash-tables
+  '(lsdb-address-cache)
+  "List of the hash tables for reverse lookup"
+  :group 'lsdb
+  :type 'list)
+
 (defcustom lsdb-window-max-height 7
   "Maximum number of lines used to display LSDB record."
   :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"))
@@ -167,7 +203,12 @@ The compressed face will be piped to this command."
   "A predicate to sort records."
   :group 'lsdb
   :type 'function)
-  
+
+(defcustom lsdb-pop-up-windows t
+  "Non-nil means LSDB should make new windows to display records."
+  :group 'lsdb
+  :type 'boolean)
+
 (defgroup lsdb-edit-form nil
   "A mode for editing forms."
   :group 'lsdb)
@@ -227,16 +268,26 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
 (defvar lsdb-hash-table nil
   "Internal hash table to hold LSDB records.")
 
+(defvar lsdb-address-cache nil
+  "The reverse lookup table for `lsdb-hash-table'.
+It represents address to full-name mapping.")
+
 (defvar lsdb-buffer-name "*LSDB*"
   "Buffer name to display LSDB record.")
 
-(defvar lsdb-hash-table-is-dirty nil
-  "Flag to indicate whether the hash table needs to be saved.")
+(defvar lsdb-hash-tables-are-dirty nil
+  "Flag to indicate whether the internal hash tables need to be saved.")
 
 (defvar lsdb-known-entry-names
   (make-vector 29 0)
   "An obarray used to complete an entry name.")
 
+(defvar lsdb-temp-buffer-show-function
+  #'lsdb-temp-buffer-show-function
+  "Non-nil means call as function to display a help buffer.
+The function is called with one argument, the buffer to be displayed.
+Overrides `temp-buffer-show-function'.")
+
 ;;;_. Hash Table Emulation
 (if (and (fboundp 'make-hash-table)
 	 (subrp (symbol-function 'make-hash-table)))
@@ -296,44 +347,84 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
     (list 0 (make-vector (or (plist-get args :size) 29) 0))))
 
 ;;;_. Hash Table Reader/Writer
+(defconst lsdb-secondary-hash-table-start-format
+  ";;; %S\n")
+
+(defsubst lsdb-secondary-hash-table-start (hash-table)
+  (format lsdb-secondary-hash-table-start-format hash-table))
+
 (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)")
-	(defun lsdb-load-file (file)
-	  "Read the contents of FILE into a hash table."
-	  (let ((buffer (find-file-noselect file)))
-	    (unwind-protect
-		(save-excursion
-		  (set-buffer buffer)
-		  (re-search-forward "^#s")
-		  (beginning-of-line)
-		  (read (point-min-marker)))
-	      (kill-buffer buffer)))))
+      (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-load-file (file)
-      "Read the contents of FILE into a hash table."
-      (let* ((plist
-	      (with-temp-buffer
-		(insert-file-contents file)
-		(save-excursion
-		  (re-search-forward "^#s")
-		  (replace-match "")
-		  (beginning-of-line)
-		  (cdr (read (point-marker))))))
-	     (size (plist-get plist 'size))
-	     (data (plist-get plist 'data))
-	     (hash-table (lsdb-make-hash-table :size size :test 'equal)))
-	(while data
-	  (lsdb-puthash (pop data) (pop data) hash-table))
-	hash-table)))))
-
-(defun lsdb-save-file (file hash-table)
-  "Write the entries within HASH-TABLE into FILE."
-  (let ((coding-system-for-write lsdb-file-coding-system))
-    (with-temp-file file
+     (defun lsdb-read (&optional marker)
+       "Read one Lisp expression as text from MARKER, return as Lisp object."
+       (save-excursion
+	 (goto-char marker)
+	 (if (looking-at "^#s(")
+	     (with-temp-buffer
+	       (buffer-disable-undo)
+	       (insert-buffer-substring (marker-buffer marker) marker)
+	       (goto-char (point-min))
+	       (delete-char 2)
+	       (let ((object (read (current-buffer)))
+		     hash-table data)
+		 (if (eq 'hash-table (car object))
+		     (progn
+		       (setq hash-table
+			     (lsdb-make-hash-table
+			      :size (plist-get (cdr object) 'size)
+			      :test 'equal)
+			     data (plist-get (cdr object) 'data))
+		       (while data
+			 (lsdb-puthash (pop data) (pop data) hash-table))
+		       hash-table)
+		   object)))))))))
+
+(defun lsdb-load-hash-tables ()
+  "Read the contents of `lsdb-file' into the internal hash tables."
+  (let ((buffer (find-file-noselect lsdb-file))
+	tables)
+    (unwind-protect
+	(save-excursion
+	  (set-buffer buffer)
+	  (goto-char (point-min))
+	  (re-search-forward "^#s(")
+	  (goto-char (match-beginning 0))
+	  (setq lsdb-hash-table (lsdb-read (point-marker)))
+	  ;; Load the secondary hash tables following.
+	  (setq tables lsdb-secondary-hash-tables)
+	  (while tables
+	    (if (re-search-forward
+		 (concat "^" (lsdb-secondary-hash-table-start
+			      (car tables)))
+		 nil t)
+		(set (car tables) (lsdb-read (point-marker))))
+	    (setq tables (cdr tables))))
+      (kill-buffer buffer))))
+
+(defun lsdb-insert-hash-table (hash-table)
+  (insert "#s(hash-table size "
+	  ;; Reduce the actual size of the close hash table, because
+	  ;; XEmacs doesn't have a distinction between index-size and
+	  ;; hash-table-size.
+	  (number-to-string (lsdb-hash-table-count hash-table))
+	  " test equal data (")
+  (lsdb-maphash
+   (lambda (key value)
+     (insert (prin1-to-string key) " " (prin1-to-string value) " "))
+   hash-table)
+  (insert "))"))
+
+(defun lsdb-save-hash-tables ()
+  "Write the records within the internal hash tables into `lsdb-file'."
+  (let ((coding-system-for-write lsdb-file-coding-system)
+	tables)
+    (with-temp-file lsdb-file
       (if (and (or (featurep 'mule)
 		   (featurep 'file-coding))
 	       lsdb-file-coding-system)
@@ -346,15 +437,14 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
 				     lsdb-file-coding-system))))))
 	    (if coding-system-name
 		(insert ";;; -*- coding: " coding-system-name " -*-\n"))))
-      (insert "#s(hash-table size "
-	      ;; reduce the actual size of the close hash table
-	      (number-to-string (lsdb-hash-table-count hash-table))
-	      " test equal data (")
-      (lsdb-maphash
-       (lambda (key value)
-	 (insert (prin1-to-string key) " " (prin1-to-string value) " "))
-       hash-table)
-      (insert "))"))))
+      (lsdb-insert-hash-table lsdb-hash-table)
+      ;; Save the secondary hash tables following.
+      (setq tables lsdb-secondary-hash-tables)
+      (while tables
+	(insert "\n" (lsdb-secondary-hash-table-start
+		      (car tables)))
+	(lsdb-insert-hash-table (symbol-value (car tables)))
+	(setq tables (cdr tables))))))
 
 ;;;_. Mail Header Extraction
 (defun lsdb-fetch-field-bodies (regexp)
@@ -377,11 +467,15 @@ 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 (nth 1 components)
-		  (funcall lsdb-canonicalize-full-name-function
-			   (car components)))
+	    (list (funcall lsdb-canonicalize-full-name-function
+			   (car components))
+		  (nth 1 components))
 	  (list (nth 1 components) (nth 1 components))))))
 
 ;; stolen (and renamed) from nnheader.el
@@ -399,23 +493,96 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
       (set-buffer-multibyte multibyte))))
 
 ;;;_. Record Management
-(defun lsdb-maybe-load-file ()
+(defun lsdb-rebuild-secondary-hash-tables (&optional force)
+  (let ((tables lsdb-secondary-hash-tables))
+    (while tables
+      (when (or force (not (symbol-value (car tables))))
+	(set (car tables) (lsdb-make-hash-table :test 'equal))
+	(lsdb-maphash
+	 (lambda (key value)
+	   (run-hook-with-args
+	    'lsdb-update-record-functions
+	    (cons key value)))
+	 lsdb-hash-table)
+	(setq lsdb-hash-tables-are-dirty t))
+      (setq tables (cdr tables)))))
+
+(defun lsdb-maybe-load-hash-tables ()
   (unless lsdb-hash-table
     (if (file-exists-p lsdb-file)
-	(setq lsdb-hash-table (lsdb-load-file lsdb-file))
-      (setq lsdb-hash-table (lsdb-make-hash-table :test 'equal)))))
-
+	(lsdb-load-hash-tables)
+      (setq lsdb-hash-table (lsdb-make-hash-table :test 'equal)))
+    (lsdb-rebuild-secondary-hash-tables)))
+
+;;;_ : Fallback Lookup Functions
+;;;_  , #1 Address Cache
+(defun lsdb-lookup-full-name-from-address-cache (sender)
+  (lsdb-gethash (nth 1 sender) lsdb-address-cache))
+
+(defun lsdb-update-address-cache (record)
+  (let ((net (cdr (assq 'net record))))
+    (while net
+      (lsdb-puthash (pop net) (car record) lsdb-address-cache))))
+
+;;;_  , #2 Iterate on the All Records (very slow)
+(defun lsdb-lookup-full-name-by-fuzzy-matching (sender)
+  (let ((names
+	 (if (string-match
+	      "\\`\\(.+\\)[ \t]+\\(/[ \t]+\\|(\\([^)]+\\))\\)"
+	      (car sender))
+	     (if (match-beginning 3)
+		 (list (match-string 1 (car sender))
+		       (match-string 3 (car sender)))
+	       (list (match-string 1 (car sender))
+		     (substring (car sender) (match-end 0))))
+	   (list (car sender))))
+	(case-fold-search t))
+    (catch 'found
+      (lsdb-maphash
+       (lambda (key value)
+	 (while names
+	   (if (or (string-match
+		    (concat "\\<" (regexp-quote (car names)) "\\>")
+		    key)
+		   (string-match
+		    (concat
+		     "\\<"
+		     (regexp-quote
+		      (mapconcat #'identity
+				 (nreverse (split-string (car names)))
+				 " "))
+		     "\\>")
+		    key)
+		   ;; Don't assume that we are using address cache.
+		   (member (nth 1 sender) (cdr (assq 'net value))))
+	       (throw 'found key))
+	   (setq names (cdr names))))
+       lsdb-hash-table))))
+
+;;;_ : Update Records
 (defun lsdb-update-record (sender &optional interesting)
-  (let ((old (lsdb-gethash (nth 1 sender) lsdb-hash-table))
-	(new (cons (cons 'net (list (car sender)))
+  (let ((old (lsdb-gethash (car sender) lsdb-hash-table))
+	(new (cons (cons 'net (list (nth 1 sender)))
 		   interesting))
 	merged
-	record)
+	record
+	full-name)
+    ;; Look for the existing record from the reverse hash table.
+    ;; If it is found, regsiter the current full-name as AKA.
+    (unless old
+      (setq full-name
+	    (run-hook-with-args-until-success
+	     'lsdb-lookup-full-name-functions
+	     sender))
+      (when full-name
+	(setq old (lsdb-gethash full-name lsdb-hash-table)
+	      new (cons (list 'aka (car sender)) new))
+	(setcar sender full-name)))
     (unless old
       (setq new (cons (cons 'creation-date (format-time-string "%Y-%m-%d"))
 		      new)))
     (setq merged (lsdb-merge-record-entries old new)
-	  record (cons (nth 1 sender) merged))
+	  record (cons (car sender) merged))
     (unless (equal merged old)
       (let ((entry (assq 'last-modified (cdr record)))
 	    (last-modified (format-time-string "%Y-%m-%d")))
@@ -425,11 +592,12 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
 			       (cdr record)))))
       (lsdb-puthash (car record) (cdr record)
 		    lsdb-hash-table)
-      (setq lsdb-hash-table-is-dirty t))
+      (run-hook-with-args 'lsdb-update-record-functions record)
+      (setq lsdb-hash-tables-are-dirty t))
     record))
 
 (defun lsdb-update-records ()
-  (lsdb-maybe-load-file)
+  (lsdb-maybe-load-hash-tables)
   (let (senders recipients interesting alist records bodies entry)
     (save-restriction
       (std11-narrow-to-header)
@@ -489,27 +657,31 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
   old)
 
 ;;;_. Display Management
-(defun lsdb-temp-buffer-show-function (buffer)
+(defun lsdb-fit-window-to-buffer (&optional window)
   (save-selected-window
-    (let ((window (or (get-buffer-window lsdb-buffer-name)
-		      (progn
-			(select-window (get-largest-window))
-			(split-window-vertically))))
-	  height)
-      (set-window-buffer window buffer)
-      (select-window window)
-      (unless (pos-visible-in-window-p (point-max))
-	(enlarge-window (- lsdb-window-max-height (window-height))))
-      (shrink-window-if-larger-than-buffer)
-      (if (> (setq height (window-height))
-	     lsdb-window-max-height)
+    (if window
+	(select-window window))
+    (unless (pos-visible-in-window-p (point-max))
+      (enlarge-window (- lsdb-window-max-height (window-height))))
+    (shrink-window-if-larger-than-buffer)
+    (let ((height (window-height)))
+      (if (> height lsdb-window-max-height)
 	  (shrink-window (- height lsdb-window-max-height)))
       (set-window-start window (point-min)))))
 
+(defun lsdb-temp-buffer-show-function (buffer)
+  (when lsdb-pop-up-windows
+    (save-selected-window
+      (let ((window (or (get-buffer-window lsdb-buffer-name)
+			(progn
+			  (select-window (get-largest-window))
+			  (split-window-vertically)))))
+	(set-window-buffer window buffer)
+	(lsdb-fit-window-to-buffer window)))))
+
 (defun lsdb-display-record (record)
   "Display only one RECORD, then shrink the window as possible."
-  (let ((temp-buffer-show-function
-	 (function lsdb-temp-buffer-show-function)))
+  (let ((temp-buffer-show-function lsdb-temp-buffer-show-function))
     (lsdb-display-records (list record))))
 
 (defun lsdb-display-records (records)
@@ -563,16 +735,45 @@ 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)
 
+(defun lsdb-complete-name-highlight (start end)
+  (make-local-hook 'pre-command-hook)
+  (add-hook 'pre-command-hook 'lsdb-complete-name-highlight-update nil t)
+  (save-excursion
+    (goto-char start)
+    (search-forward lsdb-last-completion end)
+    (setq lsdb-last-highlight-overlay
+	  (make-overlay (match-beginning 0) (match-end 0)))
+    (overlay-put lsdb-last-highlight-overlay 'face
+		 (or (find-face 'isearch-secondary)
+		     (find-face 'isearch-lazy-highlight-face)
+		     'underline))))
+
+(defun lsdb-complete-name-highlight-update ()
+  (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)))
+
+;;;_ : Name Completion
 (defun lsdb-complete-name ()
   "Complete the user full-name or net-address before point"
   (interactive)
-  (lsdb-maybe-load-file)
+  (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))
@@ -580,7 +781,7 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
       (setq lsdb-last-candidates nil
 	    lsdb-last-candidates-pointer nil
 	    lsdb-last-completion (buffer-substring start (point))
-	    pattern (concat "\\<" lsdb-last-completion))
+	    pattern (concat "\\<" (regexp-quote lsdb-last-completion)))
       (lsdb-maphash
        (lambda (key value)
 	 (let ((net (cdr (assq 'net value))))
@@ -609,7 +810,8 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
       (setq lsdb-last-candidates-pointer lsdb-last-candidates))
     (when lsdb-last-candidates-pointer
       (delete-region start (point))
-      (insert (pop lsdb-last-candidates-pointer)))))
+      (insert (pop lsdb-last-candidates-pointer))
+      (lsdb-complete-name-highlight start (point)))))
 
 ;;;_. Major Mode (`lsdb-mode') Implementation
 ;;;_ : Modeline Buffer Identification
@@ -692,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)
@@ -715,8 +918,8 @@ Modify whole identification by side effect."
       (font-lock-set-defaults)
     (set (make-local-variable 'font-lock-defaults)
 	 '(lsdb-font-lock-keywords t)))
-  (make-local-variable 'post-command-hook)
-  (setq post-command-hook 'lsdb-modeline-update)
+  (make-local-hook 'post-command-hook)
+  (add-hook 'post-command-hook 'lsdb-modeline-update nil t)
   (make-local-variable 'lsdb-modeline-string)
   (setq mode-line-buffer-identification
 	(lsdb-modeline-buffer-identification
@@ -741,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))))
 
@@ -794,7 +997,8 @@ the current record."
 	      (setcdr record (cons (cons ',entry-name form) (cdr record)))
 	      (lsdb-puthash (car record) (cdr record)
 			    lsdb-hash-table)
-	      (setq lsdb-hash-table-is-dirty t)
+	      (run-hook-with-args 'lsdb-update-record-functions record)
+	      (setq lsdb-hash-tables-are-dirty t)
 	      (beginning-of-line 2)
 	      (add-text-properties
 	       (point)
@@ -816,7 +1020,8 @@ the current record."
       (setcdr record (delq entry (cdr record)))
       (lsdb-puthash (car record) (cdr record)
 		    lsdb-hash-table)
-      (setq lsdb-hash-table-is-dirty t))
+      (run-hook-with-args 'lsdb-update-record-functions record)
+      (setq lsdb-hash-tables-are-dirty t))
     (save-restriction
       (lsdb-narrow-to-record)
       (let ((case-fold-search t)
@@ -853,7 +1058,8 @@ the current record."
 		   (inhibit-read-only t)
 		   buffer-read-only)
 	      (setcdr entry form)
-	      (setq lsdb-hash-table-is-dirty t)
+	      (run-hook-with-args 'lsdb-update-record-functions record)
+	      (setq lsdb-hash-tables-are-dirty t)
 	      (lsdb-mode-delete-entry (symbol-name ',entry-name) t)
 	      (beginning-of-line)
 	      (add-text-properties
@@ -866,15 +1072,24 @@ the current record."
 (defun lsdb-mode-save (&optional dont-ask)
   "Save LSDB hash table into `lsdb-file'."
   (interactive)
-  (if (not lsdb-hash-table-is-dirty)
+  (if (not lsdb-hash-tables-are-dirty)
       (message "(No changes need to be saved)")
     (when (or (interactive-p)
 	      dont-ask
-	      (y-or-n-p "Save the LSDB now?"))
-      (lsdb-save-file lsdb-file lsdb-hash-table)
-      (setq lsdb-hash-table-is-dirty nil)
+	      (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'."
@@ -888,14 +1103,42 @@ 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-mode-hide-buffer ()
+(defun lsdb-hide-buffer ()
   "Hide the LSDB window."
   (let ((window (get-buffer-window lsdb-buffer-name)))
     (if window
 	(lsdb-mode-quit-window nil window))))
 
+(defun lsdb-show-buffer ()
+  "Show the LSDB window."
+  (if (get-buffer lsdb-buffer-name)
+      (if lsdb-temp-buffer-show-function
+	  (let ((lsdb-pop-up-windows t))
+	    (funcall lsdb-temp-buffer-show-function lsdb-buffer-name))
+	(pop-to-buffer lsdb-buffer-name))))
+
+(defun lsdb-toggle-buffer (&optional arg)
+  "Toggle hiding of the LSDB window.
+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)))
+  (unless arg				;called noninteractively?
+    (setq arg 0))
+  (cond
+   ((or (< arg 0)
+	(and (zerop arg)
+	     (not (get-buffer-window lsdb-buffer-name))))
+    (lsdb-show-buffer))
+   ((or (> arg 0)
+	(and (zerop arg)
+	     (get-buffer-window lsdb-buffer-name)))
+    (lsdb-hide-buffer))))
+
 (defun lsdb-lookup-records (regexp &optional entry-name)
   "Return the all records in the LSDB matching the REGEXP.
 If the optional 2nd argument ENTRY-NAME is given, matching only
@@ -941,7 +1184,7 @@ performed against the entry field."
 	 "Search records regexp: ")
        nil nil nil 'lsdb-mode-lookup-history)
       entry-name)))
-  (lsdb-maybe-load-file)
+  (lsdb-maybe-load-hash-tables)
   (let ((records (lsdb-lookup-records regexp entry-name)))
     (if records
 	(lsdb-display-records records))))
@@ -1067,7 +1310,12 @@ of the buffer."
 (defun lsdb-wl-insinuate ()
   "Call this function to hook LSDB into Wanderlust."
   (add-hook 'wl-message-redisplay-hook 'lsdb-wl-update-record)
-  (add-hook 'wl-summary-exit-hook 'lsdb-mode-hide-buffer)
+  (add-hook 'wl-summary-exit-hook 'lsdb-hide-buffer)
+  (add-hook 'wl-summary-toggle-disp-off-hook 'lsdb-hide-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-wl-show-buffer)
   (add-hook 'wl-exit-hook 'lsdb-mode-save)
   (add-hook 'wl-save-hook 'lsdb-mode-save))
 
@@ -1078,15 +1326,54 @@ of the buffer."
     (set-buffer (wl-message-get-original-buffer))
     (let ((records (lsdb-update-records)))
       (when records
-	(lsdb-display-record (car records))))))
-
-;;;_. Interface to Mew written by Hideyuki SHIRAI <shirai@rdmg.mgcs.mei.co.jp>
+	(let ((lsdb-temp-buffer-show-function
+	       #'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)
+  (when lsdb-pop-up-windows
+    (save-selected-window
+      (let ((window (or (get-buffer-window lsdb-buffer-name)
+			(progn
+			  (select-window 
+			   (or (save-excursion
+				 (if (buffer-live-p wl-current-summary-buffer)
+				     (set-buffer wl-current-summary-buffer))
+				 (get-buffer-window wl-message-buffer))
+			       (get-largest-window)))
+			  (split-window-vertically)))))
+	(set-window-buffer window buffer)
+	(lsdb-fit-window-to-buffer window)))))
+
+;;;_. 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 ()
@@ -1095,25 +1382,36 @@ of the buffer."
   (add-hook 'mew-summary-toggle-disp-msg-hook
 	    (lambda ()
 	      (unless (mew-sinfo-get-disp-msg)
-		(lsdb-mode-hide-buffer))))
-  (add-hook 'mew-suspend-hook 'lsdb-mode-hide-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
@@ -1139,7 +1437,8 @@ of the buffer."
 				    (cdr (car records))))
 	(lsdb-puthash (car (car records)) (cdr (car records))
 		      lsdb-hash-table)
-	(setq lsdb-hash-table-is-dirty t)))))
+	(run-hook-with-args 'lsdb-update-record-functions (car records))
+	(setq lsdb-hash-tables-are-dirty t)))))
 
 (defun lsdb-mu-get-prefix-method ()
   "A mu-cite method to return a prefix from LSDB or \">\".
@@ -1229,11 +1528,15 @@ the user wants it."
 	       x-face)
       (goto-char (point-min))
       (end-of-line)
-      (put-text-property 0 1 'invisible t delimiter)
-      (put-text-property 0 (length delimiter) 'lsdb-record record delimiter)
-      (insert delimiter)
-      (while x-face
-	(funcall lsdb-insert-x-face-function (pop x-face))))))
+      (put-text-property 0 1 'invisible t delimiter) ;hide "\r"
+      (put-text-property
+       (point)
+       (progn
+	 (insert delimiter)
+	 (while x-face
+	   (funcall lsdb-insert-x-face-function (pop x-face)))
+	 (point))
+       'lsdb-record record))))
 
 (defun lsdb-insert-x-face-image (data type marker)
   (static-if (featurep 'xemacs)
@@ -1259,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)
@@ -1295,7 +1599,7 @@ the user wants it."
 (provide 'lsdb)
 
 (product-provide 'lsdb
-  (product-define "LSDB" nil '(0 2)))
+  (product-define "LSDB" nil '(0 7)))
 
 ;;;_* Local emacs vars.
 ;;; The following `outline-layout' local variable setting: