Mercurial > emacs
view lisp/gnus/mml1991.el @ 63480:53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Remove "-face" suffix from gnus faces
2005-06-16 Miles Bader <miles@gnu.org>
* lisp/gnus/spam.el (spam): Remove "-face" suffix from face name.
(spam-face): New backward-compatibility alias for renamed face.
(spam-face, spam-initialize): Use renamed spam face.
* lisp/gnus/message.el (message-header-to, message-header-cc)
(message-header-subject, message-header-newsgroups)
(message-header-other, message-header-name)
(message-header-xheader, message-separator, message-cited-text)
(message-mml): Remove "-face" suffix from face names.
(message-header-to-face, message-header-cc-face)
(message-header-subject-face, message-header-newsgroups-face)
(message-header-other-face, message-header-name-face)
(message-header-xheader-face, message-separator-face)
(message-cited-text-face, message-mml-face):
New backward-compatibility aliases for renamed faces.
(message-font-lock-keywords): Use renamed message faces.
* lisp/gnus/sieve-mode.el (sieve-control-commands, sieve-action-commands)
(sieve-test-commands, sieve-tagged-arguments):
Remove "-face" suffix from face names.
(sieve-control-commands-face, sieve-action-commands-face)
(sieve-test-commands-face, sieve-tagged-arguments-face):
New backward-compatibility aliases for renamed faces.
(sieve-control-commands-face, sieve-action-commands-face)
(sieve-test-commands-face, sieve-tagged-arguments-face):
Use renamed sieve faces.
* lisp/gnus/gnus.el (gnus-group-news-1, gnus-group-news-1-empty)
(gnus-group-news-2, gnus-group-news-2-empty, gnus-group-news-3)
(gnus-group-news-3-empty, gnus-group-news-4)
(gnus-group-news-4-empty, gnus-group-news-5)
(gnus-group-news-5-empty, gnus-group-news-6)
(gnus-group-news-6-empty, gnus-group-news-low)
(gnus-group-news-low-empty, gnus-group-mail-1)
(gnus-group-mail-1-empty, gnus-group-mail-2)
(gnus-group-mail-2-empty, gnus-group-mail-3)
(gnus-group-mail-3-empty, gnus-group-mail-low)
(gnus-group-mail-low-empty, gnus-summary-selected)
(gnus-summary-cancelled, gnus-summary-high-ticked)
(gnus-summary-low-ticked, gnus-summary-normal-ticked)
(gnus-summary-high-ancient, gnus-summary-low-ancient)
(gnus-summary-normal-ancient, gnus-summary-high-undownloaded)
(gnus-summary-low-undownloaded)
(gnus-summary-normal-undownloaded, gnus-summary-high-unread)
(gnus-summary-low-unread, gnus-summary-normal-unread)
(gnus-summary-high-read, gnus-summary-low-read)
(gnus-summary-normal-read, gnus-splash):
Remove "-face" suffix from face names.
(gnus-group-news-1-face, gnus-group-news-1-empty-face)
(gnus-group-news-2-face, gnus-group-news-2-empty-face)
(gnus-group-news-3-face, gnus-group-news-3-empty-face)
(gnus-group-news-4-face, gnus-group-news-4-empty-face)
(gnus-group-news-5-face, gnus-group-news-5-empty-face)
(gnus-group-news-6-face, gnus-group-news-6-empty-face)
(gnus-group-news-low-face, gnus-group-news-low-empty-face)
(gnus-group-mail-1-face, gnus-group-mail-1-empty-face)
(gnus-group-mail-2-face, gnus-group-mail-2-empty-face)
(gnus-group-mail-3-face, gnus-group-mail-3-empty-face)
(gnus-group-mail-low-face, gnus-group-mail-low-empty-face)
(gnus-summary-selected-face, gnus-summary-cancelled-face)
(gnus-summary-high-ticked-face, gnus-summary-low-ticked-face)
(gnus-summary-normal-ticked-face)
(gnus-summary-high-ancient-face, gnus-summary-low-ancient-face)
(gnus-summary-normal-ancient-face)
(gnus-summary-high-undownloaded-face)
(gnus-summary-low-undownloaded-face)
(gnus-summary-normal-undownloaded-face)
(gnus-summary-high-unread-face, gnus-summary-low-unread-face)
(gnus-summary-normal-unread-face, gnus-summary-high-read-face)
(gnus-summary-low-read-face, gnus-summary-normal-read-face)
(gnus-splash-face):
New backward-compatibility aliases for renamed faces.
(gnus-group-startup-message): Use renamed gnus faces.
* lisp/gnus/gnus-srvr.el (gnus-server-agent, gnus-server-opened)
(gnus-server-closed, gnus-server-denied, gnus-server-offline)
(gnus-server-agent): Remove "-face" suffix from face names.
(gnus-server-agent-face, gnus-server-opened-face)
(gnus-server-closed-face, gnus-server-denied-face)
(gnus-server-offline-face):
New backward-compatibility aliases for renamed faces.
(gnus-server-agent-face, gnus-server-opened-face)
(gnus-server-closed-face, gnus-server-denied-face)
(gnus-server-offline-face): Use renamed gnus faces.
* lisp/gnus/gnus-picon.el (gnus-picon-xbm, gnus-picon):
Remove "-face" suffix from face names.
(gnus-picon-xbm-face, gnus-picon-face):
New backward-compatibility aliases for renamed faces.
* lisp/gnus/gnus-cite.el (gnus-cite-attribution, gnus-cite-1, gnus-cite-2)
(gnus-cite-3, gnus-cite-4, gnus-cite-5, gnus-cite-6)
(gnus-cite-7, gnus-cite-8, gnus-cite-9, gnus-cite-10)
(gnus-cite-11): Remove "-face" suffix from face names.
(gnus-cite-attribution-face, gnus-cite-face-1, gnus-cite-face-2)
(gnus-cite-face-3, gnus-cite-face-4, gnus-cite-face-5)
(gnus-cite-face-6, gnus-cite-face-7, gnus-cite-face-8)
(gnus-cite-face-9, gnus-cite-face-10, gnus-cite-face-11):
New backward-compatibility aliases for renamed faces.
(gnus-cite-attribution-face, gnus-cite-face-list)
(gnus-article-boring-faces): Use renamed gnus faces.
* lisp/gnus/gnus-art.el (gnus-signature, gnus-header-from)
(gnus-header-subject, gnus-header-newsgroups, gnus-header-name)
(gnus-header-content): Remove "-face" suffix from face names.
(gnus-signature-face, gnus-header-from-face)
(gnus-header-subject-face, gnus-header-newsgroups-face)
(gnus-header-name-face, gnus-header-content-face):
New backward-compatibility aliases for renamed faces.
(gnus-signature-face, gnus-header-face-alist): Use renamed gnus faces.
* lisp/gnus/gnus-sum.el (gnus-summary-selected-face)
(gnus-summary-highlight): Use renamed gnus faces.
* lisp/gnus/gnus-group.el (gnus-group-highlight): Likewise.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Thu, 16 Jun 2005 03:48:20 +0000 |
parents | 11d53dd5abd9 |
children | 18a818a2ee7c |
line wrap: on
line source
;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML ;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2005 ;; Free Software Foundation, Inc. ;; Author: Sascha Lüdecke <sascha@meta-x.de>, ;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue) ;; Keywords PGP ;; 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 ;; 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: ;;; Code: (eval-when-compile (require 'cl) (require 'mm-util)) (autoload 'quoted-printable-decode-region "qp") (autoload 'quoted-printable-encode-region "qp") (defvar mml1991-use mml2015-use "The package used for PGP.") (defvar mml1991-function-alist '((mailcrypt mml1991-mailcrypt-sign mml1991-mailcrypt-encrypt) (gpg mml1991-gpg-sign mml1991-gpg-encrypt) (pgg mml1991-pgg-sign mml1991-pgg-encrypt)) "Alist of PGP functions.") ;;; mailcrypt wrapper (eval-and-compile (autoload 'mc-sign-generic "mc-toplev")) (defvar mml1991-decrypt-function 'mailcrypt-decrypt) (defvar mml1991-verify-function 'mailcrypt-verify) (defun mml1991-mailcrypt-sign (cont) (let ((text (current-buffer)) headers signature (result-buffer (get-buffer-create "*GPG Result*"))) ;; Save MIME Content[^ ]+: headers from signing (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (setq headers (buffer-string)) (delete-region (point-min) (point))) (goto-char (point-max)) (unless (bolp) (insert "\n")) (quoted-printable-decode-region (point-min) (point-max)) (with-temp-buffer (setq signature (current-buffer)) (insert-buffer-substring text) (unless (mc-sign-generic (message-options-get 'message-sender) nil nil nil nil) (unless (> (point-max) (point-min)) (pop-to-buffer result-buffer) (error "Sign error"))) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) (quoted-printable-encode-region (point-min) (point-max)) (set-buffer text) (delete-region (point-min) (point-max)) (if headers (insert headers)) (insert "\n") (insert-buffer-substring signature) (goto-char (point-max))))) (defun mml1991-mailcrypt-encrypt (cont &optional sign) (let ((text (current-buffer)) (mc-pgp-always-sign (or mc-pgp-always-sign sign (eq t (or (message-options-get 'message-sign-encrypt) (message-options-set 'message-sign-encrypt (or (y-or-n-p "Sign the message? ") 'not)))) 'never)) cipher (result-buffer (get-buffer-create "*GPG Result*"))) ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (delete-region (point-min) (point))) (mm-with-unibyte-current-buffer (with-temp-buffer (setq cipher (current-buffer)) (insert-buffer-substring text) (unless (mc-encrypt-generic (or (message-options-get 'message-recipients) (message-options-set 'message-recipients (read-string "Recipients: "))) nil (point-min) (point-max) (message-options-get 'message-sender) 'sign) (unless (> (point-max) (point-min)) (pop-to-buffer result-buffer) (error "Encrypt error"))) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) (set-buffer text) (delete-region (point-min) (point-max)) ;;(insert "Content-Type: application/pgp-encrypted\n\n") ;;(insert "Version: 1\n\n") (insert "\n") (insert-buffer-substring cipher) (goto-char (point-max)))))) ;;; gpg wrapper (eval-and-compile (autoload 'gpg-sign-cleartext "gpg")) (defun mml1991-gpg-sign (cont) (let ((text (current-buffer)) headers signature (result-buffer (get-buffer-create "*GPG Result*"))) ;; Save MIME Content[^ ]+: headers from signing (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (setq headers (buffer-string)) (delete-region (point-min) (point))) (goto-char (point-max)) (unless (bolp) (insert "\n")) (quoted-printable-decode-region (point-min) (point-max)) (with-temp-buffer (unless (gpg-sign-cleartext text (setq signature (current-buffer)) result-buffer nil (message-options-get 'message-sender)) (unless (> (point-max) (point-min)) (pop-to-buffer result-buffer) (error "Sign error"))) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) (quoted-printable-encode-region (point-min) (point-max)) (set-buffer text) (delete-region (point-min) (point-max)) (if headers (insert headers)) (insert "\n") (insert-buffer-substring signature) (goto-char (point-max))))) (defun mml1991-gpg-encrypt (cont &optional sign) (let ((text (current-buffer)) cipher (result-buffer (get-buffer-create "*GPG Result*"))) ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (delete-region (point-min) (point))) (mm-with-unibyte-current-buffer (with-temp-buffer (flet ((gpg-encrypt-func (sign plaintext ciphertext result recipients &optional passphrase sign-with-key armor textmode) (if sign (gpg-sign-encrypt plaintext ciphertext result recipients passphrase sign-with-key armor textmode) (gpg-encrypt plaintext ciphertext result recipients passphrase armor textmode)))) (unless (gpg-encrypt-func sign text (setq cipher (current-buffer)) result-buffer (split-string (or (message-options-get 'message-recipients) (message-options-set 'message-recipients (read-string "Recipients: "))) "[ \f\t\n\r\v,]+") nil (message-options-get 'message-sender) t t) ; armor & textmode (unless (> (point-max) (point-min)) (pop-to-buffer result-buffer) (error "Encrypt error")))) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) (set-buffer text) (delete-region (point-min) (point-max)) ;;(insert "Content-Type: application/pgp-encrypted\n\n") ;;(insert "Version: 1\n\n") (insert "\n") (insert-buffer-substring cipher) (goto-char (point-max)))))) ;; pgg wrapper (eval-when-compile (defvar pgg-default-user-id) (defvar pgg-errors-buffer) (defvar pgg-output-buffer)) (defun mml1991-pgg-sign (cont) (let (headers cte) ;; Don't sign headers. (goto-char (point-min)) (while (not (looking-at "^$")) (forward-line)) (unless (eobp) ;; no headers? (setq headers (buffer-substring (point-min) (point))) (forward-line) ;; skip header/body separator (delete-region (point-min) (point))) (when (string-match "^Content-Transfer-Encoding: \\(.+\\)" headers) (setq cte (intern (match-string 1 headers)))) (mm-decode-content-transfer-encoding cte) (unless (let ((pgg-default-user-id (or (message-options-get 'mml-sender) pgg-default-user-id))) (pgg-sign-region (point-min) (point-max) t)) (pop-to-buffer pgg-errors-buffer) (error "Encrypt error")) (delete-region (point-min) (point-max)) (mm-with-unibyte-current-buffer (insert-buffer-substring pgg-output-buffer) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) (mm-encode-content-transfer-encoding cte) (goto-char (point-min)) (when headers (insert headers)) (insert "\n")) t)) (defun mml1991-pgg-encrypt (cont &optional sign) (let (cte) ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (when (looking-at "^Content-Transfer-Encoding: \\(.+\\)") (setq cte (intern (match-string 1)))) (forward-line)) (unless (bobp) (delete-region (point-min) (point))) (mm-decode-content-transfer-encoding cte) (unless (pgg-encrypt-region (point-min) (point-max) (split-string (or (message-options-get 'message-recipients) (message-options-set 'message-recipients (read-string "Recipients: "))) "[ \f\t\n\r\v,]+") sign) (pop-to-buffer pgg-errors-buffer) (error "Encrypt error")) (delete-region (point-min) (point-max)) ;;(insert "Content-Type: application/pgp-encrypted\n\n") ;;(insert "Version: 1\n\n") (insert "\n") (insert-buffer-substring pgg-output-buffer) t)) ;;;###autoload (defun mml1991-encrypt (cont &optional sign) (let ((func (nth 2 (assq mml1991-use mml1991-function-alist)))) (if func (funcall func cont sign) (error "Cannot find encrypt function")))) ;;;###autoload (defun mml1991-sign (cont) (let ((func (nth 1 (assq mml1991-use mml1991-function-alist)))) (if func (funcall func cont) (error "Cannot find sign function")))) (provide 'mml1991) ;; Local Variables: ;; coding: iso-8859-1 ;; End: ;;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706 ;;; mml1991.el ends here