;; .gnus.el -- Dan Jacobson's personal Gnus startup mess ;; Author : Dan Jacobson http://jidanni.org/ ;; Copyright : http://www.fsf.org/copyleft/gpl.html ;; Created On : 1988? ;; Last Modified On: Thu May 15 09:01:41 2008 ;; Update Count : 455 (put 'gnus-group-check-bogus-groups 'disabled t) (put 'gnus-group-find-new-groups 'disabled t) (setq gnus-mark-article-hook nil message-insert-canlock nil gnus-select-method (if(string-match "jidanni1" system-name) '(nntp "localhost") '(nnnil)) gnus-inhibit-mime-unbuttonizing t gnus-secondary-select-methods '((nnml "")) gnus-check-new-newsgroups 'nil ;ask-server gnus-read-active-file nil;try default 'some' instead --naw gnus-save-killed-list nil gnus-default-article-saver 'gnus-summary-save-in-mail gnus-posting-styles '( (".*" (User-Agent nil) (From "jidanni@jidanni.org"))) message-user-path "jidanni.org";vanity plates mail-host-address message-user-path;for message id message-user-fqdn mail-host-address mail-sources `((maildir)) gnus-single-article-buffer nil gnus-kill-summary-on-exit nil mail-source-delete-incoming t ; gnus-thread-sort-functions ; '(gnus-thread-sort-by-number gnus-thread-sort-by-date) message-generate-headers-first t gnus-treat-date-lapsed 'head gnus-treat-emphasize nil;else *bla* becomes bla gnus-default-directory "~/" message-shoot-gnksa-feet '(multiple-copies) sc-auto-fill-region-p nil gnus-thread-indent-level 3 mm-body-charset-encoding-alist '((utf-8 . 8bit)) gnus-activate-level 5;stop big delay at startup message-syntax-checks '((sender . disabled)) gnus-summary-mode-line-format "Gnus: %G [%A] %Z" gnus-group-line-format "%B%1{%M%}%S%p%P%2y: %(%-50,50G%) %d %L\n" gnus-summary-pick-line-format (concat "%-2P " gnus-summary-line-format) gnus-pick-display-summary t gnus-pick-elegant-flow nil nntp-record-commands t gnus-agent nil;We use noffle gnus-asynchronous t;We use noffle gnus-use-article-prefetch nil;else wastefully asks noffle gnus-use-cache nil;else "!" caches noffle's "Will download" ;information messages, so we don't see the article when it arrives. gnus-keep-backlog 'nil;else some noffle article fetches not seen gnus-auto-select-next nil;else wastefully asks noffle ;Put X-NOFFLE-Status info into Summary buffer: nntp-nov-is-evil t;Get X-NOFFLE-Status always gnus-extra-headers '(To Newsgroups X-NOFFLE-Status X-Spam-Status) gnus-summary-line-format (concat "%U%R%z%I%(%t %3{%~(cut-left 2)" "~(max-right 6)~(pad 6)o%}%3L|%us|%-14,14f%)%3{%un%}:%s\n") ) (add-hook 'message-sent-hook 'gnus-score-followup-thread) (add-hook 'gnus-display-article-hook 'gnus-article-date-lapsed) (global-set-key "\C-xm" (quote gnus-summary-mail-other-window)) ;hmmmm (defun my-save-buffers-kill-emacs (&optional arg) "Like `save-buffers-kill-emacs'." (interactive) (jidanni-gnus-draft-reminder) (save-buffers-kill-emacs arg)) (define-key global-map "\C-x\C-c" 'my-save-buffers-kill-emacs) (add-hook 'gnus-exit-gnus-hook 'jidanni-gnus-draft-reminder) (require 'cl) (defun jidanni-gnus-draft-reminder () "Remind user if there are unsent drafts." (interactive) (if (gnus-alive-p) (let (active) (catch 'continue (dolist (group '("nndraft:drafts" "nndraft:queue")) (setq active (gnus-activate-group group)) (if (and active (>= (cdr active) (car active))) (if (y-or-n-p "There are unsent drafts, really quit?") (throw 'continue t) (error "Stop!")))))))) (defun jidanni-message-confirm () "Confirm that we really want to send the message." (interactive)(or (y-or-n-p "Send?")(keyboard-quit))) (add-hook 'message-send-hook 'jidanni-message-confirm) (add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp) (defun gnus-user-format-function-n (header) ;Steib (let ((case-fold-search t) (val (or (cdr (assq 'X-NOFFLE-Status (mail-header-extra header)))""))) (gnus-replace-in-string val "\\(\\S-\\)\\S-+ ?" "\\1")));first chars (setq nnmail-extra-headers gnus-extra-headers) ;(I Didn't use debian's /usr/share/emacs/site-lisp/gnus/noffle.el) ;remove User-Agent, as it is wasteful ;Want better control of References but don't know how (setq message-required-news-headers '(From Newsgroups Subject Date Message-ID)) (setq message-required-mail-headers '(From Subject Date Message-ID)) (eval-after-load 'message ;for *Drafts* '(add-to-list 'message-required-headers 'Date)) (setq gnus-ignored-from-addresses "jidanni" sc-preferred-attribution-list '("sc-lastchoice" "x-attribution" "sc-consult" "initials" "firstname" "lastname") sc-attrib-selection-list '(("sc-from-address" ((".*" . (bbdb/sc-consult-attr (sc-mail-field "sc-from-address")))))) sc-mail-glom-frame '((begin (setq sc-mail-headers-start (point))) ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t) ("^\\S +:.*$" (sc-mail-fetch-field) nil t) ("^$" (progn (bbdb/sc-default) (list 'abort '(step . 0)))) ("^[ \t]+" (sc-mail-append-field)) (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) (end (setq sc-mail-headers-end (point)))) mail-user-agent 'gnus-user-agent;m wont work in bbdb before ;sending other mail ;;hmmm, should make sure gnus is running before sending mail. gnus-summary-goto-unread 'never gnus-auto-center-summary nil gnus-confirm-mail-reply-to-news t nnmail-split-methods '(("mail.debianbugs" "@bugs\\.debian\\.org") ("mail.misc" "")) message-from-style nil message-hidden-headers nil gnus-mime-display-multipart-related-as-mixed t;else miss stuff url-automatic-caching t;for when I try news feeds again in 2007 ;(setq gnus-message-archive-group "nnfolder+archive:sent") gnus-message-archive-group (concat "nnml:archive." (format-time-string "%Y" (current-time)))) (codepage-setup 874)(define-coding-system-alias 'windows-874 'cp874) (add-hook 'gnus-summary-mode-hook (function (lambda () (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-thread)))) (defun message-shorten-references (header references) "Trim REFERENCES to be jidanni:1 Message-ID long or less, and fold them. If folding is disallowed, also check that the REFERENCES are less than 988 characters long, and if they are not, trim them until they are." (let ((maxcount 1);jidanni (count 0) (cut 2) refs) (with-temp-buffer (insert references) (goto-char (point-min)) ;; Cons a list of valid references. (while (re-search-forward "<[^>]+>" nil t) (push (match-string 0) refs)) (setq ;refs (nreverse refs);jidanni off count (length refs))) ;; If the list has more than MAXCOUNT elements, trim it by ;; removing the CUTth element and the required number of ;; elements that follow. (when (> count maxcount) (let ((surplus (- count maxcount))) (message-shorten-1 refs cut surplus) (decf count surplus))) ;; If folding is disallowed, make sure the total length (including ;; the spaces between) will be less than MAXSIZE characters. ;; ;; Only disallow folding for News messages. At this point the headers ;; have not been generated, thus we use message-this-is-news directly. (when (and message-this-is-news message-cater-to-broken-inn) (let ((maxsize 988) (totalsize (+ (apply #'+ (mapcar #'length refs)) (1- count))) (surplus 0) (ptr (nthcdr (1- cut) refs))) ;; Decide how many elements to cut off... (while (> totalsize maxsize) (decf totalsize (1+ (length (car ptr)))) (incf surplus) (setq ptr (cdr ptr))) ;; ...and do it. (when (> surplus 0) (message-shorten-1 refs cut surplus)))) ;; Finally, collect the references back into a string and insert ;; it into the buffer. (let ((refstring (mapconcat #'identity refs " "))) (if (and message-this-is-news message-cater-to-broken-inn) (insert (capitalize (symbol-name header)) ": " refstring "\n") (message-fill-header header refstring))))) ;; ;;after (setq gnus-extra-headers '(To Newsgroups X-Spam-Status)) (defun gnus-user-format-function-s (header) (gnus-replace-in-string (gnus-extra-header 'X-Spam-Status header) ".*score=\\([-0-9.]+\\).*" "\\1")) ;; (defun gnus-article-sort-by-spam-status (h1 h2) ;; "Sort articles by score from the X-Spam-Status: header." ;; (< (string-to-number (gnus-user-format-function-s h1)) ;; (string-to-number (gnus-user-format-function-s h2)))) ;; (defun gnus-thread-sort-by-spam-status (h1 h2) ;; "Sort threads by spam status" ;; (gnus-article-sort-by-spam-status ;; (gnus-thread-header h1) (gnus-thread-header h2))) (setq gnus-parameters '(("^nndoc:" ;; (gnus-thread-sort-functions 'gnus-thread-sort-by-spam-status) (gnus-summary-line-format (concat "%U%R%z%I%(%t %~(cut-left 2)~(max-right 6)" "~(pad 6)o|%1{%us%}|%-14,14f%):%s\n"))))) ;; (defun gnus-summary-sort-by-spam-status (&optional reverse) ;; "Sort the summary buffer by X-Spam-Status. ;; Argument REVERSE means reverse order." ;; (interactive "P") ;; (gnus-summary-sort 'spam-status reverse)) ;; (gnus-define-keys gnus-summary-mode-map ;; "\C-c\C-s\C-p" gnus-summary-sort-by-spam-status) ;(setq message-from-style 'angles) (setq gnus-save-newsrc-file nil);gets trampled by other readers anyway (setq rs-gnus-auto-digest-subjects "^spamdealer report\\|^Risks Digest") (defun rs-gnus-maybe-enter-digest-mode () "Jidanni auto digest enterer" ;;(when ;(or ;(and (stringp rs-gnus-auto-digest-groups) ;; (string-match rs-gnus-auto-digest-groups gnus-newsgroup-name) ;; (not (string-match "nndoc:.*-[0-9]+" gnus-newsgroup-name))) (and (stringp rs-gnus-auto-digest-subjects) (let ((subject (gnus-with-article-buffer (gnus-fetch-field "Subject")))) (and (stringp subject) (string-match rs-gnus-auto-digest-subjects subject))) (gnus-message 9 ;"Entering digest group automatically.") (documentation 'rs-gnus-maybe-enter-digest-mode));how to say ;current function? ;;(sit-for 1) (gnus-summary-enter-digest-group))) ;(gnus-summary-show-article) ;(add-hook 'gnus-select-article-hook 'rs-gnus-maybe-enter-digest-mode) (setq gnus-large-ephemeral-newsgroup 2222) ;;Be sure we are very aware of Disposition-Notification requests ;;though we can only respond manually at present. (add-hook 'gnus-startup-hook '(lambda () (require 'gnus-art) (setq gnus-visible-headers (concat "^Disposition-Notification-To:\\|";^X-Spam-Status:\\|" gnus-visible-headers)) (setq gnus-header-face-alist (cons '("Disposition-Notification-To:" gnus-summary-cancelled ;vivid gnus-summary-cancelled) gnus-header-face-alist)))) (defun message-get-reply-headers (wide &optional to-address address-headers) (let (follow-to mct never-mct to cc author mft recipients) ;; Find all relevant headers we need. (save-restriction (message-narrow-to-headers-or-head) ;; Gmane renames "To". Look at "Original-To", too, if it is present in ;; message-header-synonyms. (setq to (or (message-fetch-field "to") (and (loop for synonym in message-header-synonyms when (memq 'Original-To synonym) return t) (message-fetch-field "original-to"))) cc (message-fetch-field "cc") mct (message-fetch-field "mail-copies-to") author (or (message-fetch-field "mail-reply-to") (message-fetch-field "reply-to") (message-fetch-field "from") "") mft (and message-use-mail-followup-to (message-fetch-field "mail-followup-to")))) ;; Handle special values of Mail-Copies-To. (when mct (cond ((or (equal (downcase mct) "never") (equal (downcase mct) "nobody")) (setq never-mct t) (setq mct nil)) ((or (equal (downcase mct) "always") (equal (downcase mct) "poster")) (setq mct author)))) (save-match-data ;; Build (textual) list of new recipient addresses. (cond ((not wide) (setq recipients (concat ", " author))) (address-headers (dolist (header address-headers) (let ((value (message-fetch-field header))) (when value (setq recipients (concat recipients ", " value)))))) ((and mft (string-match "[^ \t,]" mft) (or (not (eq message-use-mail-followup-to 'ask)) (message-y-or-n-p "Obey Mail-Followup-To? " t "\ You should normally obey the Mail-Followup-To: header. In this article, it has the value of " mft " which directs your response to " (if (string-match "," mft) "the specified addresses" "that address only") ". Most commonly, Mail-Followup-To is used by a mailing list poster to express that responses should be sent to just the list, and not the poster as well. If a message is posted to several mailing lists, Mail-Followup-To may also be used to direct the following discussion to one list only, because discussions that are spread over several lists tend to be fragmented and very difficult to follow. Also, some source/announcement lists are not intended for discussion; responses here are directed to other addresses. You may customize the variable `message-use-mail-followup-to', if you want to get rid of this query permanently."))) (setq recipients (concat ", " mft))) (to-address (setq recipients (concat ", " to-address)) ;; If the author explicitly asked for a copy, we don't deny it to them. (if mct (setq recipients (concat recipients ", " mct)))) (t (setq recipients (if never-mct "" (concat ", " author))) (if to (setq recipients (concat recipients ", " to))) (if cc (setq recipients (concat recipients ", " cc))) (if mct (setq recipients (concat recipients ", " mct))))) (if (>= (length recipients) 2) ;; Strip the leading ", ". (setq recipients (substring recipients 2))) ;; Squeeze whitespace. (while (string-match "[ \t][ \t]+" recipients) (setq recipients (replace-match " " t t recipients))) ;; Remove addresses that match `rmail-dont-reply-to-names'. (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) (setq recipients (rmail-dont-reply-to recipients))) ;; Perhaps "Mail-Copies-To: never" removed the only address? (if (string-equal recipients "") (setq recipients author)) ;; Convert string to a list of (("foo@bar" . "Name ") ...). (setq recipients (mapcar (lambda (addr) ;;jidanni changed ;; (cons (downcase (mail-strip-quoted-names addr)) addr)) ;;to (cons (downcase (mail-strip-quoted-names addr)) (downcase (mail-strip-quoted-names addr)))) ;;to avoid looking like a fool, even more consistantly than ;;mail-extr-ignore-realname-equals-mailbox-name and ;;mail-extr-ignore-single-names could, before gnus ignored them anyway ;;end of jidanni change. Should set a "message-austere-to-cc-reply" (message-tokenize-header recipients))) ;; Remove first duplicates. (Why not all duplicates? Is this a bug?) (let ((s recipients)) (while s (setq recipients (delq (assoc (car (pop s)) s) recipients)))) ;; Remove hierarchical lists that are contained within each other, ;; if message-hierarchical-addresses is defined. (when message-hierarchical-addresses (let ((plain-addrs (mapcar 'car recipients)) subaddrs recip) (while plain-addrs (setq subaddrs (assoc (car plain-addrs) message-hierarchical-addresses) plain-addrs (cdr plain-addrs)) (when subaddrs (setq subaddrs (cdr subaddrs)) (while subaddrs (setq recip (assoc (car subaddrs) recipients) subaddrs (cdr subaddrs)) (if recip (setq recipients (delq recip recipients)))))))) ;; Build the header alist. Allow the user to be asked whether ;; or not to reply to all recipients in a wide reply. (setq follow-to (list (cons 'To (cdr (pop recipients))))) (when (and recipients (or (not message-wide-reply-confirm-recipients) (y-or-n-p "Reply to all recipients? "))) (setq recipients (mapconcat (lambda (addr) (cdr addr)) recipients ", ")) (if (string-match "^ +" recipients) (setq recipients (substring recipients (match-end 0)))) (push (cons 'Cc recipients) follow-to))) follow-to)) (defun rs-gnus-save-newsrc-with-whitespace-1 () "Save ~/.newsrc.eld with extra whitespace." (gnus-message 5 "Adding whitespace to .newsrc.eld") (save-excursion (goto-char (point-min)) (while (re-search-forward "(\\\"\\| ((\\| (nn" nil t) (replace-match "\n \\&" t)) (delete-trailing-whitespace))) (add-hook 'gnus-save-quick-newsrc-hook 'rs-gnus-save-newsrc-with-whitespace-1) (setq gnus-msg-keep-gcc-header t) ;will be in Debian sid gnus-msg.el 2008 hopefully (setq message-archive-note nil) (setq rs-bbdb-ignored-from-list '("@public.gmane.org")) (setq bbdb/news-auto-create-p nil) (setq bbdb/news-auto-create-hook 'bbdb-ignore-some-messages-hook) (setq bbdb/mail-auto-create-p 'bbdb-ignore-some-messages-hook) (setq bbdb-ignore-some-messages-alist `(("From" . , (regexp-opt rs-bbdb-ignored-from-list)))) (custom-set-faces'(gnus-header-subject((t(:foreground "yellow" :bold t))))) (custom-set-faces'(message-header-subject((t(:foreground "yellow" :bold t))))) ;(setq mm-inline-text-html-with-w3m-keymap nil) (defun jidanni-gnus-group-get-new-rss-news() "Sorry attempt to seperate out painful RSS fetching." (let ((gnus-activate-foreign-newsgroups 5)) (gnus-group-get-new-news))) (define-key gnus-group-mode-map "v" (lambda () (interactive) (jidanni-gnus-group-get-new-rss-news)))