;;; (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-wl-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 "l" 'lsdb-toggle-buffer)))
;;; Code:
(attribution 4 ?.)
(organization 4)
(www 4)
- (aka 4)
+ (aka 4 ?,)
(score -1)
(x-face -1))
"Alist of entry types for presentation.
: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"))
"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)
(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)))
(defun lsdb-extract-address-components (string)
(let ((components (std11-extract-address-components string)))
- (if (nth 1 components)
+ (if (and (nth 1 components)
+ ;; When parsing a group address,
+ ;; std11-extract-address-components is likely to return
+ ;; the ("GROUP" "") form.
+ (not (equal (nth 1 components) "")))
(if (car components)
(list (funcall lsdb-canonicalize-full-name-function
(car components))
(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)
(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
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-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)
(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)
+ (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)))
"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))
(define-key keymap "a" 'lsdb-mode-add-entry)
(define-key keymap "d" 'lsdb-mode-delete-entry)
(define-key keymap "e" 'lsdb-mode-edit-entry)
+ (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)
(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))))
(message "(No changes need to be saved)")
(when (or (interactive-p)
dont-ask
- (y-or-n-p "Save the LSDB now?"))
+ (y-or-n-p "Save the LSDB now? "))
(lsdb-save-hash-tables)
(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'."
(delete-window window))
(if kill
(kill-buffer buffer)
- (bury-buffer buffer))))
+ (bury-buffer (unless (eq buffer (current-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
(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-wl-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))))))
-
-;;;_. Interface to Mew written by Hideyuki SHIRAI <shirai@rdmg.mgcs.mei.co.jp>
+ (let ((lsdb-temp-buffer-show-function
+ #'lsdb-wl-temp-buffer-show-function))
+ (lsdb-display-record (car records)))))))
+
+(defun lsdb-wl-toggle-buffer (&optional arg)
+ "Toggle hiding of the LSDB window for Wanderlust.
+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)))
+ (let ((lsdb-temp-buffer-show-function
+ #'lsdb-wl-temp-buffer-show-function))
+ (lsdb-toggle-buffer arg)))
+
+(defun lsdb-wl-show-buffer ()
+ (when lsdb-pop-up-windows
+ (let ((lsdb-temp-buffer-show-function
+ #'lsdb-wl-temp-buffer-show-function))
+ (lsdb-show-buffer))))
+
+(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@meadowy.org>
(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"))
+ (autoload 'mew-cache-hit "mew")
+ (autoload 'mew-xinfo-get-decode-err "mew")
+ (autoload 'mew-xinfo-get-action "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))
+ (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))
+ (cache (mew-cache-hit fld msg))
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))))))
+ (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))
+ (when (setq records (lsdb-update-records))
+ (lsdb-display-record (car records))))))))
;;;_. Interface to MU-CITE
(eval-when-compile
'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)
(provide 'lsdb)
(product-provide 'lsdb
- (product-define "LSDB" nil '(0 2)))
+ (product-define "LSDB" nil '(0 7)))
;;;_* Local emacs vars.
;;; The following `outline-layout' local variable setting:
projects / elisp / lsdb.git / blobdiff