mu-register.el

   1 ;;; mu-register.el --- registration feature of mu-cite
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MINOURA Makoto <minoura@netlaputa.or.jp>
   6 ;;         MORIOKA Tomohiko <tomo@m17n.org>
   7 ;;; Created: 1995-12-27 by MINOURA Makoto
   8 ;; Maintainer: Katsumi Yamaoka <yamaoka@jpl.org>
   9 ;; Keywords: registration, citation, mail, news
  10
  11 ;; This file is part of MU (Message Utilities).
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Code:
  29
  30 (require 'mu-cite)
  31
  32
  33 ;;; @ variables
  34 ;;;
  35
  36 (defcustom mu-registration-file (expand-file-name "~/.mu-cite.el")
  37   "The name of the user environment file for mu-cite."
  38   :type 'file
  39   :group 'mu-cite)
  40
  41 (defcustom mu-registration-file-modes 384
  42   "Mode bits of `mu-registration-file', as an integer."
  43   :type 'integer
  44   :group 'mu-cite)
  45
  46 (defcustom mu-registration-file-coding-system-for-read nil
  47   "Coding system used when reading a registration file."
  48   :group 'mu-cite)
  49
  50 (defcustom mu-cite-allow-null-string-registration nil
  51   "If non-nil, null-string citation-name is registered."
  52   :type 'boolean
  53   :group 'mu-cite)
  54
  55 (defvar mu-registration-symbol 'mu-citation-name-alist
  56   "*Name of the variable to register citation prefix strings.")
  57
  58 (defvar mu-registration-file-coding-system nil
  59   "Coding system used when writing a current registration file.")
  60
  61 (defvar mu-citation-name-alist nil)
  62
  63 (defvar mu-register-history nil)
  64
  65 (eval-when-compile (require 'static))
  66
  67 (static-when (featurep 'xemacs)
  68   (define-obsolete-variable-alias
  69     'mu-cite/registration-file 'mu-registration-file)
  70
  71   (define-obsolete-variable-alias
  72     'mu-cite/allow-null-string-registration
  73     'mu-cite-allow-null-string-registration)
  74
  75   (define-obsolete-variable-alias
  76     'mu-cite/registration-symbol 'mu-registration-symbol)
  77   )
  78
  79
  80 ;;; @ load / save registration file
  81 ;;;
  82
  83 (defun mu-cite-load-registration-file ()
  84   (if (file-readable-p mu-registration-file)
  85       (with-temp-buffer
  86         (insert-file-contents-as-coding-system
  87          mu-registration-file-coding-system-for-read
  88          mu-registration-file)
  89         (setq mu-registration-file-coding-system
  90               buffer-file-coding-system)
  91         (let ((exp (read (current-buffer))))
  92           (or (eq (car (cdr exp)) mu-registration-symbol)
  93               (setcar (cdr exp) mu-registration-symbol))
  94           (eval exp)))))
  95
  96 (defun mu-cite-save-registration-file ()
  97   (with-temp-buffer
  98     (insert ";;; " (file-name-nondirectory mu-registration-file) "\n")
  99     (insert ";;; This file is generated automatically by mu-cite "
 100             mu-cite-version "\n\n")
 101     (insert "(setq "
 102             (symbol-name mu-registration-symbol)
 103             "\n      '(")
 104     (insert (mapconcat
 105              (function prin1-to-string)
 106              mu-citation-name-alist "\n        "))
 107     (insert "\n        ))\n\n")
 108     (insert ";;; "
 109             (file-name-nondirectory mu-registration-file)
 110             " ends here.\n")
 111     (write-region-as-coding-system mu-registration-file-coding-system
 112                                    (point-min)(point-max)
 113                                    mu-registration-file nil 'nomsg)
 114     (condition-case nil
 115         (set-file-modes mu-registration-file mu-registration-file-modes)
 116       (error nil))))
 117
 118
 119 ;;; @ database accessors
 120 ;;;
 121
 122 ;; get citation-name from the database
 123 (defun mu-register-get-citation-name (from)
 124   (cdr (assoc from mu-citation-name-alist)))
 125
 126 ;; register citation-name to the database
 127 (defun mu-register-add-citation-name (name from)
 128   (setq mu-citation-name-alist
 129         (put-alist from name mu-citation-name-alist))
 130   (mu-cite-save-registration-file))
 131
 132
 133 ;;; @ methods
 134 ;;;
 135
 136 ;;;###autoload
 137 (defun mu-cite-get-prefix-method ()
 138   (or (mu-register-get-citation-name (mu-cite-get-value 'address))
 139       ">"))
 140
 141 ;;;###autoload
 142 (defun mu-cite-get-prefix-register-method ()
 143   (let ((addr (mu-cite-get-value 'address)))
 144     (or (mu-register-get-citation-name addr)
 145         (let ((return
 146                (read-string "Citation name? "
 147                             (or (mu-cite-get-value 'x-attribution)
 148                                 (mu-cite-get-value 'full-name))
 149                             'mu-register-history)))
 150           (when (and (or mu-cite-allow-null-string-registration
 151                          (not (string-equal return "")))
 152                      (y-or-n-p (format "Register \"%s\"? " return)))
 153             (mu-register-add-citation-name return addr))
 154           return))))
 155
 156 ;;;###autoload
 157 (defun mu-cite-get-prefix-register-verbose-method ()
 158   (let* ((addr (mu-cite-get-value 'address))
 159          (return1 (mu-register-get-citation-name addr))
 160          (return (read-string "Citation name? "
 161                               (or return1
 162                                   (mu-cite-get-value 'x-attribution)
 163                                   (mu-cite-get-value 'full-name))
 164                               'mu-register-history)))
 165     (when (and (or mu-cite-allow-null-string-registration
 166                    (not (string-equal return "")))
 167                (not (string-equal return return1))
 168                (y-or-n-p (format "Register \"%s\"? " return)))
 169       (mu-register-add-citation-name return addr))
 170     return))
 171
 172
 173 ;;; @ end
 174 ;;;
 175
 176 (provide 'mu-register)
 177
 178 (mu-cite-load-registration-file)
 179
 180 ;;; mu-register.el ends here