* lsdb.el: Add instructions for Wanderlust.

(lsdb-gnus-insinuate-message): Abolish.
(lsdb-gethash) [Emacs]: Fixed.

diff --git a/lsdb.el b/lsdb.el
index e981e48..200d1e7 100644 (file)
--- a/lsdb.el
+++ b/lsdb.el
@@ -24,13 +24,24 @@
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

+;;; For Semi-gnus:

 ;;; (autoload 'lsdb-gnus-insinuate "lsdb")
 ;;; (autoload 'lsdb-gnus-insinuate-message "lsdb")
 ;;; (add-hook 'gnus-startup-hook 'lsdb-gnus-insinuate)
 ;;; (autoload 'lsdb-gnus-insinuate "lsdb")
 ;;; (autoload 'lsdb-gnus-insinuate-message "lsdb")
 ;;; (add-hook 'gnus-startup-hook 'lsdb-gnus-insinuate)

-;;; (add-hook 'message-setup-hook 'lsdb-gnus-insinuate-message)
+;;; (add-hook 'message-setup-hook
+;;;           (lambda ()
+;;;             (define-key message-mode-map "\M-\t" 'lsdb-complete-name)))
+
+;;; For Wanderlust, put the following lines into your ~/.wl:
+;;; (require 'lsdb)
+;;; (lsdb-wl-insinuate)
+;;; (add-hook 'wl-draft-mode-hook
+;;;           (lambda ()
+;;;             (define-key message-mode-map "\M-\t" 'lsdb-complete-name)))

 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'poem)

 (require 'mime)
 
 ;;;_* USER CUSTOMIZATION VARIABLES:
 (require 'mime)
 
 ;;;_* USER CUSTOMIZATION VARIABLES:

@@ -74,11 +85,13 @@ where the last three elements are optional."
   :type 'list)
 
 (defcustom lsdb-entry-type-alist
   :type 'list)
 
 (defcustom lsdb-entry-type-alist

-  '((net 3 ?,)
+  '((net 5 ?,)

     (creation-date 2)
     (creation-date 2)

-    (mailing-list 1 ?,)
-    (attribution 1 ?.)
-    (organization 1))
+    (last-modified 2)
+    (mailing-list 3 ?,)
+    (attribution 3 ?.)
+    (organization 3)
+    (score -1))

   "Alist of entries to display.
 The format of elements of this list should be
      (ENTRY SCORE CLASS)
   "Alist of entries to display.
 The format of elements of this list should be
      (ENTRY SCORE CLASS)

@@ -181,8 +194,10 @@ where the last element is optional."
   (defun lsdb-gethash (key hash-table &optional default)
     "Find hash value for KEY in HASH-TABLE.
 If there is no corresponding value, return DEFAULT (which defaults to nil)."
   (defun lsdb-gethash (key hash-table &optional default)
     "Find hash value for KEY in HASH-TABLE.
 If there is no corresponding value, return DEFAULT (which defaults to nil)."

-    (or (intern-soft key (nth 1 hash-table))
-       default))
+    (let ((symbol (intern-soft key (nth 1 hash-table))))
+      (if symbol
+         (symbol-value symbol)
+       default)))

   (defun lsdb-remhash (key hash-table)
     "Remove the entry for KEY from HASH-TABLE.
 Do nothing if there is no entry for KEY in HASH-TABLE."
   (defun lsdb-remhash (key hash-table)
     "Remove the entry for KEY from HASH-TABLE.
 Do nothing if there is no entry for KEY in HASH-TABLE."

@@ -267,16 +282,17 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
       (lsdb-save-file lsdb-file lsdb-hash-table)))
 
 ;;;_. Mail Header Extraction
       (lsdb-save-file lsdb-file lsdb-hash-table)))
 
 ;;;_. Mail Header Extraction

-(defun lsdb-fetch-field-bodies (entity regexp)
+(defun lsdb-fetch-field-bodies (regexp)

   (save-excursion
     (goto-char (point-min))
     (let ((case-fold-search t)
          field-bodies)
   (save-excursion
     (goto-char (point-min))
     (let ((case-fold-search t)
          field-bodies)

-      (while (re-search-forward (concat "^\\(" regexp "\\):[ \t]*") nil t)
+      (while (re-search-forward (concat "^\\(" regexp "\\):[ \t]*")
+                               nil t)

        (push (funcall lsdb-decode-field-body-function
        (push (funcall lsdb-decode-field-body-function

-                      (buffer-substring (point) (std11-field-end))
-                      (match-string 1))
-             field-bodies))
+                            (buffer-substring (point) (std11-field-end))
+                            (match-string 1))
+                   field-bodies))

       (nreverse field-bodies))))
 
 (defun lsdb-canonicalize-spaces-and-dots (string)
       (nreverse field-bodies))))
 
 (defun lsdb-canonicalize-spaces-and-dots (string)

@@ -296,11 +312,16 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
 ;; stolen (and renamed) from nnheader.el
 (defun lsdb-decode-field-body (field-body field-name
                                          &optional mode max-column)
 ;; stolen (and renamed) from nnheader.el
 (defun lsdb-decode-field-body (field-body field-name
                                          &optional mode max-column)

-  (mime-decode-field-body field-body
-                         (if (stringp field-name)
-                             (intern (capitalize field-name))
-                           field-name)
-                         mode max-column))
+  (let ((multibyte enable-multibyte-characters))
+    (unwind-protect
+       (progn
+         (set-buffer-multibyte t)
+         (mime-decode-field-body field-body
+                                 (if (stringp field-name)
+                                     (intern (capitalize field-name))
+                                   field-name)
+                                 mode max-column))
+      (set-buffer-multibyte multibyte))))

 
 ;;;_. Record Management
 (defun lsdb-maybe-load-file ()
 
 ;;;_. Record Management
 (defun lsdb-maybe-load-file ()

@@ -321,27 +342,30 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
     (setq merged (lsdb-merge-record-entries old new)
          record (cons (nth 1 sender) merged))
     (unless (equal merged old)
     (setq merged (lsdb-merge-record-entries old new)
          record (cons (nth 1 sender) merged))
     (unless (equal merged old)

+      (let ((entry (assq 'last-modified (cdr record)))
+           (last-modified (format-time-string "%Y-%m-%d")))
+       (if entry
+           (setcdr entry last-modified)
+         (setcdr record (cons (cons 'last-modified last-modified)
+                              (cdr record)))))

       (lsdb-puthash (car record) (copy-sequence (cdr record))
                    lsdb-hash-table)
       (setq lsdb-hash-table-is-dirty t))
     record))
 
       (lsdb-puthash (car record) (copy-sequence (cdr record))
                    lsdb-hash-table)
       (setq lsdb-hash-table-is-dirty t))
     record))
 

-(defun lsdb-update-records (entity)
+(defun lsdb-update-records ()

   (lsdb-maybe-load-file)
   (let (senders recipients interesting alist records bodies entry)
   (lsdb-maybe-load-file)
   (let (senders recipients interesting alist records bodies entry)

-    (with-temp-buffer
-      (set-buffer-multibyte nil)
-      (buffer-disable-undo)
-      (mime-insert-entity entity)
+    (save-restriction

       (std11-narrow-to-header)
       (setq senders
            (delq nil (mapcar #'lsdb-extract-address-components
                              (lsdb-fetch-field-bodies
       (std11-narrow-to-header)
       (setq senders
            (delq nil (mapcar #'lsdb-extract-address-components
                              (lsdb-fetch-field-bodies

-                              entity lsdb-sender-headers)))
+                              lsdb-sender-headers)))

            recipients
            (delq nil (mapcar #'lsdb-extract-address-components
                              (lsdb-fetch-field-bodies
            recipients
            (delq nil (mapcar #'lsdb-extract-address-components
                              (lsdb-fetch-field-bodies

-                              entity lsdb-recipients-headers))))
+                              lsdb-recipients-headers))))

       (setq alist lsdb-interesting-header-alist)
       (while alist
        (setq bodies
       (setq alist lsdb-interesting-header-alist)
       (while alist
        (setq bodies

@@ -351,7 +375,7 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
                          (string-match (nth 1 (car alist)) field-body))
                     (replace-match (nth 3 (car alist)) nil nil field-body)
                   field-body))
                          (string-match (nth 1 (car alist)) field-body))
                     (replace-match (nth 3 (car alist)) nil nil field-body)
                   field-body))

-              (lsdb-fetch-field-bodies entity (car (car alist)))))
+              (lsdb-fetch-field-bodies (car (car alist)))))

        (when bodies
          (setq entry (or (nth 2 (car alist))
                          'notes))
        (when bodies
          (setq entry (or (nth 2 (car alist))
                          'notes))

@@ -495,16 +519,30 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
   (add-hook 'gnus-article-prepare-hook 'lsdb-gnus-update-record)
   (add-hook 'gnus-save-newsrc-hook 'lsdb-offer-save))
 
   (add-hook 'gnus-article-prepare-hook 'lsdb-gnus-update-record)
   (add-hook 'gnus-save-newsrc-hook 'lsdb-offer-save))
 

-(defvar message-mode-map)
-(defun lsdb-gnus-insinuate-message ()
-  "Call this function to hook LSDB into Message mode."
-  (define-key message-mode-map "\M-\t" 'lsdb-complete-name))
-

 (defvar gnus-current-headers)
 (defun lsdb-gnus-update-record ()
 (defvar gnus-current-headers)
 (defun lsdb-gnus-update-record ()

-  (let ((records (lsdb-update-records gnus-current-headers)))
-    (when records
-      (lsdb-display-record (car records)))))
+  (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))))))
+
+;;;_. Interface to Wanderlust
+(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-exit-hook 'lsdb-offer-save))
+
+(defun lsdb-wl-update-record ()
+  (save-excursion
+    (set-buffer (wl-message-get-original-buffer))
+    (let ((records (lsdb-update-records)))
+      (when records
+       (lsdb-display-record (car records))))))

 
 (provide 'lsdb)
 
 
 (provide 'lsdb)