;;; (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)
;;; (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-toggle-buffer)))
;;; For Mew, put the following lines into your ~/.mew:
;;; (autoload 'lsdb-mew-insinuate "lsdb")
;;; (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 ":" 'lsdb-toggle-buffer)))
;;; Code:
(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))
(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)
+ (www 4)
+ (aka 4 ?,)
(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)
:group 'lsdb
:type 'function)
+(defcustom lsdb-lookup-full-name-functions
+ '(lsdb-lookup-full-name-from-address-cache)
+ "List of functions to pick up the existing full-name of the sender.
+The sender is passed to each function as the argument."
+ :group 'lsdb
+ :type 'hook)
+
+(defcustom lsdb-update-record-functions
+ '(lsdb-update-address-cache)
+ "List of functions called after a record is updated.
+The updated 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"
+ :group 'lsdb
+ :type 'list)
+
(defcustom lsdb-window-max-height 7
"Maximum number of lines used to display LSDB record."
:group 'lsdb
"A predicate to sort records."
:group 'lsdb
:type 'function)
-
+
+(defcustom lsdb-pop-up-windows t
+ "Non-nil means LSDB should make new windows to display records."
+ :group 'lsdb
+ :type 'boolean)
+
(defgroup lsdb-edit-form nil
"A mode for editing forms."
:group 'lsdb)
(defvar lsdb-hash-table nil
"Internal hash table to hold LSDB records.")
+(defvar lsdb-address-cache 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)
"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)))
(list 0 (make-vector (or (plist-get args :size) 29) 0))))
;;;_. Hash Table Reader/Writer
+(defconst lsdb-secondary-hash-table-start-format
+ ";;; %S\n")
+
+(defsubst 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."
- (let ((coding-system-for-write lsdb-file-coding-system))
- (with-temp-file 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))
+ tables)
+ (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)))
+ ;; Load the secondary hash tables following.
+ (setq tables lsdb-secondary-hash-tables)
+ (while tables
+ (if (re-search-forward
+ (concat "^" (lsdb-secondary-hash-table-start
+ (car tables)))
+ nil t)
+ (set (car tables) (lsdb-read (point-marker))))
+ (setq tables (cdr tables))))
+ (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)
+ tables)
+ (with-temp-file lsdb-file
(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"))
- (insert "#s(hash-table size "
- (number-to-string (lsdb-hash-table-size hash-table))
- " test equal data (")
- (lsdb-maphash
- (lambda (key value)
- (insert (prin1-to-string key) " " (prin1-to-string value) " "))
- hash-table)
- (insert "))"))))
+ (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"))))
+ (lsdb-insert-hash-table lsdb-hash-table)
+ ;; Save the secondary hash tables following.
+ (setq tables lsdb-secondary-hash-tables)
+ (while tables
+ (insert "\n" (lsdb-secondary-hash-table-start
+ (car tables)))
+ (lsdb-insert-hash-table (symbol-value (car tables)))
+ (setq tables (cdr tables))))))
;;;_. Mail Header Extraction
(defun lsdb-fetch-field-bodies (regexp)
(let ((components (std11-extract-address-components string)))
(if (nth 1 components)
(if (car components)
- (list (nth 1 components)
- (funcall lsdb-canonicalize-full-name-function
- (car components)))
+ (list (funcall lsdb-canonicalize-full-name-function
+ (car components))
+ (nth 1 components))
(list (nth 1 components) (nth 1 components))))))
;; stolen (and renamed) from nnheader.el
(set-buffer-multibyte multibyte))))
;;;_. Record Management
-(defun lsdb-maybe-load-file ()
+(defun lsdb-maybe-load-secondary-hash-tables ()
+ (let ((tables lsdb-secondary-hash-tables))
+ (while tables
+ (unless (symbol-value (car tables))
+ (set (car tables) (lsdb-make-hash-table :test 'equal))
+ (lsdb-maphash
+ (lambda (key value)
+ (run-hook-with-args
+ 'lsdb-update-record-functions
+ (cons key value)))
+ lsdb-hash-table)
+ (setq lsdb-hash-tables-are-dirty t))
+ (setq tables (cdr tables)))))
+
+(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-load-secondary-hash-tables)))
+
+;;;_ : Fallback Lookup Functions
+;;;_ , #1 Address Cache
+(defun lsdb-lookup-full-name-from-address-cache (sender)
+ (lsdb-gethash (nth 1 sender) lsdb-address-cache))
+
+(defun lsdb-update-address-cache (record)
+ (let ((net (cdr (assq 'net record))))
+ (while net
+ (lsdb-puthash (pop net) (car record) lsdb-address-cache))))
+
+;;;_ , #2 Iterate on the All Records (very slow)
+(defun lsdb-lookup-full-name-by-fuzzy-matching (sender)
+ (let ((names
+ (if (string-match
+ "\\`\\(.+\\)[ \t]+\\(/[ \t]+\\|(\\([^)]+\\))\\)"
+ (car sender))
+ (if (match-beginning 3)
+ (list (match-string 1 (car sender))
+ (match-string 3 (car sender)))
+ (list (match-string 1 (car sender))
+ (substring (car sender) (match-end 0))))
+ (list (car sender))))
+ (case-fold-search t))
+ (catch 'found
+ (lsdb-maphash
+ (lambda (key value)
+ (while names
+ (if (or (string-match
+ (concat "\\<" (regexp-quote (car names)) "\\>")
+ key)
+ (string-match
+ (concat
+ "\\<"
+ (regexp-quote
+ (mapconcat #'identity
+ (nreverse (split-string (car names)))
+ " "))
+ "\\>")
+ key)
+ ;; Don't assume that we are using address cache.
+ (member (nth 1 sender) (cdr (assq 'net value))))
+ (throw 'found key))
+ (setq names (cdr names))))
+ lsdb-hash-table))))
+
+;;;_ : Update Records
(defun lsdb-update-record (sender &optional interesting)
- (let ((old (lsdb-gethash (nth 1 sender) lsdb-hash-table))
- (new (cons (cons 'net (list (car sender)))
+ (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
+ (run-hook-with-args-until-success
+ 'lsdb-lookup-full-name-functions
+ sender))
+ (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)))
(setq merged (lsdb-merge-record-entries old new)
- record (cons (nth 1 sender) merged))
+ record (cons (car sender) merged))
(unless (equal merged old)
(let ((entry (assq 'last-modified (cdr record)))
(last-modified (format-time-string "%Y-%m-%d")))
(cdr record)))))
(lsdb-puthash (car record) (cdr record)
lsdb-hash-table)
- (setq lsdb-hash-table-is-dirty t))
+ (run-hook-with-args 'lsdb-update-record-functions record)
+ (setq lsdb-hash-tables-are-dirty t))
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)
(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))
old)
;;;_. Display Management
-(defun lsdb-temp-buffer-show-function (buffer)
+(defun lsdb-fit-window-to-buffer (&optional window)
(save-selected-window
- (let ((window (or (get-buffer-window lsdb-buffer-name)
- (progn
- (select-window (get-largest-window))
- (split-window-vertically))))
- height)
- (set-window-buffer window buffer)
- (select-window window)
- (unless (pos-visible-in-window-p (point-max))
- (enlarge-window (- lsdb-window-max-height (window-height))))
- (shrink-window-if-larger-than-buffer)
- (if (> (setq height (window-height))
- lsdb-window-max-height)
+ (if window
+ (select-window window))
+ (unless (pos-visible-in-window-p (point-max))
+ (enlarge-window (- lsdb-window-max-height (window-height))))
+ (shrink-window-if-larger-than-buffer)
+ (let ((height (window-height)))
+ (if (> height lsdb-window-max-height)
(shrink-window (- height lsdb-window-max-height)))
(set-window-start window (point-min)))))
+(defun lsdb-temp-buffer-show-function (buffer)
+ (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."
- (let ((temp-buffer-show-function
- (function lsdb-temp-buffer-show-function)))
+ (let ((temp-buffer-show-function lsdb-temp-buffer-show-function))
(lsdb-display-records (list record))))
(defun lsdb-display-records (records)
(defvar lsdb-last-candidates nil)
(defvar lsdb-last-candidates-pointer nil)
+;;;_ : Matching Highlight
+(defvar lsdb-last-highlight-overlay nil)
+
+(defun lsdb-complete-name-highlight (start end)
+ (make-local-hook 'pre-command-hook)
+ (add-hook 'pre-command-hook 'lsdb-complete-name-highlight-update nil t)
+ (save-excursion
+ (goto-char start)
+ (search-forward lsdb-last-completion end)
+ (setq lsdb-last-highlight-overlay
+ (make-overlay (match-beginning 0) (match-end 0)))
+ (overlay-put lsdb-last-highlight-overlay 'face
+ (or (find-face 'isearch-secondary)
+ (find-face 'isearch-lazy-highlight-face)
+ 'underline))))
+
+(defun lsdb-complete-name-highlight-update ()
+ (unless (eq 'this-command 'lsdb-complete-name)
+ (if lsdb-last-highlight-overlay
+ (delete-overlay lsdb-last-highlight-overlay))
+ (remove-hook 'pre-command-hook
+ 'lsdb-complete-name-highlight-update t)))
+
+;;;_ : Name Completion
(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]*")
(setq lsdb-last-candidates nil
lsdb-last-candidates-pointer nil
lsdb-last-completion (buffer-substring start (point))
- pattern (concat "\\<" lsdb-last-completion))
+ pattern (concat "\\<" (regexp-quote lsdb-last-completion)))
(lsdb-maphash
(lambda (key value)
(let ((net (cdr (assq 'net value))))
(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
(delete-region start (point))
- (insert (pop lsdb-last-candidates-pointer)))))
+ (insert (pop lsdb-last-candidates-pointer))
+ (lsdb-complete-name-highlight start (point)))))
;;;_. Major Mode (`lsdb-mode') Implementation
;;;_ : Modeline Buffer Identification
(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)
(set (make-local-variable 'font-lock-defaults)
'(lsdb-font-lock-keywords t)))
- (make-local-variable 'post-command-hook)
- (setq post-command-hook 'lsdb-modeline-update)
+ (make-local-hook 'post-command-hook)
+ (add-hook 'post-command-hook 'lsdb-modeline-update nil t)
(make-local-variable 'lsdb-modeline-string)
(setq mode-line-buffer-identification
(lsdb-modeline-buffer-identification
(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)
+ (run-hook-with-args 'lsdb-update-record-functions record)
+ (setq lsdb-hash-tables-are-dirty t)
(beginning-of-line 2)
(add-text-properties
(point)
(setcdr record (delq entry (cdr record)))
(lsdb-puthash (car record) (cdr record)
lsdb-hash-table)
- (setq lsdb-hash-table-is-dirty t))
+ (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)
(setcdr entry form)
- (setq lsdb-hash-table-is-dirty t)
+ (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
(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)
(kill-buffer buffer)
(bury-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-show-buffer ()
+ "Show the LSDB window."
+ (if (get-buffer lsdb-buffer-name)
+ (if lsdb-temp-buffer-show-function
+ (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.
If the optional 2nd argument ENTRY-NAME is given, matching only
"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))))
(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-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-show-buffer)
(add-hook 'wl-exit-hook 'lsdb-mode-save)
(add-hook 'wl-save-hook 'lsdb-mode-save))
(set-buffer (wl-message-get-original-buffer))
(let ((records (lsdb-update-records)))
(when records
- (lsdb-display-record (car records))))))
+ (let ((lsdb-temp-buffer-show-function
+ #'lsdb-wl-temp-buffer-show-function))
+ (lsdb-display-record (car records)))))))
+
+(defvar wl-current-summary-buffer)
+(defvar wl-message-buffer)
+(defun lsdb-wl-temp-buffer-show-function (buffer)
+ (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@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 ()
(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))
(cdr (car records))))
(lsdb-puthash (car (car records)) (cdr (car records))
lsdb-hash-table)
- (setq lsdb-hash-table-is-dirty t)))))
+ (run-hook-with-args 'lsdb-update-record-functions (car records))
+ (setq lsdb-hash-tables-are-dirty t)))))
(defun lsdb-mu-get-prefix-method ()
"A mu-cite method to return a prefix from LSDB or \">\".
x-face)
(goto-char (point-min))
(end-of-line)
- (put-text-property 0 1 'invisible t delimiter)
- (put-text-property 0 (length delimiter) 'lsdb-record record delimiter)
- (insert delimiter)
- (while x-face
- (funcall lsdb-insert-x-face-function (pop x-face))))))
+ (put-text-property 0 1 'invisible t delimiter) ;hide "\r"
+ (put-text-property
+ (point)
+ (progn
+ (insert delimiter)
+ (while x-face
+ (funcall lsdb-insert-x-face-function (pop x-face)))
+ (point))
+ 'lsdb-record record))))
(defun lsdb-insert-x-face-image (data type marker)
(static-if (featurep 'xemacs)
(provide 'lsdb)
(product-provide 'lsdb
- (product-define "LSDB" nil '(0 2)))
+ (product-define "LSDB" nil '(0 5)))
;;;_* Local emacs vars.
;;; The following `outline-layout' local variable setting:
projects / elisp / lsdb.git / blobdiff