* lsdb.el (lsdb-interesting-header-alist): Ass List-Id, X-Sequence,

[elisp/lsdb.git] / lsdb.el

diff --git a/lsdb.el b/lsdb.el
index 90b3761..106b56c 100644 (file)
--- a/lsdb.el
+++ b/lsdb.el
@@ -83,8 +83,11 @@
 
 (defcustom lsdb-interesting-header-alist
   '(("Organization" nil organization)
-    ("\\(X-\\)?User-Agent\\|X-Mailer" nil user-agent)
+    ("\\(X-\\)?User-Agent\\|X-Mailer\\|X-Newsreader" nil user-agent)
     ("\\(X-\\)?ML-Name" nil mailing-list)
+    ("List-Id" "\\(.*\\)[ \t]+<[^>]+>\\'" mailing-list "\\1")
+    ("X-Sequence" "\\(.*\\)[ \t]+[0-9]+\\'" mailing-list "\\1")
+    ("Delivered-To" "mailing list[ \t]+\\([^@]+\\)@.*" mailing-list "\\1")
     ("\\(X-URL\\|X-URI\\)" nil www)
     ("X-Attribution\\|X-cite-me" nil attribution)
     ("X-Face" nil x-face))
@@ -97,18 +100,24 @@ where the last three elements are optional."
 
 (defcustom lsdb-entry-type-alist
   '((net 5 ?,)
-    (creation-date 2)
-    (last-modified 3)
+    (creation-date 2 ?. t)
+    (last-modified 3 ?. t)
     (mailing-list 4 ?,)
     (attribution 4 ?.)
     (organization 4)
     (www 1)
     (score -1)
     (x-face -1))
-  "Alist of entries to display.
+  "Alist of entry types for presentation.
 The format of elements of this list should be
-     (ENTRY SCORE CLASS)
-where the last element is optional."
+     (ENTRY SCORE [CLASS READ-ONLY])
+where the last two elements are optional.
+Possible values for CLASS are `?.' and '?,'.  If CLASS is `?.', the
+entry takes a unique value which is overridden by newly assigned one
+by `lsdb-mode-edit-entry' or such a command.  If CLASS is `?,', the
+entry can have multiple values separated by commas.
+If the fourth element READ-ONLY is non-nil, it is assumed that the
+entry cannot be modified."
   :group 'lsdb
   :type 'list)
 
@@ -328,14 +337,18 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
       (if (and (or (featurep 'mule)
                   (featurep 'file-coding))
               lsdb-file-coding-system)
-         (insert ";;; -*- coding: "
-                 (if (symbolp lsdb-file-coding-system)
-                     (symbol-name lsdb-file-coding-system)
-                   ;; XEmacs
-                   (symbol-name (coding-system-name lsdb-file-coding-system)))
-                 " -*-\n"))
+         (let ((coding-system-name
+                (if (symbolp lsdb-file-coding-system)
+                    (symbol-name lsdb-file-coding-system)
+                  ;; XEmacs
+                  (static-if (featurep 'xemacs)
+                      (symbol-name (coding-system-name
+                                    lsdb-file-coding-system))))))
+           (if coding-system-name
+               (insert ";;; -*- coding: " coding-system-name " -*-\n"))))
       (insert "#s(hash-table size "
-             (number-to-string (lsdb-hash-table-size hash-table))
+             ;; 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)
@@ -431,13 +444,15 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
       (setq alist lsdb-interesting-header-alist)
       (while alist
        (setq bodies
-             (mapcar
-              (lambda (field-body)
-                (if (and (nth 1 (car alist))
-                         (string-match (nth 1 (car alist)) field-body))
-                    (replace-match (nth 3 (car alist)) nil nil field-body)
-                  field-body))
-              (lsdb-fetch-field-bodies (car (car alist)))))
+             (delq nil (mapcar
+                        (lambda (field-body)
+                          (if (nth 1 (car alist))
+                              (and (string-match (nth 1 (car alist))
+                                                 field-body)
+                                   (replace-match (nth 3 (car alist))
+                                                  nil nil field-body))
+                            field-body))
+                        (lsdb-fetch-field-bodies (car (car alist))))))
        (when bodies
          (setq entry (or (nth 2 (car alist))
                          'notes))
@@ -581,7 +596,15 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
               (if (string-match pattern (car net))
                   (push (car net) lsdb-last-candidates))
               (setq net (cdr net))))))
-       lsdb-hash-table))
+       lsdb-hash-table)
+      ;; Sort candidates by the position where the pattern occurred.
+      (setq lsdb-last-candidates
+           (sort lsdb-last-candidates
+                 (lambda (cand1 cand2)
+                   (< (if (string-match pattern cand1)
+                          (match-beginning 0))
+                      (if (string-match pattern cand2)
+                          (match-beginning 0)))))))
     (unless lsdb-last-candidates-pointer
       (setq lsdb-last-candidates-pointer lsdb-last-candidates))
     (when lsdb-last-candidates-pointer
@@ -686,7 +709,7 @@ Modify whole identification by side effect."
 (define-derived-mode lsdb-mode fundamental-mode "LSDB"
   "Major mode for browsing LSDB records."
   (setq buffer-read-only t)
-  (if (featurep 'xemacs)
+  (static-if (featurep 'xemacs)
       ;; In XEmacs, setting `font-lock-defaults' only affects on
       ;; `find-file-hooks'.
       (font-lock-set-defaults)
@@ -1059,7 +1082,11 @@ of the buffer."
 
 ;;;_. Interface to Mew written by Hideyuki SHIRAI <shirai@rdmg.mgcs.mei.co.jp>
 (eval-when-compile
-  (ignore-errors (require 'mew)))
+  (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
 (defun lsdb-mew-insinuate ()