mu-register.el

   1 ;;; mu-register.el --- registration feature of mu-cite
   2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
   3 ;;        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 (eval-when-compile (require 'static))
  33
  34
  35 ;;; @ variables
  36 ;;;
  37
  38 (defcustom mu-registration-file (expand-file-name "~/.mu-cite.el")
  39   "The name of the user environment file for mu-cite."
  40   :type 'file
  41   :group 'mu-cite)
  42
  43 (defcustom mu-registration-file-modes 384
  44   "Mode bits of `mu-registration-file', as an integer."
  45   :type 'integer
  46   :group 'mu-cite)
  47
  48 (defcustom mu-registration-file-coding-system-for-write
  49   (static-if (boundp 'MULE)
  50       '*iso-2022-jp*
  51     'iso-2022-7bit)
  52   "Coding-system used when writing a registration file.  If you set this
  53 to nil, the value of `mu-registration-file-coding-system' will be used
  54 for writing a file."
  55   :group 'mu-cite)
  56
  57 (defcustom mu-cite-allow-null-string-registration nil
  58   "If non-nil, null-string citation-name can be registered."
  59   :type 'boolean
  60   :group 'mu-cite)
  61
  62 (defvar mu-registration-symbol 'mu-citation-name-alist
  63   "*Name of the variable to register citation prefix strings.")
  64
  65 (defvar mu-registration-file-coding-system-for-read nil
  66   "*Coding-system used when reading a registration file.  It is strongly
  67 recommended that you do not set this option if you have no particular
  68 reason.")
  69
  70 (defvar mu-registration-file-coding-system nil
  71   "Internal variable used to keep a default coding-system for writing
  72 a current registration file.  The value will be renewed whenever a
  73 registration id read.")
  74
  75 (defvar mu-register-history nil)
  76
  77
  78 ;;; @ load / save registration file
  79 ;;;
  80
  81 (defun mu-cite-load-registration-file ()
  82   (if (file-readable-p mu-registration-file)
  83       (with-temp-buffer
  84         (if mu-registration-file-coding-system-for-read
  85             (insert-file-contents-as-coding-system
  86              mu-registration-file-coding-system-for-read
  87              mu-registration-file)
  88           (insert-file-contents mu-registration-file))
  89         (setq mu-registration-file-coding-system
  90               (static-cond
  91                ((boundp 'buffer-file-coding-system)
  92                 (symbol-value 'buffer-file-coding-system))
  93                ((boundp 'file-coding-system)
  94                 (symbol-value 'file-coding-system))
  95                (t
  96                 nil)))
  97         (let ((exp (read (current-buffer))))
  98           (or (eq (car (cdr exp)) mu-registration-symbol)
  99               (setcar (cdr exp) mu-registration-symbol))
 100           (eval exp))))
 101   (or (boundp mu-registration-symbol)
 102       (set mu-registration-symbol nil)))
 103
 104 (defun mu-cite-save-registration-file ()
 105   (with-temp-buffer
 106     (set-buffer-multibyte t)
 107     (let ((name (file-name-nondirectory mu-registration-file))
 108           (coding-system (or mu-registration-file-coding-system-for-write
 109                              mu-registration-file-coding-system)))
 110       (insert (format "\
 111 ;;; %s  -*- mode: emacs-lisp; coding: %s -*-
 112 ;; This file is generated automatically by MU-CITE v%s.
 113
 114 "
 115                       name coding-system mu-cite-version))
 116       (insert "(setq "
 117               (symbol-name mu-registration-symbol)
 118               "\n      '(")
 119       (insert (mapconcat
 120                (function
 121                 (lambda (elem)
 122                   (format "(%s . %s)"
 123                           (prin1-to-string
 124                            (mu-cite-remove-text-properties (car elem)))
 125                           (prin1-to-string
 126                            (mu-cite-remove-text-properties (cdr elem))))))
 127                (symbol-value mu-registration-symbol) "\n\t"))
 128       (insert "))\n\n")
 129       (insert ";;; " name " ends here\n")
 130       (write-region-as-coding-system coding-system
 131                                      (point-min) (point-max)
 132                                      mu-registration-file nil 'nomsg)
 133       (condition-case nil
 134           (set-file-modes mu-registration-file mu-registration-file-modes)
 135         (error nil)))))
 136
 137
 138 ;;; @ database accessors
 139 ;;;
 140
 141 ;; get citation-name from the database
 142 (defun mu-register-get-citation-name (from)
 143   (cdr (assoc from (symbol-value mu-registration-symbol))))
 144
 145 ;; register citation-name to the database
 146 (defun mu-register-add-citation-name (name from)
 147   (set-alist mu-registration-symbol from name)
 148   (mu-cite-save-registration-file))
 149
 150
 151 ;;; @ methods
 152 ;;;
 153
 154 ;;;###autoload
 155 (defun mu-cite-get-prefix-method ()
 156   (or (mu-register-get-citation-name (mu-cite-get-value 'address))
 157       ">"))
 158
 159 ;;;###autoload
 160 (defun mu-cite-get-prefix-register-method ()
 161   (let ((addr (mu-cite-get-value 'address)))
 162     (or (mu-register-get-citation-name addr)
 163         (let* ((minibuffer-allow-text-properties nil)
 164                (return
 165                 (mu-cite-remove-text-properties
 166                  (read-string "Citation name? "
 167                               (or (mu-cite-get-value 'x-attribution)
 168                                   (mu-cite-get-value 'x-cite-me)
 169                                   (mu-cite-get-value 'full-name))
 170                               'mu-register-history))))
 171
 172           (if (and (or mu-cite-allow-null-string-registration
 173                        (not (string-equal return "")))
 174                    (y-or-n-p (format "Register \"%s\"? " return)))
 175               (mu-register-add-citation-name return addr))
 176           return))))
 177
 178 ;;;###autoload
 179 (defun mu-cite-get-prefix-register-verbose-method ()
 180   (let* ((addr (mu-cite-get-value 'address))
 181          (return1 (mu-register-get-citation-name addr))
 182          (minibuffer-allow-text-properties nil)
 183          (return (mu-cite-remove-text-properties
 184                   (read-string "Citation name? "
 185                                (or return1
 186                                    (mu-cite-get-value 'x-attribution)
 187                                    (mu-cite-get-value 'x-cite-me)
 188                                    (mu-cite-get-value 'full-name))
 189                                'mu-register-history))))
 190     (if (and (or mu-cite-allow-null-string-registration
 191                  (not (string-equal return "")))
 192              (not (string-equal return return1))
 193              (y-or-n-p (format "Register \"%s\"? " return)))
 194         (mu-register-add-citation-name return addr))
 195     return))
 196
 197
 198 ;;; @ end
 199 ;;;
 200
 201 (provide 'mu-register)
 202
 203 (mu-cite-load-registration-file)
 204
 205 ;;; mu-register.el ends here