cgit.sxemacs.org Git - riece/blob - lisp/riece-lsdb.el

   1 ;;; riece-lsdb.el --- help register nicknames in LSDB rolodex program
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; NOTE: This is an add-on module for Riece.
  28
  29 ;;; Code:
  30
  31 (require 'riece-identity)
  32
  33 (eval-when-compile
  34   (autoload 'lsdb-maybe-load-hash-tables "lsdb")
  35   (autoload 'lsdb-rebuild-secondary-hash-tables "lsdb")
  36   (autoload 'lsdb-lookup-records "lsdb")
  37   (autoload 'lsdb-puthash "lsdb")
  38   (autoload 'lsdb-maphash "lsdb")
  39   (autoload 'lsdb-gethash "lsdb")
  40   (autoload 'lsdb-display-records "lsdb")
  41   (autoload 'lsdb-update-record "lsdb"))
  42
  43 (defvar riece-lsdb-cache nil)
  44
  45 (defvar riece-lsdb-enabled nil)
  46
  47 (defconst riece-lsdb-description
  48   "Help register nicknames in LSDB rolodex program.")
  49
  50 (defun riece-lsdb-update-cache (record)
  51   (let ((irc (cdr (assq 'irc record))))
  52     (while irc
  53       (lsdb-puthash (car irc)
  54                     (cons (car record)
  55                           (lsdb-gethash (car irc) riece-lsdb-cache))
  56                     riece-lsdb-cache)
  57       (setq irc (cdr irc)))))
  58
  59 (defun riece-lsdb-delete-cache (record)
  60   (let ((irc (cdr (assq 'irc record))))
  61     (while irc
  62       (lsdb-puthash (car irc)
  63                     (delete (car record)
  64                             (lsdb-gethash (car irc) riece-lsdb-cache))
  65                     riece-lsdb-cache)
  66       (setq irc (cdr irc)))))
  67
  68 (defun riece-lsdb-lookup-records (user)
  69   (lsdb-maybe-load-hash-tables)
  70   (unless riece-lsdb-cache
  71     (lsdb-rebuild-secondary-hash-tables))
  72   (let ((names (lsdb-gethash (riece-format-identity user t)
  73                              riece-lsdb-cache))
  74         records)
  75     (while names
  76       (setq records (append records (lsdb-lookup-records (car names))))
  77       (setq names (cdr names)))
  78     records))
  79
  80 (defun riece-lsdb-display-records (user)
  81   (interactive
  82    (let ((completion-ignore-case t))
  83      (list (riece-completing-read-identity
  84             "User: "
  85             (riece-get-users-on-server (riece-current-server-name))))))
  86   (let ((records (riece-lsdb-lookup-records user)))
  87     (if records
  88         (lsdb-display-records records)
  89       (message "No entry for `%s'" (riece-format-identity user t)))))
  90
  91 (defvar lsdb-hash-table)
  92 (defun riece-lsdb-add-user (user full-name)
  93   (interactive
  94    (let ((completion-ignore-case t)
  95          (table lsdb-hash-table))
  96      (unless (vectorp table)
  97        (setq table (make-vector 29 0))
  98        (lsdb-maphash (lambda (key value)
  99                        (intern key table))
 100                      lsdb-hash-table))
 101      (list (riece-completing-read-identity
 102             "User: "
 103             (riece-get-users-on-server (riece-current-server-name)))
 104            (completing-read "Full name: " table))))
 105   (let* ((record (lsdb-gethash full-name lsdb-hash-table))
 106          (irc (riece-format-identity user t))
 107          (old (cdr (assq 'irc record))))
 108     ;; Remove all properties before adding entry.
 109     (set-text-properties 0 (length irc) nil irc)
 110     (unless (member irc old)
 111       (lsdb-update-record (list full-name
 112                                 ;; LSDB does not allow empty 'net entry.
 113                                 (or (nth 1 (assq 'net (lsdb-lookup-records
 114                                                        full-name)))
 115                                     ""))
 116                           (list (cons 'irc (cons irc old)))))))
 117
 118 (defvar riece-command-mode-map)
 119 (defvar lsdb-secondary-hash-tables)
 120 (defvar lsdb-after-update-record-functions)
 121 (defvar lsdb-after-delete-record-functions)
 122 (defun riece-lsdb-insinuate ()
 123   (require 'lsdb)
 124   (add-to-list 'lsdb-secondary-hash-tables
 125                'riece-lsdb-cache)
 126   (add-to-list 'lsdb-after-update-record-functions
 127                'riece-lsdb-update-cache)
 128   (add-to-list 'lsdb-after-delete-record-functions
 129                'riece-lsdb-delete-cache))
 130
 131 (defun riece-lsdb-uninstall ()
 132   (setq lsdb-secondary-hash-tables
 133         (delq 'riece-lsdb-cache lsdb-secondary-hash-tables)
 134         lsdb-after-update-record-functions
 135         (delq 'riece-lsdb-update-cache lsdb-after-update-record-functions)
 136         lsdb-after-delete-record-functions
 137         (delq 'riece-lsdb-delete-cache lsdb-after-delete-record-functions)))
 138
 139 (defun riece-lsdb-enable ()
 140   (define-key riece-command-mode-map
 141     "\C-c\C-ll" 'riece-lsdb-display-records)
 142   (define-key riece-command-mode-map
 143     "\C-c\C-la" 'riece-lsdb-add-user)
 144   (setq riece-lsdb-enabled t))
 145
 146 (defun riece-lsdb-disable ()
 147   (define-key riece-command-mode-map
 148     "\C-c\C-ll" nil)
 149   (define-key riece-command-mode-map
 150     "\C-c\C-la" nil)
 151   (setq riece-lsdb-enabled nil))
 152
 153 (provide 'riece-lsdb)
 154
 155 ;;; riece-lsdb.el ends here