+2003-05-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-logo-color-alist): Added no colours.
+
+2003-05-09 Dave Love <fx@gnu.org>
+
+ * utf7.el (mm-util): Require.
+ (utf7-direct-encoding-chars, utf7-imap-direct-encoding-chars):
+ Defconst, not defvar.
+ (utf7-utf-16-coding-system): New.
+ (utf7-encode-internal): Hoist concat out of loop.
+ (utf7-fragment-encode): Use mm-with-unibyte-current-buffer.
+ (utf7-get-u16char-converter) [utf7-utf-16-coding-system]: New
+ case.
+ (utf7-latin1-u16-char-converter): Encode the region.
+ (utf7-u16-latin1-char-converter): Decode the region.
+ (utf7-encode, utf7-decode): Fix multibyteness.
+
+ * mm-bodies.el (mm-body-7-or-8): Don't special-case mule.
+ (mm-encode-body): Use mm-read-coding-system, not mm-read-charset.
+ (mm-uu-yenc-decode-function): Defvar when compiling.
+ (mm-encode-body, mm-decode-body): Doc fix.
+
+2003-05-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-unregistered-group-regex):
+ removed in favor of the group/topic/global variables
+ (gnus-registry-register-message-ids): fixed test to omit
+ gnus-registry-unregistered-group-regex
+
+ * gnus.el (gnus-variable-list): removed gnus-registry-alist and
+ gnus-registry-headers-alist from the list
+ (gnus-registry-headers-alist): removed
+ (registry-ignore): new parameter, with accompanying
+ gnus-registry-ignored-groups global variable
+
+ * gnus-start.el (gnus-clear-system): no need to clear the
+ registry, we can do it ourselves
+ (gnus-gnus-to-quick-newsrc-format): extra parameters so it can be
+ used by gnus-registry.el
+
+ * gnus-registry.el (gnus-registry-cache-file): new file variable
+ (gnus-registry-cache-read, gnus-registry-cache-save): new
+ functions
+ (gnus-registry-cache-whitespace): new function. From Dan
+ Christensen <jdc@chow.mat.jhu.edu>
+ (gnus-registry-save, gnus-registry-read): use the new
+ gnus-registry-cache-{read|save} functions, and change the name
+ from gnus-registry-translate-{from|to}-alist
+ (gnus-registry-clear): fixed so it doesn't refer to old function name
+
2003-05-09 Jesper Harder <harder@ifa.au.dk>
* gnus-picon.el (gnus-picon-transform-address): Parse the encoded
(defvar gnus-registry-hashtb nil
"*The article registry by Message ID.")
-(defvar gnus-registry-headers-hashtb nil
- "*The article header registry by Message ID. Unused for now.")
-
(defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue")
"List of groups that gnus-registry-split-fancy-with-parent won't follow.
The group names are matched, they don't have to be fully qualified."
:group 'gnus-registry
:type '(repeat string))
-(defcustom gnus-registry-unregistered-group-regex "^nntp"
- "Group name regex that gnus-registry-register-message-ids won't process."
+(defcustom gnus-registry-cache-file "~/.gnus.registry.eld"
+ "File where the Gnus registry will be stored."
:group 'gnus-registry
- :type 'regexp)
+ :type 'file)
;; Function(s) missing in Emacs 20
(when (memq nil (mapcar 'fboundp '(puthash)))
;; alias puthash is missing from Emacs 20 cl-extra.el
(defalias 'puthash 'cl-puthash)))
-(defun gnus-registry-translate-to-alist ()
- (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb)))
-
-(defun gnus-registry-translate-from-alist ()
+(defun gnus-registry-cache-read ()
+ "Read the registry cache file."
+ (interactive)
+ (let ((file gnus-registry-cache-file))
+ (when (file-exists-p file)
+ (gnus-message 5 "Reading %s..." file)
+ (gnus-load file)
+ (gnus-message 5 "Reading %s...done" file))))
+
+(defun gnus-registry-cache-save ()
+ "Save the registry cache file."
+ (interactive)
+ (let ((file gnus-registry-cache-file))
+ (save-excursion
+ ;; Save .newsrc.eld.
+ (set-buffer (gnus-get-buffer-create " *Gnus-registry-cache*"))
+ (make-local-variable 'version-control)
+ (setq version-control gnus-backup-startup-file)
+ (setq buffer-file-name file)
+ (setq default-directory (file-name-directory buffer-file-name))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (gnus-message 5 "Saving %s..." file)
+ (if gnus-save-startup-file-via-temp-buffer
+ (let ((coding-system-for-write gnus-ding-file-coding-system)
+ (standard-output (current-buffer)))
+ (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist)
+ (gnus-registry-cache-whitespace file)
+ (save-buffer))
+ (let ((coding-system-for-write gnus-ding-file-coding-system)
+ (version-control gnus-backup-startup-file)
+ (startup-file file)
+ (working-dir (file-name-directory file))
+ working-file
+ (i -1))
+ ;; Generate the name of a non-existent file.
+ (while (progn (setq working-file
+ (format
+ (if (and (eq system-type 'ms-dos)
+ (not (gnus-long-file-names)))
+ "%s#%d.tm#" ; MSDOS limits files to 8+3
+ (if (memq system-type '(vax-vms axp-vms))
+ "%s$tmp$%d"
+ "%s#tmp#%d"))
+ working-dir (setq i (1+ i))))
+ (file-exists-p working-file)))
+
+ (unwind-protect
+ (progn
+ (gnus-with-output-to-file working-file
+ (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist))
+
+ ;; These bindings will mislead the current buffer
+ ;; into thinking that it is visiting the startup
+ ;; file.
+ (let ((buffer-backed-up nil)
+ (buffer-file-name startup-file)
+ (file-precious-flag t)
+ (setmodes (file-modes startup-file)))
+ ;; Backup the current version of the startup file.
+ (backup-buffer)
+
+ ;; Replace the existing startup file with the temp file.
+ (rename-file working-file startup-file t)
+ (set-file-modes startup-file setmodes)))
+ (condition-case nil
+ (delete-file working-file)
+ (file-error nil)))))
+
+ (gnus-kill-buffer (current-buffer))
+ (gnus-message 5 "Saving %s...done" file))))
+
+;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
+;; Save the gnus-registry file with extra line breaks.
+(defun gnus-registry-cache-whitespace (filename)
+ (gnus-message 4 "Adding whitespace to %s" filename)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^(\\|(\\\"" nil t)
+ (replace-match "\n\\&" t))
+ (goto-char (point-min))
+ (while (re-search-forward " $" nil t)
+ (replace-match "" t t))))
+
+(defun gnus-registry-save ()
+ (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb))
+ (gnus-registry-cache-save))
+
+(defun gnus-registry-read ()
+ (gnus-registry-cache-read)
(setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist)))
(defun alist-to-hashtable (alist)
(defun gnus-registry-register-message-ids ()
"Register the Message-ID of every article in the group"
- (unless (and gnus-registry-unregistered-group-regex
- (string-match gnus-registry-unregistered-group-regex gnus-newsgroup-name))
+ (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
(dolist (article gnus-newsgroup-articles)
(let ((id (gnus-registry-fetch-message-id-fast article)))
(unless (gnus-registry-fetch-group id)
(defun gnus-registry-clear ()
"Clear the Gnus registry."
(interactive)
- (setq gnus-registry-alist nil
- gnus-registry-headers-alist nil)
- (gnus-registry-translate-from-alist))
+ (setq gnus-registry-alist nil)
+ (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist)))
; also does copy, respool, and crosspost
(add-hook 'gnus-summary-article-move-hook 'gnus-register-action)
(add-hook 'gnus-summary-article-expire-hook 'gnus-register-action)
(add-hook 'nnmail-spool-hook 'gnus-register-spool-action)
-(add-hook 'gnus-save-newsrc-hook 'gnus-registry-translate-to-alist)
-(add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-translate-from-alist)
+(add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
+(add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
(add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)
nnoo-state-alist nil
gnus-current-select-method nil
nnmail-split-history nil
- gnus-ephemeral-servers nil
- gnus-registry-alist nil)
+ gnus-ephemeral-servers nil)
(gnus-shutdown 'gnus)
;; Kill the startup file.
(and gnus-current-startup-file
(gnus-offer-save-summaries)
(gnus-save-newsrc-file)))
-(defun gnus-gnus-to-quick-newsrc-format ()
+(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name specific-variable)
"Print Gnus variables such as gnus-newsrc-alist in lisp format."
(princ ";; -*- emacs-lisp -*-\n")
- (princ ";; Gnus startup file.\n")
- (princ "\
+ (if name
+ (princ (format ";; %s\n" name))
+ (princ ";; Gnus startup file.\n"))
+
+ (unless minimal
+ (princ "\
;; Never delete this file -- if you want to force Gnus to read the
;; .newsrc file (if you have one), touch .newsrc instead.\n")
- (princ "(setq gnus-newsrc-file-version ")
- (princ (gnus-prin1-to-string gnus-version))
- (princ ")\n")
+ (princ "(setq gnus-newsrc-file-version ")
+ (princ (gnus-prin1-to-string gnus-version))
+ (princ ")\n"))
+
(let* ((print-quoted t)
(print-readably t)
(print-escape-multibyte nil)
(stringp gnus-save-killed-list))
(gnus-strip-killed-list)
gnus-killed-list))
- (variables
- (if gnus-save-killed-list gnus-variable-list
- ;; Remove the `gnus-killed-list' from the list of variables
- ;; to be saved, if required.
- (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
+ (variables
+ (if specific-variable
+ (list specific-variable)
+ (if gnus-save-killed-list gnus-variable-list
+ ;; Remove the `gnus-killed-list' from the list of variables
+ ;; to be saved, if required.
+ (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
;; Peel off the "dummy" group.
(gnus-newsrc-alist (cdr gnus-newsrc-alist))
variable)
(storm "#666699" "#99ccff")
(pdino "#9999cc" "#99ccff")
(purp "#9999cc" "#666699")
+ (no "#000000" "#ff0000")
(neutral "#b4b4b4" "#878787")
(september "#bf9900" "#ffcc00"))
"Color alist used for the Gnus logo.")
`gnus-large-newsgroup'). If it is nil, the default value is the
total number of articles in the group.")
+;; The Gnus registry's ignored groups
+(gnus-define-group-parameter
+ registry-ignore
+ :type list
+ :function-document
+ "Whether this group should be ignored by the registry."
+ :variable gnus-registry-ignored-groups
+ :variable-default nil
+ :variable-document
+ "*Groups in which the registry should be turned off."
+ :variable-group gnus-registry
+ :variable-type '(repeat
+ (list
+ (regexp :tag "Group Name Regular Expression")
+ (boolean :tag "Ignored")))
+
+ :parameter-type '(boolean :tag "Group Ignored by the Registry")
+ :parameter-document
+ "Whether the Gnus Registry should ignore this group.")
+
;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com>
(defcustom gnus-install-group-spam-parameters t
"*Disable the group parameters for spam detection.
'(gnus-newsrc-options gnus-newsrc-options-n
gnus-newsrc-last-checked-date
gnus-newsrc-alist gnus-server-alist
- gnus-registry-alist
- gnus-registry-headers-alist
gnus-killed-list gnus-zombie-list
gnus-topic-topology gnus-topic-alist
gnus-agent-covered-methods)
"Assoc list of registry data.
gnus-registry.el will populate this if it's loaded.")
-(defvar gnus-registry-headers-alist nil
- "Assoc list of registry header data.
-gnus-registry.el will populate this if it's loaded.")
-
(defvar gnus-newsrc-hashtb nil
"Hashtable of gnus-newsrc-alist.")
(iso-2022-jp-2 . 7bit)
;; We MUST encode UTF-16 because it can contain \0's which is
;; known to break servers.
+ ;; Note: UTF-16 variants are invalid for text parts [RFC 2781],
+ ;; so this can't happen :-/.
(utf-16 . base64)
(utf-16be . base64)
(utf-16le . base64))
(defun mm-encode-body (&optional charset)
"Encode a body.
Should be called narrowed to the body that is to be encoded.
-If there is more than one non-ASCII MULE charset, then list of found
-MULE charsets are returned.
-If CHARSET is non-nil, it is used.
+If there is more than one non-ASCII MULE charset in the body, then the
+list of MULE charsets found is returned.
+If CHARSET is non-nil, it is used as the MIME charset to encode the body.
If successful, the MIME charset is returned.
If no encoding was done, nil is returned."
(if (not (mm-multibyte-p))
(message-options-get 'mm-encody-body-charset)
(message-options-set
'mm-encody-body-charset
- (mm-read-charset "Charset used in the article: ")))
+ (mm-read-coding-system "Charset used in the article: ")))
;; The logic in `mml-generate-mime-1' confirms that it's OK
;; to return nil here.
nil)))
(defun mm-body-7-or-8 ()
"Say whether the body is 7bit or 8bit."
- (cond
- ((not (featurep 'mule))
- (if (save-excursion
- (goto-char (point-min))
- (skip-chars-forward mm-7bit-chars)
- (eobp))
- '7bit
- '8bit))
- (t
- ;; Mule version
- (if (and (null (delq 'ascii
- (mm-find-charset-region (point-min) (point-max))))
- ;;!!!The following is necessary because the function
- ;;!!!above seems to return the wrong result under
- ;;!!!Emacs 20.3. Sometimes.
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward mm-7bit-chars)
- (eobp)))
- '7bit
- '8bit))))
+ (if (save-excursion
+ (goto-char (point-min))
+ (skip-chars-forward mm-7bit-chars)
+ (eobp))
+ '7bit
+ '8bit))
;;;
;;; Functions for decoding
;;;
+(eval-when-compile (defvar mm-uu-yenc-decode-function))
+
(defun mm-decode-content-transfer-encoding (encoding &optional type)
"Decodes buffer encoded with ENCODING, returning success status.
If TYPE is `text/plain' CRLF->LF translation may occur."
(replace-match "\n" t t)))))
(defun mm-decode-body (charset &optional encoding type)
- "Decode the current article that has been encoded with ENCODING.
-The characters in CHARSET should then be decoded. If FORCE is non-nil
-use the supplied charset unconditionally."
+ "Decode the current article that has been encoded with ENCODING to CHARSET.
+ENCODING is a MIME content transfer encoding.
+CHARSET is the MIME charset with which to decode the data after transfer
+decoding. If it is nil, default to `mail-parse-charset'."
(when (stringp charset)
(setq charset (intern (downcase charset))))
(when (or (not charset)
(save-excursion
(when encoding
(mm-decode-content-transfer-encoding encoding type))
- (when (featurep 'mule)
+ (when (featurep 'mule) ; Fixme: Wrong test for unibyte session.
(let ((coding-system (mm-charset-to-coding-system charset)))
(if (and (not coding-system)
(listp mail-parse-ignored-charsets)
-;;; utf7.el --- UTF-7 encoding/decoding for Emacs
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*-coding: iso-8859-1;-*-
+;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc.
;; Author: Jon K Hellan <hellan@acm.org>
+;; Maintainer: bugs@gnus.org
;; Keywords: mail
;; This file is part of GNU Emacs.
;; Boston, MA 02111-1307, USA.
;;; Commentary:
-;;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152
-;;; This is a transformation format of Unicode that contains only 7-bit
-;;; ASCII octets and is intended to be readable by humans in the limiting
-;;; case that the document consists of characters from the US-ASCII
-;;; repertoire.
-;;; In short, runs of characters outside US-ASCII are encoded as base64
-;;; inside delimiters.
-;;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way
-;;; to represent characters outside US-ASCII in mailbox names in IMAP.
-;;; This library supports both variants, but the IMAP variation was the
-;;; reason I wrote it.
-;;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode)
-;;; -> current character set, and vice versa.
-;;; However, until Emacs supports Unicode, the only Emacs character set
-;;; supported here is ISO-8859.1, which can trivially be converted to/from
-;;; Unicode.
-;;; When decoding results in a character outside the Emacs character set,
-;;; an error is thrown. It is up to the application to recover.
+
+;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152
+;; This is a transformation format of Unicode that contains only 7-bit
+;; ASCII octets and is intended to be readable by humans in the limiting
+;; case that the document consists of characters from the US-ASCII
+;; repertoire.
+;; In short, runs of characters outside US-ASCII are encoded as base64
+;; inside delimiters.
+;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way
+;; to represent characters outside US-ASCII in mailbox names in IMAP.
+;; This library supports both variants, but the IMAP variation was the
+;; reason I wrote it.
+;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode)
+;; -> current character set, and vice versa.
+;; However, until Emacs supports Unicode, the only Emacs character set
+;; supported here is ISO-8859.1, which can trivially be converted to/from
+;; Unicode.
+;; When decoding results in a character outside the Emacs character set,
+;; an error is thrown. It is up to the application to recover.
+
+;; UTF-7 should be done by providing a coding system. Mule-UCS does
+;; already, but I don't know if it does the IMAP version and it's not
+;; clear whether that should really be a coding system. The UTF-16
+;; part of the conversion can be done with coding systems available
+;; with Mule-UCS or some versions of Emacs. Unfortunately these were
+;; done wrongly (regarding handling of byte-order marks and how the
+;; variants were named), so we don't have a consistent name for the
+;; necessary coding system. The code below doesn't seem to DTRT
+;; generally. E.g.:
+;;
+;; (utf7-encode "a+£")
+;; => "a+ACsAow-"
+;;
+;; $ echo "a+£"|iconv -f iso-8859-1 -t utf-7
+;; a+-+AKM
+;;
+;; -- fx
+
;;; Code:
(require 'base64)
(eval-when-compile (require 'cl))
+(require 'mm-util)
-(defvar utf7-direct-encoding-chars " -%'-*,-[]-}"
+(defconst utf7-direct-encoding-chars " -%'-*,-[]-}"
"Character ranges which do not need escaping in UTF-7.")
-(defvar utf7-imap-direct-encoding-chars
+(defconst utf7-imap-direct-encoding-chars
(concat utf7-direct-encoding-chars "+\\~")
"Character ranges which do not need escaping in the IMAP variant of UTF-7.")
+(defconst utf7-utf-16-coding-system
+ (cond ((mm-coding-system-p 'utf-16-be-no-signature) ; Mule-UCS
+ 'utf-16-be-no-signature)
+ ((and (mm-coding-system-p 'utf-16-be) ; Emacs 21.4 (?), Emacs 22
+ ;; Avoid versions with BOM.
+ (= 2 (length (encode-coding-string "a" 'utf-16-be))))
+ 'utf-16-be)
+ ((mm-coding-system-p 'utf-16-be-nosig) ; ?
+ 'utf-16-be-nosig))
+ "Coding system which encodes big endian UTF-16 without a BOM signature.")
+
(defsubst utf7-imap-get-pad-length (len modulus)
"Return required length of padding for IMAP modified base64 fragment."
(mod (- len) modulus))
(end (point-max)))
(narrow-to-region start end)
(goto-char start)
- (let ((esc-char (if for-imap ?& ?+))
- (direct-encoding-chars
- (if for-imap utf7-imap-direct-encoding-chars
- utf7-direct-encoding-chars)))
+ (let* ((esc-char (if for-imap ?& ?+))
+ (direct-encoding-chars
+ (if for-imap utf7-imap-direct-encoding-chars
+ utf7-direct-encoding-chars))
+ (not-direct-encoding-chars (concat "^" direct-encoding-chars)))
(while (not (eobp))
(skip-chars-forward direct-encoding-chars)
(unless (eobp)
(let ((p (point))
(fc (following-char))
(run-length
- (skip-chars-forward (concat "^" direct-encoding-chars))))
+ (skip-chars-forward not-direct-encoding-chars)))
(if (and (= fc esc-char)
(= run-length 1)) ; Lone esc-char?
(delete-backward-char 1) ; Now there's one too many
(save-restriction
(narrow-to-region start end)
(funcall (utf7-get-u16char-converter 'to-utf-16))
- (base64-encode-region start (point-max))
+ (mm-with-unibyte-current-buffer
+ (base64-encode-region start (point-max)))
(goto-char start)
(let ((pm (point-max)))
(when for-imap
(defun utf7-get-u16char-converter (which-way)
"Return a function to convert between UTF-16 and current character set."
- ;; Add test to check if we are really Latin-1.
- ;; Support other character sets once Emacs groks Unicode.
- (if (eq which-way 'to-utf-16)
- 'utf7-latin1-u16-char-converter
- 'utf7-u16-latin1-char-converter))
+ (if utf7-utf-16-coding-system
+ (if (eq which-way 'to-utf-16)
+ (lambda ()
+ (encode-coding-region (point-min) (point-max)
+ utf7-utf-16-coding-system))
+ (lambda ()
+ (decode-coding-region (point-min) (point-max)
+ utf7-utf-16-coding-system)))
+ ;; Add test to check if we are really Latin-1.
+ (if (eq which-way 'to-utf-16)
+ 'utf7-latin1-u16-char-converter
+ 'utf7-u16-latin1-char-converter)))
(defun utf7-latin1-u16-char-converter ()
"Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode.
Characters are converted to raw byte pairs in narrowed buffer."
+ (mm-encode-coding-region (point-min) (point-max) 'iso-8859-1)
+ (mm-disable-multibyte)
(goto-char (point-min))
(while (not (eobp))
(insert 0)
(if (= 0 (following-char))
(delete-char 1)
(error "Unable to convert from Unicode"))
- (forward-char)))
+ (forward-char))
+ (mm-decode-coding-region (point-min) (point-max) 'iso-8859-1)
+ (mm-enable-multibyte))
(defun utf7-encode (string &optional for-imap)
"Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil."
- (let ((default-enable-multibyte-characters nil))
+ (let ((default-enable-multibyte-characters t))
(with-temp-buffer
(insert string)
(utf7-encode-internal for-imap)
(with-temp-buffer
(insert string)
(utf7-decode-internal for-imap)
+ (mm-enable-multibyte)
(buffer-string))))
(provide 'utf7)
+2003-05-09 Simon Josefsson <jas@extundo.com>
+
+ * pgg.texi (Default user identity): Add.
+
2003-05-08 Jesper Harder <harder@ifa.au.dk>
* gnus.texi (Selecting a Group): Mention nil value
projects / elisp / gnus.git- / commitdiff