(lsdb-read) [Emacs]: Don't create temp buffer.
[elisp/lsdb.git] / lsdb.el
diff --git a/lsdb.el b/lsdb.el
index 2375d8f..718a214 100644 (file)
--- 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)
@@ -158,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"))
@@ -189,14 +204,6 @@ The compressed face will be piped to this command."
   :group 'lsdb
   :type 'function)
 
-(defcustom 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'."
-  :group 'lsdb
-  :type 'function)
-
 (defcustom lsdb-pop-up-windows t
   "Non-nil means LSDB should make new windows to display records."
   :group 'lsdb
@@ -222,6 +229,11 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
   :group 'lsdb
   :type 'string)
 
+(defcustom lsdb-verbose t
+  "If non-nil, confirm user to submit changes to lsdb-hash-table."
+  :type 'boolean
+  :group 'lsdb)
+
 ;;;_. Faces
 (defface lsdb-header-face
   '((t (:underline t)))
@@ -275,6 +287,12 @@ It represents address to full-name mapping.")
   (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)))
@@ -342,22 +360,19 @@ 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."
        (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)
+            (progn
+              (forward-char 2) ;skip "#s"
               (let ((object (read (current-buffer)))
                     hash-table data)
                 (if (eq 'hash-table (car object))
@@ -370,7 +385,8 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
                       (while data
                         (lsdb-puthash (pop data) (pop data) hash-table))
                       hash-table)
-                  object)))))))))
+                  object)))
+          (read marker)))))))
 
 (defun lsdb-load-hash-tables ()
   "Read the contents of `lsdb-file' into the internal hash tables."
@@ -403,7 +419,8 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
          " test equal data (")
   (lsdb-maphash
    (lambda (key value)
-     (insert (prin1-to-string key) " " (prin1-to-string value) " "))
+     (let (print-level print-length)
+       (insert (prin1-to-string key) " " (prin1-to-string value) " ")))
    hash-table)
   (insert "))"))
 
@@ -454,7 +471,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))
@@ -476,10 +497,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)
@@ -495,7 +516,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
@@ -653,13 +674,14 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
       (set-window-start window (point-min)))))
 
 (defun lsdb-temp-buffer-show-function (buffer)
-  (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))))
+  (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."
@@ -717,6 +739,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)
@@ -735,9 +758,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)))
 
