X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lsdb.el;h=8b31fdf0a6fc84d8ebfa049c9a0781301d4fb7be;hb=1857621e234123fc816b4b6c3acacba265a840cc;hp=cee99c3a5049c30793e3c0f328d1b2d98d86edb4;hpb=bdd0c0fc3766e90640928ca6c0b9eb6f017726bd;p=elisp%2Flsdb.git diff --git a/lsdb.el b/lsdb.el index cee99c3..8b31fdf 100644 --- a/lsdb.el +++ b/lsdb.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002 Daiki Ueno ;; Author: Daiki Ueno -;; Keywords: adress book +;; Keywords: address book ;; This file is part of the Lovely Sister Database. @@ -36,8 +36,8 @@ ;;; (define-key gnus-summary-mode-map ":" 'lsdb-toggle-buffer))) ;;; For Wanderlust, put the following lines into your ~/.wl: -;;; (require 'lsdb) -;;; (lsdb-wl-insinuate) +;;; (autoload 'lsdb-wl-insinuate "lsdb") +;;; (add-hook 'wl-init-hook 'lsdb-wl-insinuate) ;;; (add-hook 'wl-draft-mode-hook ;;; (lambda () ;;; (define-key wl-draft-mode-map "\M-\t" 'lsdb-complete-name))) @@ -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) @@ -156,6 +156,13 @@ The updated record is passed to each function as the argument." :group 'lsdb :type 'hook) +(defcustom lsdb-delete-record-functions + '(lsdb-delete-address-cache) + "List of functions called after a record is removed. +The removed 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" @@ -167,6 +174,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")) @@ -198,6 +211,14 @@ The compressed face will be piped to this command." :group 'lsdb :type 'function) +(defcustom lsdb-display-records-belong-to-user t + "Non-nil means LSDB displays records belong to yourself. +When this option is equal to nil and a message is sent by the user +whose address is `user-mail-address', the LSDB record for the To: line +will be shown instead of the one for the From: line." + :group 'lsdb + :type 'boolean) + (defcustom lsdb-pop-up-windows t "Non-nil means LSDB should make new windows to display records." :group 'lsdb @@ -223,6 +244,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))) @@ -349,35 +375,42 @@ 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) - (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))))))))) + (let ((end-marker + (progn + (forward-char 2) ;skip "#s" + (forward-sexp) ;move to the left paren + (point-marker)))) + (with-temp-buffer + (buffer-disable-undo) + (insert-buffer-substring (marker-buffer marker) + marker end-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)))) + (read marker))))))) (defun lsdb-load-hash-tables () "Read the contents of `lsdb-file' into the internal hash tables." @@ -410,7 +443,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 "))")) @@ -487,10 +521,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) @@ -506,7 +540,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 @@ -518,6 +552,11 @@ This is the current number of slots in HASH-TABLE, whether occupied or not." (while net (lsdb-puthash (pop net) (car record) lsdb-address-cache)))) +(defun lsdb-delete-address-cache (record) + (let ((net (cdr (assq 'net record)))) + (while net + (lsdb-remhash (pop net) lsdb-address-cache)))) + ;;;_ , #2 Iterate on the All Records (very slow) (defun lsdb-lookup-full-name-by-fuzzy-matching (sender) (let ((names @@ -673,26 +712,49 @@ This is the current number of slots in HASH-TABLE, whether occupied or not." (set-window-buffer window buffer) (lsdb-fit-window-to-buffer window))))) +(defun lsdb-update-records-and-display () + (let ((records (lsdb-update-records))) + (if lsdb-display-records-belong-to-user + (if records + (lsdb-display-record (car records)) + (lsdb-hide-buffer)) + (catch 'lsdb-show-record + (while records + (if (member user-mail-address (cdr (assq 'net (car records)))) + (setq records (cdr records)) + (lsdb-display-record (car records)) + (throw 'lsdb-show-record t))) + (lsdb-hide-buffer))))) + (defun lsdb-display-record (record) "Display only one RECORD, then shrink the window as possible." (let ((temp-buffer-show-function lsdb-temp-buffer-show-function)) (lsdb-display-records (list record)))) (defun lsdb-display-records (records) - (with-output-to-temp-buffer lsdb-buffer-name - (set-buffer standard-output) - (setq records - (sort (copy-sequence records) - (or lsdb-display-records-sort-predicate - (lambda (record1 record2) - (string-lessp (car record1) (car record2)))))) - (while records - (save-restriction - (narrow-to-region (point) (point)) - (lsdb-print-record (car records))) - (goto-char (point-max)) - (setq records (cdr records))) - (lsdb-mode))) + (with-current-buffer (get-buffer-create lsdb-buffer-name) + (let ((standard-output (current-buffer)) + (inhibit-read-only t) + buffer-read-only) + (buffer-disable-undo) + (erase-buffer) + (setq records + (sort (copy-sequence records) + (or lsdb-display-records-sort-predicate + (lambda (record1 record2) + (string-lessp (car record1) (car record2)))))) + (while records + (save-restriction + (narrow-to-region (point) (point)) + (lsdb-print-record (car records))) + (goto-char (point-max)) + (setq records (cdr records)))) + (lsdb-mode) + (set-buffer-modified-p lsdb-hash-tables-are-dirty) + (goto-char (point-min)) + (if temp-buffer-show-function + (funcall temp-buffer-show-function (current-buffer)) + (pop-to-buffer (current-buffer))))) (defsubst lsdb-entry-score (entry) (or (nth 1 (assq (car entry) lsdb-entry-type-alist)) 0)) @@ -729,6 +791,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) @@ -747,9 +810,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))) @@ -758,11 +822,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)) @@ -882,7 +949,10 @@ Modify whole identification by side effect." (let ((keymap (make-sparse-keymap))) (define-key keymap "a" 'lsdb-mode-add-entry) (define-key keymap "d" 'lsdb-mode-delete-entry) + (define-key keymap "D" 'lsdb-mode-delete-record) (define-key keymap "e" 'lsdb-mode-edit-entry) + (define-key keymap "E" 'lsdb-mode-edit-record) + (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) @@ -922,7 +992,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 "")))) @@ -932,34 +1002,48 @@ 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-delete-record (record) + "Delete given RECORD." + (lsdb-remhash (car record) lsdb-hash-table) + (run-hook-with-args 'lsdb-delete-record-functions record) + (setq lsdb-hash-tables-are-dirty t)) (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." @@ -995,80 +1079,162 @@ 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 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-delete-record () + "Delete the record on the current line." + (interactive) + (let ((record (lsdb-current-record))) + (unless record + (error "%s" "There is nothing to follow here")) + (when (or (not lsdb-verbose) + (yes-or-no-p + (format "Do you really want to delete entire record of `%s'? " + (car record)))) + (lsdb-delete-record record) + (save-restriction + (lsdb-narrow-to-record) + (let ((inhibit-read-only t) + buffer-read-only) + (delete-region (point-min) (point-max))))))) + +(defun lsdb-mode-delete-entry-or-record () + "Delete the entry on the current line. +If the cursor is on the first line of a database entry (the name line) +then the entire entry will be deleted." + (interactive) + (if (lsdb-current-entry) + (lsdb-mode-delete-entry) + (lsdb-mode-delete-record))) (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))) - (lsdb-edit-form - (cdr entry) "Editing the entry." - `(lambda (form) - (unless (equal form ',(cdr entry)) - (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))) + (unless record + (error "There is nothing to follow here")) + (let ((entry-name (or (lsdb-current-entry) + (lsdb-read-entry record "Which entry to edit: ")))) + (lsdb-edit-form + (cdr (assq entry-name (cdr record))) "Editing the entry." + `(lambda (form) + (let* ((record ',record) + (entry-name ',entry-name) + (entry (assq entry-name (cdr record)))) + (unless (equal form (cdr entry)) (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) - (beginning-of-line) - (add-text-properties - (point) - (progn - (lsdb-insert-entry (cons ',entry-name form)) - (point)) - (list 'lsdb-record record))))))))) + (with-current-buffer lsdb-buffer-name + (let ((inhibit-read-only t) + buffer-read-only + (pos (text-property-any (point-min) (point-max) + 'lsdb-record record))) + (unless pos + (error "%s" "The entry currently in editing is discarded")) + (lsdb-mode-delete-entry-1 entry) + (forward-line 0) + (add-text-properties + (point) + (progn + (lsdb-insert-entry (cons entry-name form)) + (point)) + (list 'lsdb-record record))))))))))) + +(defun lsdb-mode-edit-record () + "Edit the name of the record on the current line." + (interactive) + (let ((record (lsdb-current-record))) + (unless record + (error "There is nothing to follow here")) + (lsdb-edit-form + (car record) "Editing the name." + `(lambda (new-name) + (unless (stringp new-name) + (error "String is required: `%s'" new-name)) + (let* ((record ',record) + (old-name (car record))) + (unless (equal new-name old-name) + (lsdb-delete-record record) + (setcar record new-name) + (lsdb-puthash new-name (cdr record) lsdb-hash-table) + (run-hook-with-args 'lsdb-update-record-functions record) + (setq lsdb-hash-tables-are-dirty t) + (with-current-buffer lsdb-buffer-name + (let ((inhibit-read-only t) + buffer-read-only + (pos (text-property-any (point-min) (point-max) + 'lsdb-record record))) + (unless pos + (error "%s" "The entry currently in editing is discarded")) + (delete-region (point) (+ (point) (length old-name))) + (add-text-properties (point) + (progn (insert form) (point)) + (list 'lsdb-record record)))))))))) + +(defun lsdb-mode-edit-entry-or-record () + "Edit the entry on the current line. +If the cursor is on the first line of a database entry (the name line) +then the name of this record will be edited." + (interactive) + (if (lsdb-current-entry) + (lsdb-mode-edit-entry) + (lsdb-mode-edit-record))) (defun lsdb-mode-save (&optional dont-ask) "Save LSDB hash table into `lsdb-file'." - (interactive) + (interactive (list t)) (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?")) + (when (or dont-ask + (not lsdb-verbose) + (y-or-n-p "Save the LSDB now? ")) (lsdb-save-hash-tables) - (setq lsdb-hash-tables-are-dirty nil) + (set-buffer-modified-p (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'." @@ -1082,7 +1248,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." @@ -1126,8 +1292,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) @@ -1162,7 +1326,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 @@ -1272,17 +1437,12 @@ of the buffer." (add-hook 'gnus-article-prepare-hook 'lsdb-gnus-update-record) (add-hook 'gnus-save-newsrc-hook 'lsdb-mode-save)) -(defvar gnus-current-headers) +(defvar gnus-article-current-summary) +(defvar gnus-original-article-buffer) (defun lsdb-gnus-update-record () - (let ((entity gnus-current-headers) - records) - (with-temp-buffer - (set-buffer-multibyte nil) - (buffer-disable-undo) - (mime-insert-entity entity) - (setq records (lsdb-update-records)) - (when records - (lsdb-display-record (car records)))))) + (with-current-buffer (with-current-buffer gnus-article-current-summary + gnus-original-article-buffer) + (lsdb-update-records-and-display))) ;;;_. Interface to Wanderlust ;;;###autoload @@ -1303,11 +1463,9 @@ of the buffer." (defun lsdb-wl-update-record () (save-excursion (set-buffer (wl-message-get-original-buffer)) - (let ((records (lsdb-update-records))) - (when records - (let ((lsdb-temp-buffer-show-function - #'lsdb-wl-temp-buffer-show-function)) - (lsdb-display-record (car records))))))) + (let ((lsdb-temp-buffer-show-function + #'lsdb-wl-temp-buffer-show-function)) + (lsdb-update-records-and-display)))) (defun lsdb-wl-toggle-buffer (&optional arg) "Toggle hiding of the LSDB window for Wanderlust. @@ -1344,13 +1502,26 @@ always hide." (set-window-buffer window buffer) (lsdb-fit-window-to-buffer window))))) -;;;_. Interface to Mew written by Hideyuki SHIRAI +;;;_. Interface to Mew written by Hideyuki SHIRAI (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")) + (condition-case nil + (progn + (require 'mew) + ;; Avoid macro `mew-cache-hit' expand (Mew 1.94.2 or earlier). + ;; Changed `mew-cache-hit' from macro to function at Mew 2.0. + (if (not (fboundp 'mew-current-get-fld)) + (setq byte-compile-macro-environment + (cons '(mew-cache-hit . nil) + byte-compile-macro-environment)))) + (error + ;; Silence byte compiler for environments where Mew does not installed. + (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-xinfo-get-decode-err "mew") + (autoload 'mew-xinfo-get-action "mew")))) ;;;###autoload (defun lsdb-mew-insinuate () @@ -1362,22 +1533,31 @@ always hide." (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)) - 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)))))) + (cache (mew-cache-hit fld msg))) + (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)) + (lsdb-update-records-and-display)))))) ;;;_. Interface to MU-CITE (eval-when-compile @@ -1528,7 +1708,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) @@ -1564,7 +1745,7 @@ the user wants it." (provide 'lsdb) (product-provide 'lsdb - (product-define "LSDB" nil '(0 5))) + (product-define "LSDB" nil '(0 9))) ;;;_* Local emacs vars. ;;; The following `outline-layout' local variable setting: