;; -*- mode: emacs-lisp; coding: hebrew-iso-8bit-unix; -*- ;; r-mail-x.el --- Added commands and changes to rmail ;; Copyright (C) 1992-2000 Ehud karni ;; This file is NOT part of GNU Emacs, distribution conditions below. ;; ;; EHUD KARNI ינרק דוהא ;; Ben Gurion st' 14 ןוירוג ןב 'חר ;; Kfar - Sava 44 257 אבס - רפכ ;; =================================== ;; 972-(0)9-7659599 ;; =================================== ;; RCS: $Id: r-mail-x.el,v 1.102 2000/03/05 12:40:35 ehud Exp ehud $ ;; ;; LOG: $Log: r-mail-x.el,v $ ;; Revision 1.102 2000/03/05 12:40:35 ehud ;; Add wrappers mail-send-ehud*, drop mime-quote-pr*, summary-delete-many. ;; Re-written metamail-buffer-ek. Minor reply bug fix. Keys changes. ;; ;; Revision 1.101 1998/11/11 11:59:38 ehud ;; Add rmail-get-new-mail-from-pop and functions for mime quoted printable, ;; Hack metamail-buffer for RMAIL. Last revision for 19.34. ;; ;; Revision 1.100 1998/03/11 13:15:05 ehud ;; Initial RCS version (19.34) ;; This program 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 of the License, or ;; (at your option) any later version. ;; ;; This program 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 this program; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (defun mail-send-ehud-exit ( ) "Bury buffer after sending" (interactive) (and (mail-send-ehud) (bury-buffer))) (defun mail-send-ehud ( ) "Remind to run spell checking before sending" (interactive) (flyspell-buffer) (and (yes-or-no-p "See the flyspell. Is the mail spelled OK") (let ((subj "(No Subject)")) (flyspell-delete-all-overlays) (save-excursion (goto-char (point-min)) (and (re-search-forward "^[Ss]ubject: " nil t) (setq subj (buffer-substring (point) (line-end-position))))) (call-interactively 'mail-send) (rename-buffer (concat "+mail-" subj "-sent+") 'unique)))) (defun mail-mode-SW () ;; fix ^S==>^_ ^Q==>^^ (define-key mail-mode-map "\C-c\C-^" 'mail-fill-yanked-message) (define-key mail-mode-map "\C-c\C-_" 'mail-send-ehud) (define-key mail-mode-map "\C-c\C-f\C-_" 'mail-subject) (define-key mail-mode-map "\C-ch" 'describe-mode) ;; Alt-m ==> ^C, Shift-Alt-m ==> ^C^F (define-key mail-mode-map (concat alted-key-prefix "M") "\C-c\C-f") (define-key mail-mode-map "\C-ch" 'describe-mode) ;; Add ^f-t/b/f/c/s and T/B/F/C/S instead of ^F^x (define-key mail-mode-map (concat alted-key-prefix "m?") 'describe-mode) (define-key mail-mode-map (concat alted-key-prefix "mh") 'describe-mode) (define-key mail-mode-map (concat alted-key-prefix "mt") 'mail-text) (define-key mail-mode-map (concat alted-key-prefix "my") 'mail-yank-original) (define-key mail-mode-map (concat alted-key-prefix "mq") 'mail-fill-yanked-message) (define-key mail-mode-map (concat alted-key-prefix "mw") 'mail-signature) (define-key mail-mode-map (concat alted-key-prefix "mv") 'mail-sent-via) (define-key mail-mode-map (concat alted-key-prefix "mc") 'mail-send-ehud-exit) (define-key mail-mode-map (concat alted-key-prefix "ms") 'mail-send-ehud) (define-key mail-mode-map (concat alted-key-prefix "mp") 'mail-mime-quote-printable) (define-key mail-mode-map (concat alted-key-prefix "mm") 'mail-mime-quote-printable-marked) (define-key mail-mode-map (concat alted-key-prefix "m\t") 'mail-complete) (define-key mail-mode-map (concat alted-key-prefix "mi") 'ispell-marked) (define-key mail-mode-map (concat alted-key-prefix "mf") 'flyspell-buffer) (define-key mail-mode-map [?\M-m ??] 'describe-mode) (define-key mail-mode-map [?\M-m ?h] 'describe-mode) (define-key mail-mode-map [?\M-m ?t] 'mail-text) (define-key mail-mode-map [?\M-m ?y] 'mail-yank-original) (define-key mail-mode-map [?\M-m ?q] 'mail-fill-yanked-message) (define-key mail-mode-map [?\M-m ?w] 'mail-signature) (define-key mail-mode-map [?\M-m ?v] 'mail-sent-via) (define-key mail-mode-map [?\M-m ?c] 'mail-send-ehud-exit) (define-key mail-mode-map [?\M-m ?s] 'mail-send-ehud) (define-key mail-mode-map [?\M-m ?p] 'mail-mime-quote-printable) (define-key mail-mode-map [?\M-m ?m] 'mail-mime-quote-printable-marked) (define-key mail-mode-map [?\M-m ?\t] 'mail-complete) (define-key mail-mode-map [?\M-m tab] 'mail-complete) (define-key mail-mode-map [?\M-m ?i] 'ispell-marked) (define-key mail-mode-map [?\M-m ?i] 'flyspell-buffer) (define-key mail-mode-map [?\A-m ??] 'describe-mode) (define-key mail-mode-map [?\A-m ?h] 'describe-mode) (define-key mail-mode-map [?\A-m ?t] 'mail-text) (define-key mail-mode-map [?\A-m ?y] 'mail-yank-original) (define-key mail-mode-map [?\A-m ?q] 'mail-fill-yanked-message) (define-key mail-mode-map [?\A-m ?w] 'mail-signature) (define-key mail-mode-map [?\A-m ?v] 'mail-sent-via) (define-key mail-mode-map [?\A-m ?c] 'mail-send-ehud-exit) (define-key mail-mode-map [?\A-m ?s] 'mail-send-ehud) (define-key mail-mode-map [?\A-m ?p] 'mail-mime-quote-printable) (define-key mail-mode-map [?\A-m ?m] 'mail-mime-quote-printable-marked) (define-key mail-mode-map [?\A-m ?\t] 'mail-complete) (define-key mail-mode-map [?\A-m tab] 'mail-complete) (define-key mail-mode-map [?\A-m ?i] 'ispell-marked) (define-key mail-mode-map [?\A-m ?i] 'flyspell-buffer) (setq mail-from-style nil) (setq sendmail-coding-system 'no-conversion) ) (add-hook 'mail-mode-hook 'mail-mode-SW) ;;change mail-mode-map (defun rmail-mode-SW () ;; fix ^S==>^_ ^Q==>^^ (define-key rmail-mode-map "\\" 'rmail-previous-same-subject) (define-key rmail-mode-map "=" 'rmail-next-same-subject) (define-key rmail-mode-map "\e\C-_" 'rmail-summary-by-regexp) (define-key rmail-mode-map "\C-r" 'rmail-resend-ek) (define-key rmail-mode-map "b" 'metamail-buffer-ek) (define-key rmail-mode-map "c" 'rmail-output-to-rmail-file) (define-key rmail-mode-map "m" 'rmail-move-to-rmail-file) (define-key rmail-mode-map "q" 'rmail-reply-qoute) (define-key rmail-mode-map "v" 'rmail-gpg-verify) (define-key rmail-mode-map "y" 'rmail-gpg-decrypt) (define-key rmail-mode-map "B" 'metamail-buffer-ek) (define-key rmail-mode-map "G" 'rmail-show-message) (define-key rmail-mode-map "Q" 'rmail-reply-qoute) (define-key rmail-mode-map "N" 'rmail-next-message) (define-key rmail-mode-map "L" 'rmail-next-labeled-message) (define-key rmail-mode-map "P" 'rmail-previous-message) (define-key rmail-mode-map "M" 'rmail-previous-labeled-message) (define-key rmail-mode-map "R" 'rmail-search-backwards) (define-key rmail-mode-map "S" 'rmail-search) (define-key rmail-mode-map "U" 'unforward-rmail-message) (define-key rmail-mode-map "V" 'rmail-gpg-verify) (define-key rmail-mode-map "Y" 'rmail-gpg-decrypt) ;; Alt-h ==> summary of various kinds (define-key rmail-mode-map (concat alted-key-prefix "hh") 'rmail-summary) (define-key rmail-mode-map (concat alted-key-prefix "hl") 'rmail-summary-by-labels) (define-key rmail-mode-map (concat alted-key-prefix "hr") 'rmail-summary-by-recipients) (define-key rmail-mode-map (concat alted-key-prefix "hs") 'rmail-summary-by-regexp) (define-key rmail-mode-map (concat alted-key-prefix "ht") 'rmail-summary-by-topic) (define-key rmail-mode-map [?\M-h ?h] 'rmail-summary) (define-key rmail-mode-map [?\M-h ?l] 'rmail-summary-by-labels) (define-key rmail-mode-map [?\M-h ?r] 'rmail-summary-by-recipients) (define-key rmail-mode-map [?\M-h ?s] 'rmail-summary-by-regexp) (define-key rmail-mode-map [?\M-h ?t] 'rmail-summary-by-topic) (define-key rmail-mode-map [?\A-h ?h] 'rmail-summary) (define-key rmail-mode-map [?\A-h ?l] 'rmail-summary-by-labels) (define-key rmail-mode-map [?\A-h ?r] 'rmail-summary-by-recipients) (define-key rmail-mode-map [?\A-h ?s] 'rmail-summary-by-regexp) (define-key rmail-mode-map [?\A-h ?t] 'rmail-summary-by-topic) ;; Alt-s ==> sort mail (various kinds) (define-key rmail-mode-map (concat alted-key-prefix "sd") 'rmail-sort-by-date) (define-key rmail-mode-map (concat alted-key-prefix "ss") 'rmail-sort-by-subject) (define-key rmail-mode-map (concat alted-key-prefix "sa") 'rmail-sort-by-author) (define-key rmail-mode-map (concat alted-key-prefix "sr") 'rmail-sort-by-recipient) (define-key rmail-mode-map (concat alted-key-prefix "sc") 'rmail-sort-by-correspondent) (define-key rmail-mode-map (concat alted-key-prefix "sl") 'rmail-sort-by-lines) (define-key rmail-mode-map (concat alted-key-prefix "sk") 'rmail-sort-by-keywords) (define-key rmail-mode-map [?\M-s ?d] 'rmail-sort-by-date) (define-key rmail-mode-map [?\M-s ?s] 'rmail-sort-by-subject) (define-key rmail-mode-map [?\M-s ?a] 'rmail-sort-by-author) (define-key rmail-mode-map [?\M-s ?r] 'rmail-sort-by-recipient) (define-key rmail-mode-map [?\M-s ?c] 'rmail-sort-by-correspondent) (define-key rmail-mode-map [?\M-s ?l] 'rmail-sort-by-lines) (define-key rmail-mode-map [?\M-s ?k] 'rmail-sort-by-keywords) (define-key rmail-mode-map [?\A-s ?d] 'rmail-sort-by-date) (define-key rmail-mode-map [?\A-s ?s] 'rmail-sort-by-subject) (define-key rmail-mode-map [?\A-s ?a] 'rmail-sort-by-author) (define-key rmail-mode-map [?\A-s ?r] 'rmail-sort-by-recipient) (define-key rmail-mode-map [?\A-s ?c] 'rmail-sort-by-correspondent) (define-key rmail-mode-map [?\A-s ?l] 'rmail-sort-by-lines) (define-key rmail-mode-map [?\A-s ?k] 'rmail-sort-by-keywords) (define-key rmail-mode-map [delete] 'rmail-delete-forward) ;; make [delete] act as "d" ;; Values needed (e.g. for resend) (setq sendmail-coding-system 'no-conversion) ) (add-hook 'rmail-mode-hook 'rmail-mode-SW) ;;change rmail-mode-map (defun rmail-move-to-rmail-file ( ) "Move the current message to an Rmail file (delete from this one) uses `rmail-output-to-rmail-file' function. See its help." (interactive) (let ((rmail-delete-after-output t)) (call-interactively 'rmail-output-to-rmail-file))) (defun rmail-summary-move-to-rmail-file ( ) "Move the current message to an Rmail file (delete from this one) Optional prefix arg N means move N next messages. uses `rmail-output-to-rmail-file' function. See its help." (interactive) (let ((rmail-delete-after-output t)) (save-excursion (set-buffer rmail-buffer) (call-interactively 'rmail-output-to-rmail-file))) (rmail-summary-next-msg 1)) ;; add function do delete many messages when in rmail summary ;; This function is not needed in 20.x (`rmail-summary-forward' does it) ;; (defun rmail-summary-delete-many (&optional n) ;; "delete current message, optional prefix arg N means delete N next msgs." ;; (interactive "P") ;; (let ((n (or n 1)) ;; (pos 0)) ;; (while (and (> n 0) ;; (< pos (point))) ;; (setq n (1- n)) ;; (setq pos (point)) ;; (rmail-summary-delete-forward))) ;; (rmail-summary-goto-msg)) (defun rmail-mode-summary-SW () (define-key rmail-summary-mode-map "m" 'rmail-summary-move-to-rmail-file) (define-key rmail-summary-mode-map "\\" 'rmail-summary-previous-same-subject) (define-key rmail-summary-mode-map "=" 'rmail-summary-next-same-subject) (define-key rmail-summary-mode-map "\C-r" 'rmail-resend-ek) (define-key rmail-summary-mode-map "b" 'metamail-buffer-ek) (define-key rmail-summary-mode-map "v" 'rmail-gpg-verify) (define-key rmail-summary-mode-map "y" 'rmail-gpg-decrypt) (define-key rmail-summary-mode-map "B" 'metamail-buffer-ek) (define-key rmail-summary-mode-map "G" 'rmail-summary-goto-msg) (define-key rmail-summary-mode-map "L" 'rmail-summary-next-labeled-message) (define-key rmail-summary-mode-map "M" 'rmail-summary-previous-labeled-message) (define-key rmail-summary-mode-map "R" 'rmail-summary-search-backward) (define-key rmail-summary-mode-map "S" 'rmail-summary-search) (define-key rmail-summary-mode-map "V" 'rmail-gpg-verify) (define-key rmail-summary-mode-map "Y" 'rmail-gpg-decrypt) (define-key rmail-summary-mode-map [delete] 'rmail-summary-delete-forward) ;;same as "d" ;; ;; set Alt-D to do it in rmail summary mode ;; (define-key rmail-summary-mode-map ;; (concat alted-key-prefix "d") 'rmail-summary-delete-many) ;; (define-key rmail-summary-mode-map (read-kbd-macro "M-d") 'rmail-summary-delete-many) ) (defun rmail-reply-qoute (just-sender) "Reply to the current message. Normally include CC: to all other recipients of original message; prefix argument means ignore them. While composing the reply, automaticly quotes original message into it." (interactive "P") (let ((buffer-read-only nil) (mail-reply-buffer (current-buffer)) (eom "*** EOOH ***\n") (txt "--text follows this line--\n") (odt " ") ; original date or 5 spaces (from "") ; original from added) ;; nil - not added (save-excursion (save-restriction (goto-char (point-min)) (if (re-search-forward "^[dD]ate: \\(.*\\)$" nil t) (setq odt (concat "On " (buffer-substring (match-beginning 1) (match-end 1)) ", "))) (goto-char (point-min)) (if (re-search-forward "^[fF]rom: \\(.*\\)$" nil t) (setq from (concat odt (buffer-substring (match-beginning 1) (match-end 1)) " wrote:\n"))) (and (not (search-forward eom nil 'eof)) (setq added (point)) ;save current point (insert-string "\n" eom)))) (rmail-reply just-sender) (if added (save-excursion (set-buffer mail-reply-buffer) (delete-region added (point-max)))) (goto-char (point-min)) (if (search-forward txt nil t) (save-excursion (insert-string from) (mail-yank-original 3)))) (setq buffer-read-only nil)) ;; POP mail file name: "pop://user:pass@host" (defun rmail-get-new-mail-from-pop (pop-host pop-user pop-pass) (interactive "sPOP host name: \nsUser name: \nsMail password: ") (let ((rmail-remote-password pop-pass) (pop-box-nm (concat "po:" pop-user ":" pop-host)) (rmail-remote-password-required t)) (if (eq major-mode 'rmail-mode) (rmail-get-new-mail pop-box-nm) (setq rmail-primary-inbox-list (list pop-box-nm)) (rmail)))) ## (if pop-pass ## (setq pop-pass (concat ":" pop-pass)) ;; add : before pass ## (setq pop-pass "")) ;; empty passwd ## (let ((pop-box-nm (concat "pop://" pop-user pop-pass "@" pop-host))) ## (if (eq major-mode 'rmail-mode) ## (rmail-get-new-mail pop-box-nm) ## (setq rmail-primary-inbox-list (list pop-box-nm)) ## (rmail)))) ;; (defun rmail-get-new-mail-from-pop (pop-host pop-user pop-pass) ;; "Get mail from pop serever into current rmail file ;; Accepts 3 parameters (strings): ;; POP-HOST - host name of pop serever ;; POP-USER - login name of mail user ;; POP-PASS - password of mail account" ;; (interactive "sPOP host name: \nsUser name: \nsMail password: ") ;; (let ((sv-host (getenv "MAILHOST")) ;; (sv-p-inbox rmail-primary-inbox-list) ;; (rmail-remote-password pop-pass) ;; (rmail-remote-password-required (not (null pop-pass))) ;; ) ;; (setq rmail-primary-inbox-list (list (concat "po:" pop-user))) ;; (setenv "MAILHOST" pop-host) ;; pop host name ;; (rmail) ;; get mail from pop (rmail) ;; (setq rmail-primary-inbox-list sv-p-inbox) ;; (setq rmail-pop-password sv-pass) ;; (setenv "MAILHOST" sv-host))) ;; restore host name (add-hook 'rmail-summary-mode-hook 'rmail-mode-summary-SW) ;;change rmail-summary-mode-map (defun metamail-buffer-ek (&optional viewmode buffer nodisplay) "Hacked by Ehud Karni for RMAIL.\n Process current buffer through `metamail'. Optional argument VIEWMODE specifies the value of the EMACS_VIEW_MODE environment variable (defaulted to 1). Optional argument BUFFER specifies a buffer to be filled (nil means current). Optional argument NODISPLAY non-nil means buffer is not redisplayed as output is inserted." (interactive "p") (cond ((eq major-mode 'rmail-mode) (rmail-edit-current-message)) ((eq major-mode 'rmail-summary-mode) (rmail-summary-edit-current-message)) ) (let* (STR pos buffer-read-only (CT "Content-Type") (IGN (concat "^\\(" CT "\\|Content-Transfer-Encoding\\|X-MS-TNEF-Correlator" "\\|X-Mailer\\|X-MIME-Autoconverted\\): ")) right2left-on) (goto-char (point-min)) (if (search-forward (concat CT ": application/ms-tnef") nil t) (progn (forward-line -1) (setq pos (point)) (end-of-line) (setq STR (buffer-substring pos (point))) (search-forward STR) (beginning-of-line) (delete-region pos (point)))) (goto-char (point-min)) (and (re-search-forward (concat "[" unicode-ignore-chars "]") nil t) (save-restriction (beginning-of-line) (narrow-to-region (point) (point-max)) (winvert-all-lines))) (goto-char (point-min)) (search-forward "Received:" nil t) (and (re-search-forward "^\\(Repl\\|[a-qs-zA-QS-Z]\\)[^:]+: " nil t) (beginning-of-line)) (metamail-region (point) (1- (point-max)) viewmode buffer nodisplay) (goto-char (point-min)) ;;;; (while (re-search-forward "\\(\\[\\*\\* \\(windows\\|WINDOWS\\)-1255 charset \\*\\*\\] \\)\\(.*\\)$" nil t) (setq right2left-on t) (while (re-search-forward "\\(\\[\\*\\* \\(\\(\\(iso\\|ISO\\)-8859-8\\)\\|[wW]\\(indows\\|INDOWS\\)-1255\\) charset \\*\\*\\] \\)\\(.*\\)$" nil t) (progn (setq STR (buffer-substring (match-beginning 6) (match-end 0))) (replace-match "") (insert (winvert-string STR)))) (while (re-search-forward IGN nil t) (beginning-of-line) (setq pos (point)) (forward-line 1) (delete-region pos (point)) (goto-char (point-min))))) (defun rmail-resend-ek (address &optional from comment mail-alias-file) "Hacked `rmail-resend' (from 21.2/lisp/mail) by Ehud Karni Resend current message to ADDRESSES. ADDRESSES should be a single address, a string consisting of several addresses separated by commas, or a list of addresses." (interactive "sResend to: ") (let* ((cbuf (current-buffer)) (tembuf (generate-new-buffer " sendmail temp")) mailbuf case-fold-search right2left-on) (cond ((eq major-mode 'rmail-mode) (rmail-edit-current-message) (setq mailbuf (current-buffer))) ((eq major-mode 'rmail-summary-mode) (rmail-summary-edit-current-message) (setq mailbuf (current-buffer))) ;; (t (error "Not an Rmail buffer")) ) (unwind-protect (with-current-buffer tembuf (insert-buffer-substring (if mailbuf mailbuf cbuf)) (goto-char (point-min)) (if (search-forward "Mail-from: " nil t) (shell-command-on-region (point) (point-max) (concat "sendmail -odb -oem -oi " address)) (error "Mail-from: header not found"))) (kill-buffer tembuf) (if mailbuf (with-current-buffer mailbuf (rmail-cease-edit) (rmail-set-attribute "resent" t rmail-current-message)))) (pop-to-buffer cbuf))) (defun rmail-gpg-decrypt () "Use gpg to decrypt gnupg/pgp mail message." (interactive) (let* ((cbuf (current-buffer)) BPM EPM mailbuf case-fold-search right2left-on) (cond ((eq major-mode 'rmail-mode) (rmail-edit-current-message) (setq mailbuf (current-buffer))) ((eq major-mode 'rmail-summary-mode) (rmail-summary-edit-current-message) (setq mailbuf (current-buffer))) ) (goto-char (point-min)) (insert "\n") (goto-char (point-min)) (while (search-forward "\n-----BEGIN PGP MESSAGE-----" nil t) (beginning-of-line) (setq BPM (point)) (search-forward "\n-----END PGP MESSAGE-----\n") (setq EPM (point)) (message "Region is %d-%d" BPM EPM) (shell-command-on-region BPM EPM "gpg --no-tty --decrypt" t t ;; in current buffer, replace region "*Shell Command Errors*")) (goto-char (point-min)) (delete-char 1) (if mailbuf (with-current-buffer mailbuf (rmail-cease-edit))) (pop-to-buffer cbuf) ;; (switch-to-buffer-other-window "*Shell Command Output*") (display-message-or-buffer (get-buffer "*Shell Command Errors*")))) (defun rmail-gpg-verify () "Use gpg to verify gnupg/pgp signature." (interactive) (let* ((cbuf (current-buffer)) EXT mailbuf case-fold-search right2left-on) (cond ((eq major-mode 'rmail-mode) (rmail-edit-current-message) (setq mailbuf (current-buffer))) ((eq major-mode 'rmail-summary-mode) (rmail-summary-edit-current-message) (setq mailbuf (current-buffer))) ) (setq EXT (shell-command-on-region (point-min) (point-max) "gpg --no-tty --verify")) (if mailbuf (with-current-buffer mailbuf (rmail-cease-edit))) (pop-to-buffer cbuf) (if (= EXT 0 ) (message "gpg signature verified") (display-message-or-buffer (get-buffer "*Shell Command Output*"))))) (defun rmail-show-message (&optional n no-summary) "Show message number N (prefix argument), counting from start of file. If summary buffer is currently displayed, update current message there also." (interactive "p") (or (eq major-mode 'rmail-mode) (switch-to-buffer rmail-buffer)) (rmail-maybe-set-message-counters) (widen) (if (zerop rmail-total-messages) (progn (narrow-to-region (point-min) (1- (point-max))) (goto-char (point-min)) (setq mode-line-process nil)) (let (blurb coding-system) (if (not n) (setq n rmail-current-message) (cond ((<= n 0) (setq n 1 rmail-current-message 1 blurb "No previous message")) ((> n rmail-total-messages) (setq n rmail-total-messages rmail-current-message rmail-total-messages blurb "No following message")) (t (setq rmail-current-message n)))) (let ((beg (rmail-msgbeg n))) (goto-char beg) (forward-line 1) (save-excursion (let ((end (rmail-msgend n))) (save-restriction (if (prog1 (= (following-char) ?0) (forward-line 2) ;; If there's a Summary-line in the (otherwise empty) ;; header, we didn't yet get past the EOOH line. (if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") (forward-line 1)) (narrow-to-region (point) end)) (rfc822-goto-eoh) (search-forward "\n*** EOOH ***\n" end t)) (narrow-to-region beg (point)) (goto-char (point-min)) (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) (let ((coding-system (intern (match-string 1)))) (check-coding-system coding-system) (setq buffer-file-coding-system coding-system)) (setq buffer-file-coding-system nil))))) ;; Clear the "unseen" attribute when we show a message. (rmail-set-attribute "unseen" nil) (let ((end (rmail-msgend n))) ;; Reformat the header, or else find the reformatted header. (if (= (following-char) ?0) (rmail-reformat-message beg end) (search-forward "\n*** EOOH ***\n" end t) (narrow-to-region (point) end))) (goto-char (point-min)) (rmail-display-labels) (if (and (eq rmail-enable-mime t) rmail-show-mime-function) (funcall rmail-show-mime-function) (setq rmail-view-buffer rmail-buffer) ) (rmail-highlight-headers) (if transient-mark-mode (deactivate-mark)) (run-hooks 'rmail-show-message-hook) ;; If there is a summary buffer, try to move to this message ;; in that buffer. But don't complain if this message ;; is not mentioned in the summary. ;; Don't do this at all if we were called on behalf ;; of cursor motion in the summary buffer. (and (rmail-summary-exists) (not no-summary) (let ((curr-msg rmail-current-message)) (rmail-select-summary (rmail-summary-goto-msg curr-msg t t)))) (if blurb (message blurb)))))) ;; msg-to 'blue-under font-lock-type-face ;; msg-list font-lock-keyword-face ;; msg-subject blue-bold ;; msg-from purple-bold ;; msg-header firebrick-bold font-lock-header-face ;; msg-separator black/tan-bold ;; msg-quote ForestGreen pink italic) ;; --- blue-bold font-lock-message-subject ;; --- purple-bold font-lock-message-from ;; --- black/tan-bold font-lock-separator ;; --- url font-lock-url-face ;; ---- quote font-lock-builtin-face (not comment) ;; change many message-modes ======================================================== ;; + ((bod '(("\\(mailto:\\|http:\\|ftp:\\|[Ss][Mm][Tt][Pp]:\\)[-a-zA-Z0-9/_\.~@]*" 0 font-lock-url-face) ;; + ("^\\(In article\\|[ \t]*\\w*[]<>}|]\\).*$" 0 font-lock-constant-face ;; (hdr '(("^[A-Za-z][A-Za-z0-9-]+:" 0 ;; ("^[Tt]o: .*$" 0 font-lock-type-face ;; ("^[Cc][Cc]: .*$" 0 font-lock-type-face ;; ("^[Rr]eply-[Tt]o: .*$" 0 font-lock-type-face ;; ("^[Nn]ewsgroups: .*$" 0 font-lock-type-face ;; ("^[Rr]eceived-by-user:.*$" 0 font-lock-redef-face ;; ("^[Ss]ubject:.*$" 0 font-lock-message-subject ;; ("^[Ff]rom:.*$" 0 font-lock-message-from ;; + ("^X-[Ll]\\(ist\\|oop\\):.*$" 0 font-lock-keyword-face ;; + ("^[Mm]ail[^-]*-[Ll]ist: .*$" 0 font-lock-keyword-face ;; + ("^[Ll]ist-[Pp]ost: .*$" 0 font-lock-keyword-face ;; ("^--text follows this line--$" 0 font-lock-separator ;; (pat (append hdr bod))) ;; body + header ;; ;; ;; (hilit-set-mode-patterns 'msg-header hdr) ;; (hilit-set-mode-patterns 'msg-body bod) ;; (hilit-set-mode-patterns '(text-mode mail-mode rmail-mode gnus-article-mode news-reply-mode) ;; pat 'hilit-rehighlight-message)) (setq rmail-font-lock-keywords '( ;; headers ("^[^Xx][a-zA-Z-]*: " . font-lock-header-face) ("^\\([Ff]rom\\|[Ss]ender\\|[Rr]eply-[Tt]o\\): \\(.*\\)$" (2 font-lock-message-from nil t)) ("^\\([Ss]ubject\\): \\(.*\\)$" (2 font-lock-message-subject nil t)) ("^\\([Tt]o\\|[Aa]pparently-[Tt]o\\|[Cc]c\\): \\(.*\\)$" (2 font-lock-keyword-face nil t)) ("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\): .*$" (0 font-lock-string-face t t)) ("^\\(X-[Ll]\\(ist\\|oop\\)\\|\\([Mm]ail[^-]*-[Ll]ist\\)\\|\\([Ll]ist-[Pp]ost\\)\\|[Nn]ewsgroups\\): \\(.*\\)$" (5 font-lock-warning-face t t)) ;; body ("\\(mailto:\\|http[s]?:\\|ftp:\\|[Ss][Mm][Tt][Pp]:\\)\\([^] \t\n)>]*\\)" (1 font-lock-type-face nil t) (2 font-lock-url-face nil t)) ("^\\(In article\\|[ \t]*\\w*[]<>}|]\\).*$" . font-lock-constant-face) ("^[ \t]*[a-zA-Z]*[ ]*[>|}]" ;; quoted ("\\=[ \t]*\\(\\([A-Za-z]+[A-Za-z0-9_.@-`'\"]*\\)?\\([>|}][ \t]*\\)\\)+\\(.*\\)" (beginning-of-line) (end-of-line) (2 font-lock-constant-face nil t) (4 font-lock-builtin-face nil t) )) )) ;; (setq font-lock-message-subject 'custom-button-face) ;; (setq font-lock-message-subject 'font-lock-message-subject) ;;========================= end of r-mail-x.el =================================