@@ -746,11 +770,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))
@@ -871,6 +898,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)
@@ -910,7 +938,7 @@ Modify whole identification by side effect."
     (if record
        (progn
          (setq net (car (cdr (assq 'net (cdr record)))))
-         (if (equal net (car record))
+         (if (and net (equal net (car record)))
              (setq lsdb-modeline-string net)
            (setq lsdb-modeline-string (concat (car record) " <" net ">"))))
       (setq lsdb-modeline-string ""))))
@@ -920,34 +948,42 @@ 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))))
 
 (defun lsdb-current-record ()
   "Return the current record name."
-  (let ((record (get-text-property (point) 'lsdb-record)))
-    (unless record
-      (error "There is nothing to follow here"))
-    record))
+  (get-text-property (point) 'lsdb-record))
 
 (defun lsdb-current-entry ()
-  "Return the current entry name.
-If the point is not on a entry line, it prompts to select a entry in
-the current record."
+  "Return the current entry name in canonical form."
   (save-excursion
     (beginning-of-line)
-    (if (looking-at "^[^\t]")
-       (let ((record (lsdb-current-record))
-             (completion-ignore-case t))
+    (if (looking-at "^\t\\([^\t][^:]+\\):")
+       (intern (downcase (match-string 1))))))
+
+(defun lsdb-read-entry (record &optional prompt)
+  "Prompt to select an entry in the given RECORD."
+  (let* ((completion-ignore-case t)
+        (entry-name
          (completing-read
-          "Which entry to modify: "
+          (or prompt
+              "Which entry: ")
           (mapcar (lambda (entry)
                     (list (capitalize (symbol-name (car entry)))))
-                  (cdr record))))
-      (end-of-line)
-      (re-search-backward "^\t\\([^\t][^:]+\\):")
-      (match-string 1))))
+                  (cdr record))
+          nil t)))
+    (unless (equal entry-name "")
+      (intern (downcase entry-name)))))
+
+(defun lsdb-delete-entry (record entry)
+  "Delete given ENTRY from RECORD."
+  (setcdr record (delq entry (cdr record)))
+  (lsdb-puthash (car record) (cdr record)
+               lsdb-hash-table)
+  (run-hook-with-args 'lsdb-update-record-functions record)
+  (setq lsdb-hash-tables-are-dirty t))
 
 (defun lsdb-mode-add-entry (entry-name)
   "Add an entry on the current line."
@@ -983,45 +1019,53 @@ the current record."
                 (point))
               (list 'lsdb-record record)))))))))
 
-(defun lsdb-mode-delete-entry (&optional entry-name dont-update)
+(defun lsdb-mode-delete-entry-1 (entry)
+  "Delete text contents of the ENTRY from the current buffer."
+  (save-restriction
+    (lsdb-narrow-to-record)
+    (let ((case-fold-search t)
+         (inhibit-read-only t)
+         buffer-read-only)
+      (goto-char (point-min))
+      (if (re-search-forward
+          (concat "^\t" (capitalize (symbol-name (car entry))) ":")
+          nil t)
+         (delete-region (match-beginning 0)
+                        (if (re-search-forward
+                             "^\t[^\t][^:]+:" nil t)
+                            (match-beginning 0)
+                          (point-max)))))))
+
+(defun lsdb-mode-delete-entry ()
   "Delete the entry on the current line."
   (interactive)
   (let ((record (lsdb-current-record))
-       entry)
-    (or entry-name
-       (setq entry-name (lsdb-current-entry)))
-    (setq entry (assq (intern (downcase entry-name)) (cdr record)))
+       entry-name entry)
+    (unless record
+      (error "There is nothing to follow here"))
+    (setq entry-name (or (lsdb-current-entry)
+                        (lsdb-read-entry record "Which entry to delete: "))
+         entry (assq entry-name (cdr record)))
     (when (and entry
-              (not dont-update))
-      (setcdr record (delq entry (cdr record)))
-      (lsdb-puthash (car record) (cdr record)
-                   lsdb-hash-table)
-      (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)
-           (inhibit-read-only t)
-           buffer-read-only)
-       (goto-char (point-min))
-       (if (re-search-forward
-            (concat "^\t" (or entry-name
-                              (lsdb-current-entry))
-                    ":")
-            nil t)
-           (delete-region (match-beginning 0)
-                          (if (re-search-forward
-                               "^\t[^\t][^:]+:" nil t)
-                              (match-beginning 0)
-                            (point-max))))))))
+              (or (not (interactive-p))
+                  (not lsdb-verbose)
+                  (y-or-n-p
+                   (format "Do you really want to delete entry `%s' of `%s'?"
+                           entry-name (car record)))))
+      (lsdb-delete-entry record entry)
+      (lsdb-mode-delete-entry-1 entry))))
 
 (defun lsdb-mode-edit-entry ()
   "Edit the entry on the current line."
   (interactive)
-  (let* ((record (lsdb-current-record))
-        (entry-name (intern (downcase (lsdb-current-entry))))
-        (entry (assq entry-name (cdr record)))
-        (marker (point-marker)))
+  (let ((record (lsdb-current-record))
+       entry-name entry marker)
+    (unless record
+      (error "There is nothing to follow here"))
+    (setq entry-name (or (lsdb-current-entry)
+                        (lsdb-read-entry record "Which entry to edit: "))
+         entry (assq entry-name (cdr record))
+         marker (point-marker))
     (lsdb-edit-form
      (cdr entry) "Editing the entry."
      `(lambda (form)
@@ -1029,14 +1073,17 @@ the current record."
          (save-excursion
            (set-buffer lsdb-buffer-name)
            (goto-char ,marker)
-           (let* ((record (lsdb-current-record))
-                  (entry (assq ',entry-name (cdr record)))
-                  (inhibit-read-only t)
-                  buffer-read-only)
+           (let ((record (lsdb-current-record))
+                 entry
+                 (inhibit-read-only t)
+                 buffer-read-only)
+             (unless record
+               (error "The entry currently in editing is discarded"))
+             (setq entry (assq ',entry-name (cdr record)))
              (setcdr entry form)
              (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)
+             (lsdb-mode-delete-entry-1 entry)
              (beginning-of-line)
              (add-text-properties
               (point)
@@ -1052,11 +1099,21 @@ the current record."
       (message "(No changes need to be saved)")
     (when (or (interactive-p)
              dont-ask
-             (y-or-n-p "Save the LSDB now?"))
+             (not lsdb-verbose)
+             (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'."
@@ -1070,21 +1127,41 @@ 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-mode-show-buffer ()
+(defun lsdb-show-buffer ()
   "Show the LSDB window."
   (if (get-buffer lsdb-buffer-name)
       (if lsdb-temp-buffer-show-function
-         (pop-to-buffer (get-buffer lsdb-buffer-name))
-       (funcall lsdb-temp-buffer-show-function
-                (get-buffer lsdb-buffer-name)))))
+         (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.
@@ -1094,8 +1171,6 @@ performed against the entry field."
     (lsdb-maphash
      (if entry-name
         (progn
-          (unless (symbolp entry-name)
-            (setq entry-name (intern (downcase entry-name))))
           (lambda (key value)
             (let ((entry (cdr (assq entry-name value)))
                   found)
@@ -1130,7 +1205,8 @@ performed against the entry field."
           (format "Search records `%s' regexp: " entry-name)
         "Search records regexp: ")
        nil nil nil 'lsdb-mode-lookup-history)
-      entry-name)))
+      (if (and entry-name (not (equal entry-name "")))
+         (intern (downcase entry-name))))))
   (lsdb-maybe-load-hash-tables)
   (let ((records (lsdb-lookup-records regexp entry-name)))
     (if records
@@ -1249,7 +1325,7 @@ of the buffer."
       (buffer-disable-undo)
       (mime-insert-entity entity)
       (setq records (lsdb-update-records))
-      (when (and records lsdb-pop-up-windows)
+      (when records
        (lsdb-display-record (car records))))))
 
 ;;;_. Interface to Wanderlust
@@ -1257,12 +1333,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-toggle-disp-off-hook 'lsdb-mode-hide-buffer)
-  (add-hook 'wl-summary-toggle-disp-folder-on-hook 'lsdb-mode-hide-buffer)
-  (add-hook 'wl-summary-toggle-disp-folder-off-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-mode-show-buffer)
+           'lsdb-wl-show-buffer)
   (add-hook 'wl-exit-hook 'lsdb-mode-save)
   (add-hook 'wl-save-hook 'lsdb-mode-save))
 
@@ -1272,34 +1348,55 @@ of the buffer."
   (save-excursion
     (set-buffer (wl-message-get-original-buffer))
     (let ((records (lsdb-update-records)))
-      (when (and records lsdb-pop-up-windows)
+      (when records
        (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)
-  (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@rdmg.mgcs.mei.co.jp>
+  (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 ()
@@ -1308,26 +1405,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 (and (setq records (lsdb-update-records))
-                lsdb-pop-up-windows)
-       (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
@@ -1478,7 +1585,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)
@@ -1514,7 +1622,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: