mu-register.el

   1 ;;;
   2 ;;; mu-register.el --- `register' function for mu-cite.
   3 ;;;
   4 ;;; Copyright (C) 1995 MINOURA Makoto
   5 ;;;
   6 ;;; Author: MINOURA Makoto <minoura@leo.bekkoame.or.jp>
   7 ;;;         modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;; Created: 1995/12/27 by MINOURA Makoto <minoura@leo.bekkoame.or.jp>
   9 ;;; Version:
  10 ;;;     $Id: mu-register.el,v 1.9 1996-01-16 14:04:24 morioka Exp $
  11 ;;;
  12 ;;; This file is part of tl (Tiny Library).
  13 ;;;
  14 ;;; This program is free software; you can redistribute it and/or
  15 ;;; modify it under the terms of the GNU General Public License as
  16 ;;; published by the Free Software Foundation; either version 2, or
  17 ;;; (at your option) any later version.
  18 ;;;
  19 ;;; This program is distributed in the hope that it will be useful,
  20 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;;; General Public License for more details.
  23 ;;;
  24 ;;; You should have received a copy of the GNU General Public License
  25 ;;; along with This program.  If not, write to the Free Software
  26 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27
  28 ;;; Commentary:
  29 ;;;
  30 ;;; - How to install.
  31 ;;;   1. bytecompile this file and copy it to the apropriate directory.
  32 ;;;   2. put the following lines to your .emacs.
  33 ;;;     (add-hook 'mu-cite-load-hook
  34 ;;;                (function
  35 ;;;                 (lambda ()
  36 ;;;                   (require 'mu-register))))
  37 ;;;   3. you can use the keyword `registered' in your
  38 ;;;    mu-cite/top-form and mu-cite/prefix-form, for example:
  39 ;;;     (setq mu-cite/prefix-format (list 'registered "> "))
  40 ;;;
  41 ;;; - ChangeLog.
  42 ;;;   Wed Dec 27 14:28:17 1995  MINOURA Makoto <minoura@leo.bekkoame.or.jp>
  43 ;;;
  44 ;;;     * Written.
  45 ;;;
  46 \f
  47 ;;; Code:
  48
  49 (require 'mu-cite)
  50 (require 'pp)
  51
  52
  53 ;;; @ variables
  54 ;;;
  55
  56 (defvar mu-register/registration-file
  57   (expand-file-name "~/.mu-register")
  58   "*The name of the user environment file for mu-register.")
  59
  60 (defvar mu-register/registration-symbol 'mu-register/citation-name-alist)
  61
  62 (defvar mu-register/citation-name-alist nil)
  63 (load mu-register/registration-file t t t)
  64 (or (eq 'mu-register/citation-name-alist mu-register/registration-symbol)
  65     (setq mu-register/citation-name-alist
  66           (symbol-value mu-register/registration-symbol))
  67     )
  68 (defvar mu-register/minibuffer-history nil)
  69
  70
  71 ;;; @ database accessers
  72 ;;;
  73
  74 ;; get citation-name from the database
  75 (defmacro mu-register/get-citation-name (from)
  76   (` (cdr (assoc (, from) mu-register/citation-name-alist))))
  77
  78 ;; register citation-name to the database
  79 (defun mu-register/add-citation-name (name from)
  80   (let* ((elt (assoc from mu-register/citation-name-alist)))
  81     (if elt
  82         (setq mu-register/citation-name-alist
  83               (delq elt mu-register/citation-name-alist)))
  84     (setq elt (cons from name))
  85     (setq mu-register/citation-name-alist
  86           (cons elt
  87                 mu-register/citation-name-alist))
  88     (mu-register/save-to-file)
  89     ))
  90
  91 ;; save to file
  92 (defun mu-register/save-to-file ()
  93   (let* ((filename mu-register/registration-file)
  94          (buffer (get-buffer-create " *mu-register*")))
  95     (save-excursion
  96       (set-buffer buffer)
  97       (setq buffer-file-name filename)
  98       (erase-buffer)
  99       (insert ";; generated automatically by mu-register.\n")
 100       (insert (format "(setq %s
 101  '(" mu-register/registration-symbol))
 102       (insert (mapconcat
 103                (function prin1-to-string)
 104                mu-register/citation-name-alist "\n   "))
 105       (insert "\n   ))\n")
 106       (save-buffer))
 107     (kill-buffer buffer)))
 108
 109
 110 ;;; @ main functions
 111 ;;;
 112
 113 (defun mu-register/citation-name ()
 114   (let* ((from
 115           (rfc822/address-string
 116            (car (rfc822/parse-address
 117                  (rfc822/lexical-analyze
 118                   (mu-cite/get-value 'from))))))
 119          (fullname (mu-cite/get-value 'full-name))
 120          (return1
 121           (mu-register/get-citation-name from))
 122          (return))
 123     (if (null return1)
 124         (setq return1 fullname))
 125     (setq return
 126           (read-string "Citation name? "
 127                        return1
 128                        'mu-register/minibuffer-history))
 129     (if (not (string-equal return return1))
 130         (let ((ans)
 131               (cursor-in-echo-area t))
 132           (while (null ans)
 133             (message (format "Register \"%s\" (y/n)? " return))
 134             (setq ans (read-event))
 135             (if (not (or (eq ans ?y)
 136                          (eq ans ?n)))
 137                 (setq ans nil)))
 138           (message "")
 139           (if (eq ans ?y)
 140               (mu-register/add-citation-name return from))))
 141     return))
 142
 143 (defun mu-register/citation-name-quietly ()
 144   (let* ((from
 145           (rfc822/address-string
 146            (car (rfc822/parse-address
 147                  (rfc822/lexical-analyze
 148                   (mu-cite/get-value 'from))))))
 149          (fullname (mu-cite/get-value 'full-name))
 150          (return1
 151           (mu-register/get-citation-name from))
 152          return)
 153     (if (null return1)
 154         (progn
 155           (setq return
 156                 (read-string "Citation name? "
 157                              fullname
 158                              'mu-register/minibuffer-history))
 159
 160           (if (not (string-equal return return1))
 161               (let ((ans)
 162                     (cursor-in-echo-area t))
 163                 (while (null ans)
 164                   (message (format "Register \"%s\" (y/n)? " return))
 165                   (setq ans (read-event))
 166                   (if (not (or (eq ans ?y)
 167                                (eq ans ?n)))
 168                       (setq ans nil)))
 169                 (message "")
 170                 (if (eq ans ?y)
 171                     (mu-register/add-citation-name return from)
 172                   )
 173                 ))
 174           )
 175       (setq return return1)
 176       )
 177     return))
 178
 179 \f
 180
 181 ;;; @ Installation
 182 ;;;
 183
 184 (set-alist 'mu-cite/default-methods-alist
 185            'prefix-register
 186            (function mu-register/citation-name-quietly))
 187 (set-alist 'mu-cite/default-methods-alist
 188            'prefix-register-verbose
 189            (function mu-register/citation-name))
 190
 191
 192 ;;; @ end
 193 ;;;
 194
 195 (provide 'mu-register)
 196
 197 ;;; mu-register.el ends here