From: ueno <ueno>
Date: Mon, 29 Apr 2002 16:51:40 +0000 (+0000)
Subject: * lsdb.el (lsdb-entry-type-alist): Add AKA.
X-Git-Tag: lsdb-0_4~6
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=08c1b506f74296191b6a73debf651758126d6add;p=elisp%2Flsdb.git

* lsdb.el (lsdb-entry-type-alist): Add AKA.
(lsdb-reverse-hash-table): New function.
(lsdb-hash-tables-are-dirty): Rename from lsdb-hash-table-is-dirty.
(lsdb-secondary-hash-table-start-format): New constant.
(lsdb-secondary-hash-table-start): New macro.
(lsdb-read): Splitted from lsdb-load-file.
(lsdb-load-hash-tables): New function.
(lsdb-insert-hash-table): New function.
(lsdb-save-hash-tables): Rename from lsdb-save-file.
(lsdb-maybe-build-reverse-hash-table): New function.
(lsdb-maybe-load-hash-tables): Rename from lsdb-maybe-load-file.
(lsdb-update-record): Look for the existing record from the reverse hash table.
---

diff --git a/lsdb.el b/lsdb.el
index 710aa19..929ac95 100644
--- a/lsdb.el
+++ b/lsdb.el
@@ -105,7 +105,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.
@@ -227,11 +228,15 @@ 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-reverse-hash-table 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)
@@ -296,44 +301,78 @@ 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")
+
+(defmacro 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)))))
+	(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."
+     (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)))
+    (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)))
+	  (if (re-search-forward
+	       (concat "^" (lsdb-secondary-hash-table-start
+			    lsdb-reverse-hash-table))
+	       nil t)
+	      (setq lsdb-reverse-hash-table (lsdb-read (point-marker)))))
+      (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))
-    (with-temp-file file
+    (with-temp-file lsdb-file
       (if (and (or (featurep 'mule)
 		   (featurep 'file-coding))
 	       lsdb-file-coding-system)
@@ -346,15 +385,10 @@ 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)
+      (insert "\n" (lsdb-secondary-hash-table-start
+		    lsdb-reverse-hash-table))
+      (lsdb-insert-hash-table lsdb-reverse-hash-table))))
 
 ;;;_. Mail Header Extraction
 (defun lsdb-fetch-field-bodies (regexp)
@@ -399,18 +433,39 @@ 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-maybe-build-reverse-hash-table ()
+  (unless lsdb-reverse-hash-table
+    (setq lsdb-reverse-hash-table (lsdb-make-hash-table :test 'equal))
+    (lsdb-maphash
+     (lambda (key value)
+       (let ((net (cdr (assq 'net value))))
+	 (while net
+	   (lsdb-puthash (pop net) key lsdb-reverse-hash-table))))
+     lsdb-hash-table))
+  (setq lsdb-hash-tables-are-dirty t))
+
+(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-maybe-build-reverse-hash-table)))
 
 (defun lsdb-update-record (sender &optional interesting)
   (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 (lsdb-gethash (nth 1 sender) lsdb-reverse-hash-table))
+      (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)))
@@ -425,11 +480,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))
+      (setq lsdb-hash-tables-are-dirty t))
+    (lsdb-puthash (nth 1 sender) (car sender) lsdb-reverse-hash-table)
     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)
@@ -567,7 +623,7 @@ This is the current number of slots in HASH-TABLE, whether occupied or not."
 (defun lsdb-complete-name ()
   "Complete the user full-name or net-address before point"
   (interactive)
-  (lsdb-maybe-load-file)
+  (lsdb-maybe-load-hash-tables)
   (let* ((start
 	  (save-excursion
 	    (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
@@ -794,7 +850,7 @@ 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)
+	      (setq lsdb-hash-tables-are-dirty t)
 	      (beginning-of-line 2)
 	      (add-text-properties
 	       (point)
@@ -816,7 +872,7 @@ 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))
+      (setq lsdb-hash-tables-are-dirty t))
     (save-restriction
       (lsdb-narrow-to-record)
       (let ((case-fold-search t)
@@ -853,7 +909,7 @@ the current record."
 		   (inhibit-read-only t)
 		   buffer-read-only)
 	      (setcdr entry form)
-	      (setq lsdb-hash-table-is-dirty t)
+	      (setq lsdb-hash-tables-are-dirty t)
 	      (lsdb-mode-delete-entry (symbol-name ',entry-name) t)
 	      (beginning-of-line)
 	      (add-text-properties
@@ -866,13 +922,13 @@ 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)
+      (lsdb-save-hash-tables)
+      (setq lsdb-hash-tables-are-dirty nil)
       (message "The LSDB was saved successfully."))))
 
 (defun lsdb-mode-quit-window (&optional kill window)
@@ -941,7 +997,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))))
@@ -1139,7 +1195,7 @@ of the buffer."
 				    (cdr (car records))))
 	(lsdb-puthash (car (car records)) (cdr (car records))
 		      lsdb-hash-table)
-	(setq lsdb-hash-table-is-dirty t)))))
+	(setq lsdb-hash-tables-are-dirty t)))))
 
 (defun lsdb-mu-get-prefix-method ()
   "A mu-cite method to return a prefix from LSDB or \">\".