X-Git-Url: http://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-lsdb.el;h=22bbbeda0f86af0424c84b66774e70ae5feff33d;hp=1566ec3663d7391fc5217873a4c020a2df108526;hb=b9f6bafab554195060ad18cb5fa66620da210f09;hpb=a4172314ca68caab7e2cef48323d0e296141b18d diff --git a/lisp/riece-lsdb.el b/lisp/riece-lsdb.el index 1566ec3..22bbbed 100644 --- a/lisp/riece-lsdb.el +++ b/lisp/riece-lsdb.el @@ -1,4 +1,4 @@ -;;; riece-lsdb.el --- interface to LSDB +;;; riece-lsdb.el --- help register nicknames in LSDB rolodex program ;; Copyright (C) 1998-2003 Daiki Ueno ;; Author: Daiki Ueno @@ -19,44 +19,62 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: -;; To use, add the following line to your ~/.riece/init.el: -;; (add-to-list 'riece-addons 'riece-lsdb) +;; NOTE: This is an add-on module for Riece. ;;; Code: +(require 'riece-identity) +(require 'riece-misc) + (eval-when-compile (autoload 'lsdb-maybe-load-hash-tables "lsdb") + (autoload 'lsdb-rebuild-secondary-hash-tables "lsdb") (autoload 'lsdb-lookup-records "lsdb") (autoload 'lsdb-puthash "lsdb") - (autoload 'lsdb-remhash "lsdb") + (autoload 'lsdb-maphash "lsdb") (autoload 'lsdb-gethash "lsdb") - (autoload 'lsdb-display-records "lsdb")) + (autoload 'lsdb-display-records "lsdb") + (autoload 'lsdb-update-record "lsdb")) (defvar riece-lsdb-cache nil) +(defconst riece-lsdb-description + "Help register nicknames in LSDB rolodex program.") + (defun riece-lsdb-update-cache (record) (let ((irc (cdr (assq 'irc record)))) (while irc - (lsdb-puthash (car irc) (car record) riece-lsdb-cache) + (lsdb-puthash (car irc) + (cons (car record) + (lsdb-gethash (car irc) riece-lsdb-cache)) + riece-lsdb-cache) (setq irc (cdr irc))))) (defun riece-lsdb-delete-cache (record) (let ((irc (cdr (assq 'irc record)))) (while irc - (lsdb-remhash (car irc) riece-lsdb-cache) + (lsdb-puthash (car irc) + (delete (car record) + (lsdb-gethash (car irc) riece-lsdb-cache)) + riece-lsdb-cache) (setq irc (cdr irc))))) (defun riece-lsdb-lookup-records (user) (lsdb-maybe-load-hash-tables) - (let ((name (lsdb-gethash (riece-format-identity user t) - riece-lsdb-cache))) - (if name - (lsdb-lookup-records name)))) + (unless riece-lsdb-cache + (lsdb-rebuild-secondary-hash-tables)) + (let ((names (lsdb-gethash (riece-format-identity user t) + riece-lsdb-cache)) + records) + (while names + (setq records (append records (lsdb-lookup-records (car names)))) + (setq names (cdr names))) + records)) (defun riece-lsdb-display-records (user) (interactive @@ -69,6 +87,37 @@ (lsdb-display-records records) (message "No entry for `%s'" (riece-format-identity user t))))) +(defvar lsdb-hash-table) +(defun riece-lsdb-add-user (user full-name) + (interactive + (let ((completion-ignore-case t) + (table lsdb-hash-table)) + (unless (vectorp table) + (setq table (make-vector 29 0)) + (lsdb-maphash (lambda (key value) + (intern key table)) + lsdb-hash-table)) + (list (riece-completing-read-identity + "User: " + (riece-get-users-on-server (riece-current-server-name))) + (completing-read "Full name: " table)))) + (let* ((record (lsdb-gethash full-name lsdb-hash-table)) + (irc (riece-format-identity user t)) + (old (cdr (assq 'irc record)))) + ;; Remove all properties before adding entry. + (set-text-properties 0 (length irc) nil irc) + (unless (member irc old) + (lsdb-update-record (list full-name + ;; LSDB does not allow empty 'net entry. + (or (nth 1 (assq 'net (lsdb-lookup-records + full-name))) + "")) + (list (cons 'irc (cons irc old))))))) + +(defvar riece-command-mode-map) +(defvar lsdb-secondary-hash-tables) +(defvar lsdb-after-update-record-functions) +(defvar lsdb-after-delete-record-functions) (defun riece-lsdb-insinuate () (require 'lsdb) (add-to-list 'lsdb-secondary-hash-tables @@ -76,9 +125,27 @@ (add-to-list 'lsdb-after-update-record-functions 'riece-lsdb-update-cache) (add-to-list 'lsdb-after-delete-record-functions - 'riece-lsdb-delete-cache) + 'riece-lsdb-delete-cache)) + +(defun riece-lsdb-uninstall () + (setq lsdb-secondary-hash-tables + (delq 'riece-lsdb-cache lsdb-secondary-hash-tables) + lsdb-after-update-record-functions + (delq 'riece-lsdb-update-cache lsdb-after-update-record-functions) + lsdb-after-delete-record-functions + (delq 'riece-lsdb-delete-cache lsdb-after-delete-record-functions))) + +(defun riece-lsdb-enable () + (define-key riece-command-mode-map + "\C-c\C-ll" 'riece-lsdb-display-records) + (define-key riece-command-mode-map + "\C-c\C-la" 'riece-lsdb-add-user)) + +(defun riece-lsdb-disable () + (define-key riece-command-mode-map + "\C-c\C-ll" nil) (define-key riece-command-mode-map - "\C-cL" 'riece-lsdb-display-records)) + "\C-c\C-la" nil)) (provide 'riece-lsdb)