;; -*- emacs-lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; $Id: gnus_message.el,v 1.21 2006-11-06 21:02:42 rscholz Exp $ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Einstellungen für den Message Mode und MIME ;; ;; Die offizielle Quelle dieser Datei ist ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Verhalten beim Senden / Nachfragen (Info-goto-node "(Message)Variables") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SMTP-Dialog bei Fehlern (setq message-interactive t) ;; CC's bestätigen lassen (setq message-wide-reply-confirm-recipients t) ;; Buffer mit geschriebener Mail / News nach Senden löschen (setq message-kill-buffer-on-exit t) ;; kein Envelope-From durch Gnus setzen (setq message-sendmail-f-is-evil t) ;; leere Artikel posten können (setq message-shoot-gnksa-feet '(empty-article)) ;; C-a setzt den Cursor an den Anfang der Zeile, nicht an den Anfang ;; des Header-Inhalts (ab Gnus 5.10) (setq message-beginning-of-line nil) ;; Keine Mails aufsplitten, wenn sie zu groß werden. Einige MUA haben ;; Probleme, diese mit vernünftigem Aufwand wieder zusammenzusetzen. (setq message-send-mail-partially-limit nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Header ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Header beim Erstellen verstecken (setq message-hidden-headers '("^X-Face" "^References" "^X-Draft-From")) ;(setq message-hidden-headers ; '(not "^From" "^Subject" "^To" "^Cc" "^Newsgroups")) ;; User-Agent anpassen (ab Gnus 5.10) ;(setq gnus-user-agent 'gnus) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Mail-Followup-To (Info-goto-node "(Message)Mailing Lists") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mail-Followup-To-Header setzen (ab Gnus 5.10) (setq message-subscribed-address-functions '(gnus-find-subscribed-addresses)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Encoding ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 8bit-Codierung erzwingen (add-to-list 'mm-body-charset-encoding-alist '(iso-8859-1 . 8bit)) (if (mm-coding-system-p 'iso-8859-15) (add-to-list 'mm-body-charset-encoding-alist '(iso-8859-15 . 8bit))) ;; QP-Codierung für UTF-8 erzwingen (if (mm-coding-system-p 'utf-8) (add-to-list 'mm-body-charset-encoding-alist '(utf-8 . quoted-printable))) ;; dito, aber Unterscheidung von Mail und News bzw. für bestimmte ;; Gruppen (obige Definition muss dann auskommentiert werden) ;(add-to-list 'gnus-group-posting-charset-alist ; '(message-this-is-mail nil (iso-8859-1))) ;(add-to-list 'gnus-group-posting-charset-alist ; '(message-this-is-news nil (iso-8859-1))) ;; generelle QP-Codierung und sonst auch sichere Codierung erzwingen ;(setq mm-use-ultra-safe-encoding t) ;; bei mehr als einer möglichen Kodierung beachten (setq mm-coding-system-priorities '(iso-latin-1 iso-latin-9 windows-1252 mule-utf-8)) ;; Kai Grossjohann in Nur ;; nötig, falls der von Gnus genutzte (X)Emacs kein iso-8859-15 kennt, ;; dann wird iso-8859-15 als iso-8859-1 dargestellt (besser als nix). (unless (mm-coding-system-p 'iso-8859-15) (require 'mm-util) (add-to-list 'mm-charset-synonym-alist '(iso-8859-15 . iso-8859-1))) ;; Multipart-Mails gegenüber Unicode-Mails bevorzugen ;;(setq mm-use-find-coding-systems-region nil) ;; Multipart-Mails ohne Nachfrage verschicken ;;(setq mml-confirmation-set '(multipart)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Sender- und Message-ID-Header ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Message-ID selbst basteln ;(defun message-make-message-id () ; (concat "<"(message-unique-id)"@" (symbol-value 'mail-host-address) ">")) ;; Message-ID nicht erzeugen (macht dann der News-/Mailserver) ;(setq message-required-news-headers ; (delq 'Message-ID message-required-news-headers)) ;(setq message-required-mail-headers ; (delq 'Message-ID message-required-mail-headers)) ;; Sender:-Header nicht erzeugen ;; fuer Cancel oder Supersede mit Gnus < 5.10 notwendig (add-to-list 'message-syntax-checks '(sender . disabled)) ;; für Message-ID-Generierung (if (string-match "home" zonix-location) (setq mail-host-address "hush.zonix.de") (setq mail-host-address system-name)) ;; Sender selbst basteln (defun message-make-sender () (concat (user-login-name) "@" mail-host-address)) (defvar zonix-default-group-name nil "Gruppe, die als Default verwendet wird, falls die aktuell ausgewählte Gruppe nicht ermittelt werden kann.") (if (string-match "home" zonix-location) (setq zonix-default-group-name "nnimap:INBOX")) (if (string-match "verified" zonix-location) (setq zonix-default-group-name "nnmaildir:INBOX")) (defun zonix-get-group-name () "Returns the name of the current group (or the group the cursor resides on) or the value of `zonix-default-group-name' if the former inquiries failed." (or (gnus-group-group-name) gnus-newsgroup-name zonix-default-group-name)) ;; Kurzname der Gruppe (defun zonix-short-group-name () (replace-regexp-in-string "\\." "" (gnus-short-group-name (gnus-group-real-name (zonix-get-group-name)) 0))) ;; Message-ID selbst basteln, so dass der Kurzname der Gruppe ;; eingebaut wird. (defun message-make-message-id () (concat "<" (zonix-short-group-name) "." (message-unique-id) "@" (message-make-fqdn) ">")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Zitieren ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Signatur nicht mitzitieren (setq message-cite-function 'message-cite-original-without-signature) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (set-face-foreground 'message-cited-text-face "DarkSlateBlue") (set-face-foreground 'message-header-subject-face "firebrick") (set-face-foreground 'message-header-to-face "MidnightBlue") (set-face-foreground 'message-header-other-face "DarkGreen") (modify-face 'message-header-cc-face "DarkGreen" nil nil t nil nil) (modify-face 'message-header-name-face "DarkGreen" nil nil t nil nil) (modify-face 'message-mml-face "Black" nil nil t nil nil) ;; Zitierebenen wie im Article Buffer farblich unterscheiden ;; Oliver Scholz in (eval-when-compile (require 'gnus-cite) (require 'message)) (defconst egoge-max-citation-depth (eval-when-compile (length gnus-cite-face-list)) "Maximum supported level of citation.") (defun egoge-search-citation-line (limit) "Search for a cited line and set match data accordingly. Returns nil if there is no such line before LIMIT, t otherwise." (when (re-search-forward (eval-when-compile (concat "^\\(?:" message-cite-prefix-regexp "\\)")) limit t) (let ((cdepth (length (apply 'concat (split-string (match-string-no-properties 0) "[ \t [:alnum:]]+")))) (mlist (make-list (* (1+ egoge-max-citation-depth) 2) 0))) (setcar (nthcdr (* cdepth 2) mlist) (line-beginning-position)) (setcar (nthcdr (1+ (* cdepth 2)) mlist) (line-end-position)) (set-match-data mlist)) t)) (defvar egoge-citation-x-keywords (eval-when-compile `((egoge-search-citation-line ,@(let ((list nil) (count 1)) (require 'gnus-cite) (dolist (face gnus-cite-face-list (nreverse list)) (push (list count (list 'quote face) 'prepend) list) (setq count (1+ count))))))) "Keywords for highlighting different levels of message citations.") (defun egoge-add-citation-keywords () "Add font-lock for nested citations to current buffer." (font-lock-add-keywords nil egoge-citation-x-keywords)) (defun egoge-remove-citation-keywords () "Remove font-lock for nested citations from current buffer." (font-lock-remove-keywords nil egoge-citation-x-keywords)) (define-minor-mode egoge-citation-x-mode "Toggle egoge-citation-x-mode' in current buffer. This buffer local minor mode provides additional font-lock support for nested citations. With prefix ARG, turn `egoge-citation-x-mode' on if and only if ARG is positive." nil "" nil (if egoge-citation-x-mode (egoge-add-citation-keywords) (egoge-remove-citation-keywords)) (font-lock-fontify-buffer)) (defun egoge-turn-on-citation-x () "Turn on `egoge-citation-x-mode'." (egoge-citation-x-mode 1)) (add-hook 'message-mode-hook 'egoge-turn-on-citation-x) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Nützliche Funktionen ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Einleitung mit * vor dem Namen (defun zonix-citation-line () (insert "* " (mail-header-from message-reply-headers) " wrote:\n\n")) ;(setq message-citation-line-function 'zonix-citation-line) ;; Einleitung mit Datum, wenn älter als 3 Tage und nicht länger ;; als 72 Zeichen, sonst wie oben. ;; Daniel Zimmermann in , leicht ;; modifiziert. (defun dz/zonix-my-citation-line () (let* ((from (mail-header-from message-reply-headers)) (name (or (car (gnus-extract-address-components from)) from)) (posting-time (date-to-time (mail-header-date message-reply-headers))) (posting-time-for-citation (format-time-string "%b %d %Y" posting-time))) (cond ((and (> (- (time-to-days (current-time)) (time-to-days posting-time)) 3) (< (length (concat "· On " posting-time-for-citation ", " from " wrote:")) 72)) (insert "· On " posting-time-for-citation ", " from " wrote:\n\n")) ((< (length (concat "* " from " wrote:")) 72) (insert "· " from " wrote:\n\n")) (t (insert "· " name " wrote:\n\n"))))) (setq message-citation-line-function 'dz/zonix-my-citation-line) ;; deutschsprachige Einleitung (defun zonix-message-insert-citation-line-de () "Function that inserts a simple citation line. German Version" (when message-reply-headers (insert (mail-header-from message-reply-headers) " schrieb:\n\n"))) ;(setq message-citation-line-function 'zonix-message-insert-citation-line-de) ;; englische Einleitung mit Datum ;; Bill White in (defun bw-message-insert-citation-line-en-date () "Function that inserts a simple citation line." (when message-reply-headers (insert "On " (format-time-string "%a %b %d %Y at %R" (gnus-date-get-time (mail-header-date message-reply-headers))) ", " (mail-header-from message-reply-headers) " wrote:\n\n"))) ;(setq message-citation-line-function 'bw-message-insert-citation-line-en-date) ;; Christoph Garbers in (defun cg-citation-line () "Function that inserts svengo a cool citation line." (when message-reply-headers (insert "* Quoting " (mail-header-from message-reply-headers) ":\n\n"))) ;(setq message-citation-line-function 'cg-citation-line) ;; Dirk Meyer in (defun dischi-message-generate-headers-and-save () (interactive) (message-generate-headers (if (message-news-p) message-required-news-headers message-required-mail-headers)) (save-buffer)) (define-key message-mode-map "\C-x\C-h" 'dischi-message-generate-headers-and-save) ;; leere Header beim Senden entfernen ;; Matthias Wiehl in <9hphkb$80v$1@fulmine.dhs.org> ;; modifiziert, so dass X-Header stehen bleiben (z.B. für nndiary) (defun svengo-message-strip-empty-headers () (message-narrow-to-headers) (while (not (eobp)) (while (looking-at "[^X][^:]*:[ ]*$") (message-delete-line)) (forward-line 1)) (widen)) (add-hook 'message-send-hook 'svengo-message-strip-empty-headers) ;; Abbrevs im Message-Mode verwenden (add-hook 'message-mode-hook 'abbrev-mode) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; besonders schöne Attribution ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Matthias Wiehl in <878zmt3rz8.fsf@fulmine.dhs.org> (defun my-citation-format-date-string (date) "Convert a Date header value to `dd.mm.yyyy' format." (let ((time (date-to-time date))) (format-time-string "%d.%m.%Y" time))) ;; better use gnus-extract-address-components? (defun my-citation-extract-sender-name (from) "Extract the sender's name from FROM." ;; We use `mail-extract-address-components' from the mail-lib ;; package to fetch the sender's name. (let ((names (mail-extract-address-components from))) (if names ;; If `mail-extr-ignore-single-names' is set to t, (car names) ;; will be nil if the sender of the message you're responding ;; to didn't provide a full name. In that case, the second ;; string will be returned. (or (car names) (if (message-news-p) "Ein Realnamenloser" nil))))) (defun my-insert-citation-line () "Insert a citation line that includes the original article's date." (when message-reply-headers (let ((from (my-citation-extract-sender-name (mail-header-from message-reply-headers))) (date (my-citation-format-date-string (mail-header-date message-reply-headers))) (groups (message-fetch-reply-field "newsgroups"))) ;; In mail messages, we want to use a somewhat personal ;; introduction. (if (message-mail-p) (insert "Hallo" ;; Insert the name of the person you're replying to. (if from (concat " " from) "") ",\n\n" "am " date " schriebst Du" ;; Include the name of the newsgroup which the ;; original message was posted to. (if groups (progn ;; Shorten `groups' if necessary. (if (string-match "\\(,\\)" groups) (setq groups (concat (substring groups 0 (match-beginning 0)) " et al."))) (concat " in " groups)) "") ":\n\n") ;; This is for news messages. (insert from " schrieb am " date ":\n\n"))))) ;(setq mail-extr-ignore-single-names t) ;(setq message-citation-line-function 'my-insert-citation-line) ;; http://www.tuxedo.org/~esr/jargon/html/entry/September-that-never-ended.html (require 'time-date) ;; part of Gnus (defun september-citation-line () (when message-reply-headers (insert "On " (int-to-string (- (time-to-days (mail-header-parse-date (mail-header-date message-reply-headers))) (time-to-days (encode-time 0 0 0 31 08 1993)))) " September 1993, " (let* ((email (mail-header-from message-reply-headers)) (data (mail-extract-address-components email)) (name (car data)) (net (car (cdr data)))) (or name net email)) " wrote:\n"))) ;(setq message-citation-line-function 'september-citation-line) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Quoting-Ratio berechnen ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Matthias Wiehl in (defun mw-determine-quote-ratio (start end) "Print number of cited lines in the region." (interactive "r") (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (let ((done 0) (cited 0)) (if (looking-at message-cite-prefix-regexp) (setq cited (1+ cited)) (while (re-search-forward "[\n\C-m]" nil t 1) (setq done (1+ done)) (if (looking-at message-cite-prefix-regexp) (setq cited (1+ cited)))) (goto-char (point-max)) (if (and (/= start end) (not (bolp))) (setq done (1+ done))) (message "%d cited lines, %d total" cited done)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; vi zum Editieren nutzen (örks...) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Daniel Pittman in ding (<87ofms2jhp.fsf@inanna.rimspace.net>) (defun edit-buffer-in-vi () "Put the content of the buffer into an external file and invoke VI on it." (let ((filename (expand-file-name (make-temp-name "silly.vi.user.") "~/")) (message (current-buffer))) (with-temp-buffer filename (insert (buffer-string message))) (let ((editor (start-process-shell-command "message editor" nil ; no associated buffer... "xterm" "-e" "vim" filename))) (cons editor filename)))) (defun edit-buffer-in-vi-make-closure (buffer filename) "Restore the content of buffer from filename when invoked." (let ((buffer-name (buffer-name buffer))) ; Oh for closures... `(lambda () (let ((buffer (get-buffer ,buffer-name))) (when buffer (with-current-buffer buffer (erase-buffer) (insert-file-contents ,filename))))))) ;; (add-hook 'message-setup-hook ; am I the right hook? ;; (lambda () ;; "Invoke an external editor on the content of this buffer..." ;; (let ((result (edit-buffer-in-vi))) ;; (set-process-sentinel ;; (car result) ;; (edit-buffer-in-vi-make-closure (current-buffer) (cdr result)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; alternatives nowplaying-Feld mit Abfrage ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Holger Schauer in (defun insert-np-field () "Call external program `xmms_np' to insert an now-playing line into a buffer, based on what `xmms' is currently playing." (interactive) (save-excursion (let ((old-point (point)) (npstring "")) ;; try to position cursor in front of signature, ;; otherwise stay where we are. (if (message-goto-signature) (previous-line 2) (goto-char old-point)) ;; insert np:-line (newline) (insert "np: ") (shell-command "xmms_np" t) (when (string-equal "np: " (buffer-substring (point-at-bol) (point-at-eol))) (setq npstring (read-from-minibuffer "Now playing: ")) (cond ((string-equal npstring "") (undo 0)) ; remove insertion of "np: " (t (insert npstring))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Überprüfung auf X-Post _vor_ dem Schreiben eines Artikels ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Reiner Steib in (defun rs-message-check-crosspost () "Check for crosspost _before_ composing a message." ;; Code is borrowed from `message-check-news-header-syntax'. (let ((newsgroups (message-fetch-field "newsgroups")) (followup-to (message-fetch-field "followup-to")) to) (when (and newsgroups (string-match "," newsgroups) (not followup-to) (y-or-n-p "Insert Followup-To header now? ") (not (zerop (length (setq to (completing-read "Followups to (default: no Followup-To header) " (mapcar #'list (cons "poster" (message-tokenize-header newsgroups))))))))) (message-position-on-field "Followup-To" "Newsgroups") (insert "Followup-To: " to)))) ;; Add it to a suitable hook: ;(add-hook 'message-setup-hook 'rs-message-check-crosspost)