From 3231d171219d5742818bec2054ba39b478cff6cc Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 5 Jul 2000 22:40:05 +0000 Subject: [PATCH] Synch. --- contrib/mml-smime.el | 80 +++++++++++++++ contrib/smime.el | 279 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ChangeLog | 10 ++ lisp/flow-fill.el | 4 +- lisp/gnus-sum.el | 116 ++++++++++----------- lisp/gnus-util.el | 8 +- lisp/utf7.el | 36 +++---- 7 files changed, 452 insertions(+), 81 deletions(-) create mode 100644 contrib/mml-smime.el create mode 100644 contrib/smime.el diff --git a/contrib/mml-smime.el b/contrib/mml-smime.el new file mode 100644 index 0000000..a216fe8 --- /dev/null +++ b/contrib/mml-smime.el @@ -0,0 +1,80 @@ +;;; mml-smime.el --- S/MIME support for MML +;; Copyright (c) 2000 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: Gnus, MIME, SMIME, MML + +;; This file is a part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This support creation of S/MIME parts in MML. + +;; Usage: +;; (mml-smime-setup) +;; +;; Insert an attribute, postprocess=smime-sign (or smime-encrypt), into +;; the mml tag to be signed (or encrypted). +;; +;; It is based on rfc2015.el by Shenghuo Zhu. + +;;; Code: + +(require 'smime) + +(defun mml-smime-sign (cont) + ;; FIXME: You have to input the sender. + (when (null smime-keys) + (error "Please use M-x customize RET smime RET to configure SMIME")) + (smime-sign-buffer) + (goto-char (point-min)) + (when (looking-at "^MIME-Version: 1.0") + (forward-line 1) + (delete-region (point-min) (point))) + (goto-char (point-max))) + +(defun mml-smime-encrypt (cont) + ;; FIXME: You have to input the receiptant. + ;; FIXME: Should encrypt to myself so I can read it?? + (smime-encrypt-buffer) + (goto-char (point-min)) + (when (looking-at "^MIME-Version: 1.0") + (forward-line 1) + (delete-region (point-min) (point))) + (goto-char (point-max))) + +;; The following code might be moved into mml.el or gnus-art.el. + +(defvar mml-postprocess-alist + '(("smime-sign" . mml-smime-sign) + ("smime-encrypt" . mml-smime-encrypt)) + "Alist of postprocess functions.") + +(defun mml-postprocess (cont) + (let ((pp (cdr (or (assq 'postprocess cont) + (assq 'pp cont)))) + item) + (if (and pp (setq item (assoc pp mml-postprocess-alist))) + (funcall (cdr item) cont)))) + +(defun mml-smime-setup () + (setq mml-generate-mime-postprocess-function 'mml-postprocess)) + +(provide 'mml-smime) + +;;; mml-smime.el ends here diff --git a/contrib/smime.el b/contrib/smime.el new file mode 100644 index 0000000..fb76337 --- /dev/null +++ b/contrib/smime.el @@ -0,0 +1,279 @@ +;;; smime.el --- S/MIME support library +;; Copyright (c) 2000 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: SMIME X.509 PEM OpenSSL + +;; This file is not a part of GNU Emacs, but the same permissions apply. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This library perform S/MIME operations from within Emacs. +;; +;; Functions for fetching certificates from public repositories are +;; NOT provided (yet). +;; +;; It uses OpenSSL (tested with version 0.9.5a) for signing, +;; encryption and decryption. +;; +;; Some general knowledge of S/MIME, X.509, PKCS#12, PEM etc is +;; probably required to use this library in any useful way. +;; Especially, don't expect this library to buy security for you. If +;; you don't understand what you are doing, you're as likely to lose +;; security than gain any by using this library. + +;;; Quick introduction: + +;; Get your S/MIME certificate from VeriSign or someplace. I used +;; Netscape to generate the key and certificate request and stuff, and +;; Netscape can export the key into PKCS#12 format. +;; +;; Enter OpenSSL. To be able to use this library, it need to have the +;; SMIME key readable in PEM format. OpenSSL is used to convert the +;; key: +;; +;; $ openssl pkcs12 -in mykey.p12 -clcerts -nodes > mykey.pem +;; ... +;; +;; Now, use M-x customize-variable smime-keys and add mykey.pem as +;; a key. +;; +;; Now you should be able to sign messages! Create a buffer and write +;; something and run M-x smime-sign-buffer RET RET and you should see +;; your message MIME armoured and a signature. Encryption, M-x +;; smime-encrypt-buffer, should also work. +;; +;; To be able to verify messages you need to build up trust with +;; someone. Perhaps you trust the CA that issued your certificate, at +;; least I did, so I export it's certificates from my PKCS#12 +;; certificate with: +;; +;; $ openssl pkcs12 -in mykey.p12 -cacerts -nodes > cacert.pem +;; ... +;; +;; Now, use M-x customize-variable smime-CAs and add cacert.pem as a +;; CA certificate. +;; +;; You should now be able to sign messages, and even verify messages +;; sent by others that use the same CA as you. + +;; Bugs: +;; +;; Don't complain that this package doesn't do encrypted PEM files, +;; submit a patch instead. I store my keys in a safe place, so I +;; didn't need the encryption. Also, programming this was made a lot +;; easier by that decision. One might think that this even influenced +;; were I store my keys, and one would probably be right. :-) +;; +;; Suggestions and comments are appreciated, mail me at simon@josefsson.org. + +;; +;; +;; I would include pointers to introductory text on concepts used in +;; this library here, but the material I've read are so horrible I +;; don't want to recomend them. +;; +;; Why can't someone write a simple introduction to all this stuff? +;; Until then, much of this resemble security by obscurity. +;; +;; Also, I'm not going to mention anything about the wonders of +;; cryptopolitics. Oops, I just did. +;; +;; + +;;; Revision history: + +;; version 0 not released + +;;; Code: + +(defgroup smime nil + "S/MIME configuration.") + +(defcustom smime-keys nil + "Map your mail addresses to a file with your certified key. +The file is assumed to be in PEM format and not encrypted." + :type '(repeat (list (string :tag "Mail address") + (file :tag "File name"))) + :group 'smime) + +(defcustom smime-CAs nil + "List of directories/files containing certificates for CAs you trust. +Files should be in PEM format. +Directories should contain files (in PEM format) named to the X.509 +hash of the certificate." + :type '(repeat (radio (directory :tag "Trusted CA directory") + (file :tag "Trusted CA file"))) + :group 'smime) + +(defcustom smime-certificate-directory "~/Mail/certs/" + "Directory containing other people's certificates. +It should contain files named to the X.509 hash of the certificate, +and the files themself should be in PEM format. +The S/MIME library provide simple functionality for fetching +certificates into this directory, so there is no need to populate it +manually." + :type 'directory + :group 'smime) + +(defcustom smime-openssl-program "openssl" + "Name of OpenSSL binary." + :type 'string + :group 'smime) + +;; OpenSSL wrappers. + +(defun smime-call-openssl-region (b e buf &rest args) + (case (apply 'call-process-region b e smime-openssl-program nil buf nil args) + (0 t) + (1 (error "OpenSSL: An error occurred parsing the command options.")) + (2 (error "OpenSSL: One of the input files could not be read.")) + (3 (error "OpenSSL: an error occurred creating the PKCS#7 file or when reading the MIME message.")) + (4 (error "OpenSSL: an error occurred decrypting or verifying the message.")) + (t (error "Unknown OpenSSL exitcode %s" exitcode)))) + +(defun smime-sign-region (b e keyfile) + "Sign region with certified key in KEYFILE. +If signing fails, the buffer is not modified. Region is assumed to +have proper MIME tags. KEYFILE is expected to contain a PEM encoded +private key and certificate." + (let* ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))) + (when (smime-call-openssl-region b e buffer "smime" "-sign" + "-signer" (expand-file-name keyfile)) + (delete-region b e) + (insert-buffer buffer) + (kill-buffer buffer) + t))) + +(defun smime-encrypt-region (b e certfiles) + "Encrypt region for recipients specified in CERTFILES. +If encryption fails, the buffer is not modified. Region is assumed to +have proper MIME tags. CERTFILES is a list of filenames, each file +is expected to contain of a PEM encoded certificate." + (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))) + (when (apply 'smime-call-openssl-region b e buffer "smime" "-encrypt" + (mapcar 'expand-file-name certfiles)) + (delete-region b e) + (insert-buffer buffer) + (kill-buffer buffer) + t))) + +(defun smime-sign-buffer (&optional keyfile buffer) + "S/MIME sign BUFFER with key in KEYFILE. +KEYFILE should contain a PEM encoded key and certificate." + (interactive) + (with-current-buffer (or buffer (current-buffer)) + (smime-sign-region + (point-min) (point-max) + (or keyfile + (smime-get-key-by-email + (completing-read "Sign using which signature? " smime-keys nil nil + (and (listp (car-safe smime-keys)) (caar smime-keys)))))))) + +(defun smime-encrypt-buffer (&optional certfiles buffer) + "S/MIME encrypt BUFFER for recipients specified in CERTFILES. +CERTFILES is a list of filenames, each file is expected to consist of +a PEM encoded key and certificate. Uses current buffer if BUFFER is +nil." + (interactive) + (with-current-buffer (or buffer (current-buffer)) + (smime-encrypt-region + (point-min) (point-max) + (or certfiles + (list (read-file-name "Recipient's S/MIME certificate: " + smime-certificate-directory nil)))))) + +;; User interface. + +(defvar smime-buffer "*SMIME*") + +(defvar smime-mode-map nil) +(put 'smime-mode 'mode-class 'special) + +(unless smime-mode-map + (setq smime-mode-map (make-sparse-keymap)) + (suppress-keymap smime-mode-map) + + (define-key smime-mode-map "q" 'smime-exit) + (define-key smime-mode-map "f" 'smime-certificate-info)) + +(defun smime-mode () + "Major mode for browsing, viewing and fetching certificates. + +All normal editing commands are switched off. +\\ + +The following commands are available: + +\\{smime-mode-map}" + (interactive) + (kill-all-local-variables) + (setq major-mode 'smime-mode) + (setq mode-name "SMIME") + (setq mode-line-process nil) + (use-local-map smime-mode-map) + (buffer-disable-undo) + (setq truncate-lines t) + (setq buffer-read-only t)) + +(defun smime-certificate-info (certfile) + (interactive "fCertificate file: ") + (let ((buffer (get-buffer-create (format "*certificate %s*" certfile)))) + (switch-to-buffer buffer) + (erase-buffer) + (call-process smime-openssl-program nil buffer 'display + "x509" "-in" (expand-file-name certfile) "-text") + (fundamental-mode) + (set-buffer-modified-p nil) + (toggle-read-only t) + (goto-char (point-min)))) + +(defun smime-draw-buffer () + (with-current-buffer smime-buffer + (let (buffer-read-only) + (erase-buffer) + (insert "\nYour keys:\n") + (dolist (key smime-keys) + (insert + (format "\t\t%s: %s\n" (car key) (cadr key)))) + (insert "\nTrusted Certificate Authoritys:\n") + (insert "\nKnown Certificates:\n")))) + +(defun smime () + "Go to the SMIME buffer." + (interactive) + (unless (get-buffer smime-buffer) + (save-excursion + (set-buffer (get-buffer-create smime-buffer)) + (smime-mode))) + (smime-draw-buffer) + (switch-to-buffer smime-buffer)) + +(defun smime-exit () + "Quit the S/MIME buffer." + (interactive) + (kill-buffer (current-buffer))) + +;; Other functions + +(defun smime-get-key-by-email (email) + (cadr (assoc email smime-keys))) + +(provide 'smime) + +;;; smime.el ends here diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 192d2e5..74285c0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,15 @@ 2000-07-05 Dave Love + * utf7.el: Doc and header fixes. + + * gnus-sum.el: Doc fixes. + + * gnus-util.el (gnus-point-at-eol, gnus-point-at-bol): Use + defalias, not fset. + + * flow-fill.el (fill-flowed-point-at-eol) + (fill-flowed-point-at-bol): Use defalias, not fset. + * gnus-art.el: Don't alias article-mime-decode-quoted-printable. (gnus-Plain-save-name): Delete -- apparently bogus. diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el index 9aae7c4..5d2c4f1 100644 --- a/lisp/flow-fill.el +++ b/lisp/flow-fill.el @@ -43,12 +43,12 @@ ;;; Code: (eval-and-compile - (fset 'fill-flowed-point-at-bol + (defalias 'fill-flowed-point-at-bol (if (fboundp 'point-at-bol) 'point-at-bol 'line-beginning-position)) - (fset 'fill-flowed-point-at-eol + (defalias 'fill-flowed-point-at-eol (if (fboundp 'point-at-eol) 'point-at-eol 'line-end-position))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 9cb5dbb..09ddf09 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -789,7 +789,7 @@ automatically when it is selected." . gnus-summary-high-unread-face) ((and (< score default) (= mark gnus-unread-mark)) . gnus-summary-low-unread-face) - ((and (memq article gnus-newsgroup-incorporated) + ((and (memq article gnus-newsgroup-incorporated) (= mark gnus-unread-mark)) . gnus-summary-incorporated-face) ((= mark gnus-unread-mark) @@ -871,7 +871,7 @@ default charset will be used instead." :type '(repeat symbol) :group 'gnus-charset) -(defcustom gnus-group-ignored-charsets-alist +(defcustom gnus-group-ignored-charsets-alist '(("alt\\.chinese\\.text" iso-8859-1)) "Alist of regexps (to match group names) and charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the @@ -887,7 +887,7 @@ This variable uses the same syntax as `gnus-emphasis-alist'." (repeat (list (regexp :tag "Highlight regexp") (number :tag "Group for entire word" 0) (number :tag "Group for displayed part" 0) - (symbol :tag "Face" + (symbol :tag "Face" gnus-emphasis-highlight-words))))) :group 'gnus-summary-visual) @@ -1009,9 +1009,9 @@ For example: ((1 . cn-gb-2312) (2 . big5))." ?c) (?u gnus-tmp-user-defined ?s) (?P (gnus-pick-line-number) ?d)) - "An alist of format specifications that can appear in summary lines, -and what variables they correspond with, along with the type of the -variable (string, integer, character, etc).") + "An alist of format specifications that can appear in summary lines. +These are paired with what variables they correspond with, along with +the type of the variable (string, integer, character, etc).") (defvar gnus-summary-dummy-line-format-alist `((?S gnus-tmp-subject ?s) @@ -1182,7 +1182,7 @@ end position and text.") ;; Subject simplification. (defun gnus-simplify-whitespace (str) - "Remove excessive whitespace." + "Remove excessive whitespace from STR." (let ((mystr str)) ;; Multiple spaces. (while (string-match "[ \t][ \t]+" mystr) @@ -1235,7 +1235,7 @@ The string in the accessible portion of the current buffer is simplified. It is assumed to be a single-line subject. Whitespace is generally cleaned up, and miscellaneous leading/trailing matter is removed. Additional things can be deleted by setting -gnus-simplify-subject-fuzzy-regexp." +`gnus-simplify-subject-fuzzy-regexp'." (let ((case-fold-search t) (modified-tick)) (gnus-simplify-buffer-fuzzy-step "\t" " ") @@ -1470,7 +1470,7 @@ increase the score of each group you read." "T" gnus-summary-limit-include-thread "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age - "x" gnus-summary-limit-to-extra + "x" gnus-summary-limit-to-extra "E" gnus-summary-limit-include-expunged "c" gnus-summary-limit-exclude-childless-dormant "C" gnus-summary-limit-mark-excluded-as-read) @@ -2457,9 +2457,10 @@ marks of articles." (gnus-summary-next-page nil t)) (defun gnus-summary-set-display-table () - ;; Change the display table. Odd characters have a tendency to mess - ;; up nicely formatted displays - we make all possible glyphs - ;; display only a single character. + "Change the display table. +Odd characters have a tendency to mess +up nicely formatted displays - we make all possible glyphs +display only a single character." ;; We start from the standard display table, if any. (let ((table (or (copy-sequence standard-display-table) @@ -2503,9 +2504,9 @@ marks of articles." t))) (defun gnus-set-global-variables () - ;; Set the global equivalents of the summary buffer-local variables - ;; to the latest values they had. These reflect the summary buffer - ;; that was in action when the last article was fetched. + "Set the global equivalents of the buffer-local variables. +They are set to the latest values they had. These reflect the summary +buffer that was in action when the last article was fetched." (when (eq major-mode 'gnus-summary-mode) (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) @@ -2689,7 +2690,7 @@ marks of articles." (forward-line 1)))) (defun gnus-summary-update-line (&optional dont-update) - ;; Update summary line after change. + "Update summary line after change." (when (and gnus-summary-default-score (not gnus-summary-inhibit-highlight)) (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. @@ -3334,9 +3335,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (gnus-dependencies-add-header header dependencies force-new))) (defun gnus-build-get-header (id) - ;; Look through the buffer of NOV lines and find the header to - ;; ID. Enter this line into the dependencies hash table, and return - ;; the id of the parent article (if any). + "Look through the buffer of NOV lines and find the header to ID. +Enter this line into the dependencies hash table, and return +the id of the parent article (if any)." (let ((deps gnus-newsgroup-dependencies) found header) (prog1 @@ -3684,12 +3685,12 @@ If LINE, insert the rebuilt thread starting on line LINE." ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) - ;; Return header of first article in THREAD. - ;; Note that THREAD must never, ever be anything else than a variable - - ;; using some other form will lead to serious barfage. + "Return header of first article in THREAD. +Note that THREAD must never, ever be anything else than a variable - +using some other form will lead to serious barfage." (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" + (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" (vector thread) 2)) (defsubst gnus-article-sort-by-number (h1 h2) @@ -4107,7 +4108,7 @@ or a straight list of headers." gnus-list-identifiers (mapconcat 'identity gnus-list-identifiers " *\\|")))) (dolist (header gnus-newsgroup-headers) - (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp + (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp " *\\)\\)+\\(Re: +\\)?\\)") (mail-header-subject header)) (mail-header-set-subject @@ -4255,7 +4256,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (or gnus-newsgroup-headers t))))) (defun gnus-articles-to-read (group &optional read-all) - ;; Find out what articles the user wants to read. + "Find out what articles the user wants to read." (let* ((articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. @@ -4328,7 +4329,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-sorted-complement gnus-newsgroup-unreads articles))) (when gnus-alter-articles-to-read-function (setq gnus-newsgroup-unreads - (sort + (sort (funcall gnus-alter-articles-to-read-function gnus-newsgroup-name gnus-newsgroup-unreads) '<))) @@ -4440,7 +4441,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (unless (memq (cdr type) uncompressed) (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) - + (when (gnus-check-backend-function 'request-set-mark gnus-newsgroup-name) ;; propagate flags to server, with the following exceptions: @@ -4459,7 +4460,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (push (list add 'add (list (cdr type))) delta-marks)) (when del (push (list del 'del (list (cdr type))) delta-marks))))) - + (when list (push (cons (cdr type) list) newmarked))) @@ -4467,7 +4468,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (unless (gnus-check-group gnus-newsgroup-name) (error "Can't open server for %s" gnus-newsgroup-name)) (gnus-request-set-mark gnus-newsgroup-name delta-marks)) - + ;; Enter these new marks into the info of the group. (if (nthcdr 3 info) (setcar (nthcdr 3 info) newmarked) @@ -4483,7 +4484,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr (nthcdr i info) nil))))))) (defun gnus-set-mode-line (where) - "This function sets the mode line of the article or summary buffers. + "Set the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." ;; Is this mode line one we keep updated? (when (and (memq where gnus-updated-mode-lines) @@ -4499,9 +4500,9 @@ If WHERE is `summary', the summary mode line format will be used." (let* ((mformat (symbol-value (intern (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name (gnus-group-name-decode + (gnus-tmp-group-name (gnus-group-name-decode gnus-newsgroup-name - (gnus-group-name-charset + (gnus-group-name-charset nil gnus-newsgroup-name))) (gnus-tmp-article-number (or gnus-current-article 0)) @@ -4860,8 +4861,9 @@ The resulting hash table is returned, or nil if no Xrefs were found." (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies group also-fetch-heads) - "Parse the news overview data in the server buffer, and return a -list of headers that match SEQUENCE (see `nntp-retrieve-headers')." + "Parse the news overview data in the server buffer. +Return a list of headers that match SEQUENCE (see +`nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some ;; NNTP servers do not include Xrefs when using XOVER. (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) @@ -6371,12 +6373,12 @@ articles that are younger than AGE days." (let ((header (intern (gnus-completing-read - (symbol-name (car gnus-extra-headers)) - "Limit extra header:" - (mapcar (lambda (x) + (symbol-name (car gnus-extra-headers)) + "Limit extra header:" + (mapcar (lambda (x) (cons (symbol-name x) x)) gnus-extra-headers) - nil + nil t)))) (list header (read-string (format "Limit to header %s (regexp): " header))))) @@ -7358,15 +7360,15 @@ to save in." (defun gnus-summary-show-article (&optional arg) "Force re-fetching of the current article. -If ARG (the prefix) is a number, show the article with the charset +If ARG (the prefix) is a number, show the article with the charset defined in `gnus-summary-show-article-charset-alist', or the charset inputed. -If ARG (the prefix) is non-nil and not a number, show the raw article +If ARG (the prefix) is non-nil and not a number, show the raw article without any article massaging functions being run." (interactive "P") - (cond + (cond ((numberp arg) - (let ((gnus-newsgroup-charset + (let ((gnus-newsgroup-charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (read-coding-system "Charset: "))) (gnus-newsgroup-ignored-charsets 'gnus-all)) @@ -7417,7 +7419,7 @@ If ARG is a negative number, hide the unwanted header lines." (setq hidden (if (numberp arg) (>= arg 0) - (save-restriction + (save-restriction (article-narrow-to-head) (gnus-article-hidden-text-p 'headers)))) (goto-char (point-min)) @@ -7655,7 +7657,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) - (when gnus-preserve-marks + (when gnus-preserve-marks ;; Copy any marks over to the new group. (when (and (equal to-group gnus-newsgroup-name) (not (memq article gnus-newsgroup-unreads))) @@ -9035,14 +9037,14 @@ Argument REVERSE means reverse order." (defun gnus-summary-sort-by-author (&optional reverse) "Sort the summary buffer by author name alphabetically. -If case-fold-search is non-nil, case of letters is ignored. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'author reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. -If case-fold-search is non-nil, case of letters is ignored. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'subject reverse)) @@ -9069,7 +9071,7 @@ Argument REVERSE means reverse order." "Sort the summary buffer by article length. Argument REVERSE means reverse order." (interactive "P") - (gnus-summary-sort 'chars reverse)) + (gnus-summary-sort 'chars reverse)) (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." @@ -9523,8 +9525,8 @@ If REVERSE, save parts that do not match TYPE." ;;; (defun gnus-highlight-selected-summary () + "Highlight selected article in summary buffer." ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer (when gnus-summary-selected-face (save-excursion (let* ((beg (progn (beginning-of-line) (point))) @@ -9770,7 +9772,7 @@ If REVERSE, save parts that do not match TYPE." (if (setq f (cdr (assq 'after-method mime-acting-situation-to-override))) (eval f) - ))) + ))) (mime-add-condition 'action '((type . multipart) @@ -9789,7 +9791,7 @@ If REVERSE, save parts that do not match TYPE." (setq gnus-newsgroup-charset nil) (let* ((name (and gnus-newsgroup-name (gnus-group-real-name gnus-newsgroup-name))) - (ignored-charsets + (ignored-charsets (or gnus-newsgroup-ephemeral-ignored-charsets (append (and gnus-newsgroup-name @@ -9817,7 +9819,7 @@ If REVERSE, save parts that do not match TYPE." charset (cadr elem)))) charset))) gnus-default-charset)) - (set (make-local-variable 'gnus-newsgroup-ignored-charsets) + (set (make-local-variable 'gnus-newsgroup-ignored-charsets) ignored-charsets)))) ;;; @@ -9912,7 +9914,7 @@ treated as multipart/mixed." (defun gnus-wheel-install () "Enable mouse wheel support on summary window." (when gnus-use-wheel - (let ((keys + (let ((keys '([(mouse-4)] [(shift mouse-4)] [(mouse-5)] [(shift mouse-5)]))) (dolist (key keys) (define-key gnus-summary-mode-map key @@ -9941,10 +9943,10 @@ groups." (let ((armor-start (match-beginning 0))) (if (and (pgg-decrypt-region armor-start (point-max)) (or force (not (gnus-group-read-only-p)))) - (let ((inhibit-read-only t) + (let ((inhibit-read-only t) buffer-read-only) (delete-region armor-start - (progn + (progn (re-search-forward "^-+END PGP" nil t) (beginning-of-line 2) (point))) @@ -9994,8 +9996,8 @@ groups." mark (car lway) lway name))) (setq func (eval func)) (define-key map (nth 4 lway) func))))) - -(defun gnus-summary-make-marking-command-1 (mark way lway name) + +(defun gnus-summary-make-marking-command-1 (mark way lway name) `(defun ,(intern (format "gnus-summary-put-mark-as-%s%s" name (if (eq way 'nomove) @@ -10011,7 +10013,7 @@ returned." name (car (cdr lway))) (interactive "p") (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway)))) - + (defun gnus-summary-generic-mark (n mark move unread) "Mark N articles with MARK." (unless (eq major-mode 'gnus-summary-mode) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 5b70701..7d4c417 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -118,9 +118,9 @@ (static-cond ((fboundp 'point-at-bol) - (fset 'gnus-point-at-bol 'point-at-bol)) + (defalias 'gnus-point-at-bol 'point-at-bol)) ((fboundp 'line-beginning-position) - (fset 'gnus-point-at-bol 'line-beginning-position)) + (defalias 'gnus-point-at-bol 'line-beginning-position)) (t (defun gnus-point-at-bol () "Return point at the beginning of the line." @@ -132,9 +132,9 @@ )) (static-cond ((fboundp 'point-at-eol) - (fset 'gnus-point-at-eol 'point-at-eol)) + (defalias 'gnus-point-at-eol 'point-at-eol)) ((fboundp 'line-end-position) - (fset 'gnus-point-at-eol 'line-end-position)) + (defalias 'gnus-point-at-eol 'line-end-position)) (t (defun gnus-point-at-eol () "Return point at the end of the line." diff --git a/lisp/utf7.el b/lisp/utf7.el index 06416e9..7d6af42 100644 --- a/lisp/utf7.el +++ b/lisp/utf7.el @@ -4,7 +4,7 @@ ;; Author: Jon K Hellan ;; Keywords: mail -;; This file is part of GNU Emacs, but the same permissions apply +;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -24,35 +24,35 @@ ;;; 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 +;;; 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 +;;; 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. +;;; 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. +;;; an error is thrown. It is up to the application to recover. ;;; Code: (require 'base64) -(defvar utf7-direct-encoding-chars " -%'-*,-[]-}" - "Characters ranges which do not need escaping in UTF-7") +(defvar utf7-direct-encoding-chars " -%'-*,-[]-}" + "Character ranges which do not need escaping in UTF-7.") -(defvar utf7-imap-direct-encoding-chars +(defvar utf7-imap-direct-encoding-chars (concat utf7-direct-encoding-chars "+\\~") - "Characters ranges which do not need escaping in the IMAP variant of UTF-7") + "Character ranges which do not need escaping in the IMAP variant of UTF-7.") -(defsubst utf7-imap-get-pad-length (len modulus) +(defsubst utf7-imap-get-pad-length (len modulus) "Return required length of padding for IMAP modified base64 fragment." (mod (- len) modulus)) @@ -64,7 +64,7 @@ Use IMAP modification if FOR-IMAP is non-nil." (narrow-to-region start end) (goto-char start) (let ((esc-char (if for-imap ?& ?+)) - (direct-encoding-chars + (direct-encoding-chars (if for-imap utf7-imap-direct-encoding-chars utf7-direct-encoding-chars))) (while (not (eobp)) @@ -73,7 +73,7 @@ Use IMAP modification if FOR-IMAP is non-nil." (insert esc-char) (let ((p (point)) (fc (following-char)) - (run-length + (run-length (skip-chars-forward (concat "^" direct-encoding-chars)))) (if (and (= fc esc-char) (= run-length 1)) ; Lone esc-char? @@ -90,7 +90,7 @@ Use IMAP modification if FOR-IMAP is non-nil." (base64-encode-region start (point-max)) (goto-char start) (let ((pm (point-max))) - (when for-imap + (when for-imap (while (search-forward "/" nil t) (replace-match ","))) (skip-chars-forward "^= \t\n" pm) @@ -103,7 +103,7 @@ Use IMAP modification if FOR-IMAP is non-nil." (end (point-max))) (goto-char start) (let* ((esc-pattern (concat "^" (char-to-string (if for-imap ?& ?+)))) - (base64-chars (concat "A-Za-z0-9+" + (base64-chars (concat "A-Za-z0-9+" (char-to-string (if for-imap ?, ?/))))) (while (not (eobp)) (skip-chars-forward esc-pattern) @@ -159,7 +159,7 @@ Characters are in raw byte pairs in narrowed buffer." (forward-char))) (defun utf7-encode (string &optional for-imap) - "Encode UTF-7 string. Use IMAP modification if FOR-IMAP is non-nil." + "Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil." (let ((default-enable-multibyte-characters nil)) (with-temp-buffer (insert string) @@ -167,7 +167,7 @@ Characters are in raw byte pairs in narrowed buffer." (buffer-string)))) (defun utf7-decode (string &optional for-imap) - "Decode UTF-7 string. Use IMAP modification if FOR-IMAP is non-nil." + "Decode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil." (let ((default-enable-multibyte-characters nil)) (with-temp-buffer (insert string) -- 1.7.10.4