;;; This .gnus file belongs to Sacha Chua ;; URL: http://richip.dhs.org/~sachac/notebook/emacs/dotgnus.e (setq load-path (delete "/usr/share/emacs/21.3/site-lisp/gnus" load-path)) (add-to-list 'load-path "/usr/share/emacs/21.3/site-lisp/gnus") (load "gnus") (setq gnus-select-method '(nnml "")) (setq gnus-secondary-select-methods nil) (require 'spam) (require 'bbdb-config) (bbdb-insinuate-gnus) ;; For really cool BBDB mail expansion based on the mail-alias field (add-hook 'message-setup-hook 'bbdb-define-all-aliases) (when (boundp 'mail-abbrevs-setup) (add-hook 'message-setup-hook 'mail-abbrevs-setup)) (setq gnus-check-new-newsgroups nil) (setq mail-sources '((file :path "/var/mail/sacha"))) (setq nnmbox-get-new-mail t) (setq gnus-save-newsrc-file nil) (setq gnus-group-line-format "%5y %(%-70,70g%)\n") (setq gnus-sum-thread-tree-single-indent "* ") (setq gnus-sum-thread-tree-single-leaf "+-> ") (setq gnus-summary-line-format "%uA%us%U%R: %20,20uB%ub: %-40,40s\n") (setq gnus-extra-headers '(To X-NextAction X-Waiting)) (setq nnmail-extra-headers gnus-extra-headers) (setq nntp-nov-is-evil t) (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) (setq gnus-thread-sort-functions 'gnus-thread-sort-by-total-score) (setq message-default-headers "Reply-To: Sacha Chua ") (setq gnus-select-group-hook nil) (setq gnus-auto-select-next t) (setq gnus-summary-check-current t) (setq gnus-auto-center-summary nil) (setq gnus-thread-indent-level 1) ;(add-hook 'gnus-summary-mode-hook 'gnus-summary-hide-all-threads) (add-hook 'gnus-summary-mode-hook 'turn-on-gnus-mailing-list-mode) (setq gnus-add-to-list t) (when (load "nnir" t) (setq nnir-search-engine 'swish++) (setq nnir-swish++-index-file "/home/sacha/Mail/swish++.index")) (defun sacha/ibm-search-blogs (query) (interactive "MQuery: ") (let ((nnir-swish++-index-file "/home/sacha/Mail/blogs.index")) (gnus-group-make-nnir-group nil query))) (autoload 'gnus-stat "gnus-stat" "Statistics from the summary buffer" t) ;;(setq gnus-refer-article-method ;; '(current (nnweb "refer" (nnweb-type google)))) ;; 20030627: Changed kill mark to just -1 ;; I find adaptive scoring very useful for keeping killed (boring) ;; threads out of sight. I do have some keyword scoring rules that ;; can bring some threads back up, though. (setq gnus-use-adaptive-scoring t) (setq gnus-default-adaptive-score-alist '((gnus-unread-mark) (gnus-ticked-mark (subject 5)) (gnus-dormant-mark (subject 5)) (gnus-del-mark (subject -1)) ; (gnus-read-mark (subject 1)) (gnus-killed-mark (subject -1)) (gnus-catchup-mark (subject -1)))) (setq gnus-gcc-mark-as-read t) (setq nnmail-cache-accepted-message-ids t) (setq spam-use-BBDB t) (setq nnmail-split-fancy '(| (: nnmail-split-fancy-with-parent) (any "tlug@ss.org" "list.torontolug") (any "tlug" "list.tlug") (any "help-gnu-emacs" "lists.help-gnu-emacs") ("subject" "ibm-rss" "blogs.ibm") ("to" "sacha@localhost" "blogs.ibm") (any "gnote@yahoogroups.com" "list.gnote") (any "sacha@directleap.com" "mail.directleap") (any "dave.kemp\\|mj.suhonos" "mail.school.kmd2004") (any "KCBlue" "mail.ibm.kcblue") (any "ibm.com" "mail.ibm") ("subject" "CS110" "2004sem1.cs110") ("subject" "CS21A" "2004sem1.cs21a") (any "sachac.comment@gmail.com" "mail.misc") (any "ledger-discuss@lists.sourceforge.net" "list.ledger") (any "torcamp@googlegroups.com" "list.torcamp") (any "debian-tl@banwa.upm.edu.ph" "list.debian.tl") (any "OmegaT@yahoogroups.com" "list.omtdev") (any "pinoywriters@yahoogroups.com" "list.yahoogroups.pinoywriters") (any "ph-cyberview" "list.ph-cyberview") (any "info@roomtoread.org" "mail.charity") (any "ylug" "list.ylug") (any "honyaku@yahoogroups" "list.yahoogroups.honyaku") (any "translate@ja.openoffice.org" "list.translate-ja") (any "partners-in-rhyme@att.net" "list.words") (any "firespinners" "list.yahoogroups.poi") (any "sigcse-members@listserv.acm.org" "list.sigcse") (any "xtla-el-dev@gna.org" "list.emacs.xtla") (any "pks-admin@horowitz.surfnet.nl" "mail.gpg") (any "dashboard-hackers@gnome.org" "list.dashboard") (any "utoronto.ca" "mail.school") (any "stoned_on_words@yahoogroups.com" "list.stoned_on_words") (any "flashxer@yahoogroups.com" "list.flashxer") (any "member@orkut.com" "mail.orkut") (any "emacs-wiki-discuss@nongnu.org" "mail.planner") (any "endgameinteractive@yahoogroups.com" "list.yahoogroups.endgame") (any "isc-ph@yahoogroups.com" "list.yahoogroups.isc-ph") (any "bluej-discuss@bluej.org" "list.bluej-discuss") (any "ruby-phil@googlegroups.com" "list.ruby-phil") (any "plug-org@lists.q-linux.com" "list.plug.plug-org") (any "225q@cmetech.com.au" "list.cards") (any "basr-l@trace.wisc.edu" "list.blind.basr-l") (any "compsateb@yahoogroups.com" "list.yahoogroups.compsat") (any "compsateb2005@yahoogroups.com" "list.yahoogroups.compsat") (any "compsateb2004@yahoogroups.com" "list.yahoogroups.compsat") (any "JAVA-ACCESS@JAVA.SUN.COM" "list.blind.java-access") (any "philjug@yahoogroups.com" "list.yahoogroups.philjug") (any "cs21a-b-1st-03@yahoogroups.com" "school.cs21a-b-1st-03") (any "emacspeak@cs.vassar.edu" "list.emacs.emacspeak") (any "penguinista@yahoogroups.com" "list.yahoogroups.penguinista") (any "compsci@lists.free.net.ph" "list.freenet.compsci") (any "psite_announcement@yahoogroups.com" "list.yahoogroups.psite_announcement") (any "linguaphile@wordsmith.org" "list.words") (any "erc-help@lists.sourceforge.net" "list.emacs.erc-help") (any "pisay99@yahoogroups.com" "list.yahoogroups.pisay99") (any "pinoyjug-newbies@yahoogroups.com" "list.yahoogroups.pinoyjug-newbies") (from "googlealerts-noreply@google.com" "mail.google-alerts") (any "owen@ditherati.net" "list.ditherati") (any "linops@linuxboxen.org" "list.linops") (any "wear-hard@haven.org" "list.wear-hard") (any "compsat@yahoogroups.com" "list.yahoogroups.compsat") (any "blinux-list@redhat.com" "list.blind.blinux") (any "emacs-devel@gnu.org" "list.emacs.emacs-devel") (any "ding@gnus.org" "list.emacs.gnus") (any "mailman" "list.mailman") (any "technews@hq.acm.org" "list.acm") (any "PinoySmartphone@yahoogroups.com" "list.yahoogroups.pinoysmartphone") (any "SIGCSE.MEMBERS@ACM.ORG" "list.sigcse") (any "cs@admu.edu.ph" "school.cs") (any "python@lists.free.net.ph" "list.freenet.python") (any "php@lists.free.net.ph" "list.freenet.php") (any "SIGCSE.ANNOUNCE@ACM.ORG" "list.sigcse") (any "program-l@LISTSERV.NAS.NET" "list.blind.program-l") (any "oss-dev@lists.free.net.ph" "list.freenet.oss-dev") (any "admu2003@yahoogroups.com" "list.yahoogroups.admu2003") (any "compsat2003@yahoogroups.com" "list.yahoogroups.compsat") (any "Fil-IT@yahoogroups.com" "list.yahoogroups.fil-it") (any "xemacs-design@xemacs.org" "list.emacs.xemacs") (any "xemacs@xemacs.org" "list.emacs.xemacs") (any "unix-geeks@lists.free.net.ph" "list.freenet.unix-geeks") (any "plug-misc@lists.q-linux.com" "list.plug.plug-misc") (any "xemacs-patches@xemacs.org" "list.emacs.xemacs") (any "xemacs-beta@xemacs.org" "list.emacs.xemacs") (any "admuACM@yahoogroups.com" "list.yahoogroups.admuacm") (any "gnu-emacs-sources@gnu.org" "list.emacs.gnu-emacs-sources") (any "DOS-DISCUSS@SOFTCON.COM" "list.blind.dos-discuss") (any "MemberServices@eSightCareers.net" "list.blind.esight") (any "open-source-now-list@redhat.com" "list.open-source-now-list") (any "Partners-In-Rhyme@peak.org" "list.words") (any "openminds_ph@yahoogroups.com" "list.yahoogroups.openminds_ph") (any "digitalfilipino@yahoogroups.com" "list.yahoogroups.digitalfilipino") (any "pinoyjug@yahoogroups.com" "list.yahoogroups.pinoyjug") (any "poch" "mail.poch") ("List-Id" "plug.lists.linux.org.ph" "list.plug.plug") (any "ruby-phil@googlegroups.com" "list.ruby-phil") ("List-Id" "ph-linux-newbie.lists.linux.org.ph" "list.plug.ph-linux-newbie") ("X-Mailing-List" "\\(debian-.+\\)@lists.debian.org" "list.debian.\\1") (from "mailer" "mail.errors") ("X-Spam-Status" "Yes" "spam") ("Content-Type" "charset=\"gb2312\"" "spam") ("Subject" "planner" "mail.planner") (any "uva\\.es" "mail.judge-acm") (any "root@cersa.admu.edu.ph" "mail.cersa.root") (any "sachac@subdimension.com" "mail.subdimension") (any "sacha@cersa.admu.edu.ph" "mail.cersa.sacha") (: spam-split) (any "booksnake" "mail.booksnake") (from "ateneo" "mail.school") (from "admu" "mail.school") (to "schua@ateneo.edu" "mail.school") ("cc" "schua@ateneo.edu" "mail.school") (any "sacha@free.net.ph" "mail.misc") (any "sachac@gmail.com" "mail.misc") (any "sacha@sachachua.com" "mail.misc") "mail.others")) ;; BBDB ;; (require 'bbdb-com) ;; so that bbdb-search will be defined for below ;; (defvar bbdb/gnus-folder-field 'gnus-folder ;; "BBDB field that controls where Gnus splits its mail") ;; (defun gnus-folder-per-bbdb () ;; "gnus fancy split function. ;; If the sender is in bbdb, return folder from the bbdb attribute ;; indicated by `bbdb/gnus-folder-field'" ;; (let* ((who (bbdb-canonicalize-address ;; (cadr (gnus-extract-address-components ;; (or (message-fetch-field "from") ;; (message-fetch-field "sender") ;; (message-fetch-field "reply-to")))))) ;; (found (bbdb-search-simple nil who))) ;; (and found (bbdb-record-getprop found bbdb/gnus-folder-field)))) ;; (defun gnus-if-in-bbdb (target) ;; "gnus fancy split function; ;; if the senders address is in bbdb, return TARGET" ;; (let ((who (bbdb-canonicalize-address ;; (cadr (gnus-extract-address-components ;; (or (message-fetch-field "from") ;; (message-fetch-field "sender") ;; (message-fetch-field "reply-to") ;; "nobody@nowhere.nohow")))))) ;; (when (bbdb-search-simple nil who) ;; target))) (when (boundp 'message-syntax-checks) (add-to-list 'message-syntax-checks '(sender . disabled))) (setq nnmail-split-methods 'nnmail-split-fancy) (setq nnmail-crosspost nil) (setq gnus-posting-styles '((".*" (name "Sacha Chua") (address "sacha@sachachua.com")) ;; I used to send text messages from Gnus. I haven't figured ;; out how to do that with my Microsoft Smartphone yet, but ;; I'll leave this in here just in case ("mail.text" (signature nil) (signature-file nil)) (".*compsat.*" (signature "Sacha Chua\nGeekette, CompSAt¤\nCompSAt¤ www.compsat.org") (organization "CompSAt") (reply-to "sacha@compsat.org") (address "sacha@compsat.org")))) ;; Inline images? (setq mm-attachment-override-types '("image/.*")) ;; don't like html or richtext (when (boundp 'mm-automatic-display) (setq mm-discouraged-alternatives '("text/html" "text/richtext") mm-automatic-display (remove "text/html" mm-automatic-display))) (defun my-async-short-unread-p (data) "Return non-nil for short, unread articles." (and (gnus-data-unread-p data) (< (mail-header-lines (gnus-data-header data)) 100))) (setq gnus-visible-headers "^From:\\|^To:\\|^Subject:\\|^Date:") (setq gnus-summary-exit-hook 'gnus-summary-bubble-group) ;(setq nnmail-treat-duplicates 'delete) (setq nnmail-treat-duplicates nil) (setq gnus-save-duplicate-list t) (setq gnus-message-archive-group '((lambda (x) (cond ;; Store personal mail messages in the same group I started out in ((string-match "mail" group) group) ;; I receive a copy of all messages I send to a list, so there's no need to archive ((string-match "list" group) nil) ;; Store everything else in misc until I can sort it out ((string-match "nntp" group) nil) (t "mail-misc"))))) (setq gnus-message-archive-method '(nnml "")) ;; Lots of things I can twiddle depending on how much I feel ;; like pretending other people observe netiquette. =) (setq gnus-treat-fill-article nil) (setq gnus-treat-fill-long-lines nil) (setq gnus-treat-capitalize-sentences nil) (setq gnus-treat-date-local 'head) (setq gnus-treat-hide-headers 'head) (setq gnus-treat-hide-boring-headers 'head) (setq gnus-treat-date-english t) (setq gnus-boring-article-headers '(empty followup-to reply-to to-address date long-to many-to)) ;; I browse by thread, so I tend to remember thread context; if I need ;; more info, I can just unhide cited text. (setq gnus-treat-hide-citation t) (add-hook 'nnmail-prepare-incoming-header-hook 'nnmail-remove-list-identifiers) (setq nnmail-list-identifiers '("[.*] ")) (setq gnus-list-identifiers '("\\[.*\\] ")) (setq nnslashdot-threshold 4) (setq nnslashdot-threaded nil) (setq gnus-always-read-dribble-file t) (setq gnus-ignored-from-addresses "schua@ateneo.edu\\|sacha@free.net.ph\\|sachachua.com\\|sachac@ca.ibm.com") (setq gnus-activate-foreign-newsgroups nil) (setq gnus-article-banner-alist '((yahoogroup . "^\\(_+\nDo You Yahoo\\|.*Yahoo\! Groups Sponsor\\)\\(.*\n\\)+"))) ;(require 'gnus-dired) ;(add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode) (setq gnus-summary-display-while-building 10) (setq gnus-gcc-mark-as-read t) ;;; * Gnus spam stuff from Thomas Gehrlein (spam-initialize) (require 'spam-stat) (spam-stat-load) ; load .spam-stat.el (setq spam-use-stat t) ; spam-split should use spam-stat ;; Emacs cannot automatically determine the coding system for .spam-stat.el. ;; Every time I exit Gnus Emacs asks me about the coding system. This is very ;; annoying. This is a work-around. (defun spam-stat-save () "Save the `spam-stat' hash table as lisp file." (interactive) (with-temp-buffer (let ((standard-output (current-buffer)) (font-lock-maximum-size 0)) (insert "(setq spam-stat-ngood " (number-to-string spam-stat-ngood) " spam-stat-nbad " (number-to-string spam-stat-nbad) " spam-stat (spam-stat-to-hash-table '(") (maphash (lambda (word entry) (prin1 (list word (spam-stat-good entry) (spam-stat-bad entry)))) spam-stat) (insert ")))") (let ((coding-system-for-write 'emacs-mule)) ; new line tjg (write-file spam-stat-file))))) (setq message-unsent-separator (concat message-unsent-separator "\\|" "^------ This is a copy of the message, including all the headers. ------$" "\\|" "--- Original message follows\\.$")) ;; load Gnus' spam library ;(require 'spam) (setq spam-use-BBDB t) ; use BBDB as whitelist (setq gnus-spam-newsgroup-contents '(("spam" gnus-group-spam-classification-spam)) spam-mark-only-unseen-as-spam t spam-move-spam-nonspam-groups-only nil spam-log-to-registry nil) (defvar sacha/gnus-nick-threshold 5 "*Number of people to stop greeting individually.") (defun sacha/gnus-add-nick-to-message () "Inserts \"Hello, NICK!\" in messages based on the recipient's nick field." (interactive) (save-excursion (let* ((bbdb-get-addresses-headers (list (assoc 'recipients bbdb-get-addresses-headers))) (recipients (bbdb-get-addresses nil gnus-ignored-from-addresses 'gnus-fetch-field)) recipient nicks rec net salutations) (goto-char (point-min)) (when (re-search-forward "--text follows this line--" nil t) (forward-line 1) (if (and sacha/gnus-nick-threshold (>= (length recipients) sacha/gnus-nick-threshold)) (insert "Hello, all!\n\n") (while recipients (setq recipient (car (cddr (car recipients)))) (setq net (nth 1 recipient)) (setq rec (car (bbdb-search (bbdb-records) nil nil net))) (cond ((null rec) (add-to-list 'nicks (car recipient))) ((bbdb-record-getprop rec 'hello) (add-to-list 'salutations (bbdb-record-getprop rec 'hello))) ((bbdb-record-getprop rec 'nick) (add-to-list 'nicks (bbdb-record-getprop rec 'nick))) (t (bbdb-record-name rec))) (setq recipients (cdr recipients)))) (when nicks (insert "Hello, " (mapconcat 'identity (nreverse nicks) ", ") "! ")) (when salutations (insert (mapconcat 'identity salutations " "))) (when (or nicks salutations) (insert "\n\n"))))) (goto-char (point-min))) (defadvice gnus-post-news (after sacha/nick activate) "Insert nicknames or custom salutations." (sacha/gnus-add-nick-to-message)) (defadvice gnus-msg-mail (after sacha/nick activate) "Insert nicknames or custom salutations." (sacha/gnus-add-nick-to-message)) (defadvice gnus-summary-reply (after sacha activate) "Insert nicknames or custom salutations." (sacha/gnus-add-nick-to-message)) (defun sacha/gnus-add-subject-to-bbdb-record () "Add datestamped subject note for each person this message has been sent to." (let* ((subject (concat (planner-today) ": E-mail: " (message-fetch-field "Subject") "\n")) (bbdb-get-addresses-headers (list (assoc 'recipients bbdb-get-addresses-headers))) records) (setq records (bbdb-update-records (bbdb-get-addresses nil gnus-ignored-from-addresses 'gnus-fetch-field) nil nil)) (mapc (lambda (rec) (bbdb-record-putprop rec 'contact (concat subject (or (bbdb-record-getprop rec 'contact) "")))) records))) (add-hook 'message-send-hook 'sacha/gnus-add-subject-to-bbdb-record) ;; NOTES ---------------------------------------------------------------- (defun sacha/gnus-remove-notes () "Remove everything from --- NOTES --- to END NOTES." (goto-char (point-min)) (when (re-search-forward "^--- NOTES ---" nil t) (let ((start (match-beginning 0)) (end (and (re-search-forward "^--- END NOTES ---") (match-end 0)))) (delete-region start end)))) (add-hook 'message-send-hook 'sacha/gnus-remove-notes) (defun sacha/gnus-send-message-to-all (records subject &optional text) "Compose message to everyone listed in the BBDB buffer with SUBJECT and TEXT. SUBJECT and TEXT can be strings, functions, or strings containing expressions. This allows you to specify expressions at the minibuffer prompt. If SUBJECT or TEXT is an expression, the variable `record' will contain the current BBDB record. This allows you to write messages with arbitrary Lisp expressions, such as the following: (concat \"Hello, \" (bbdb-record-name record) \"!\") or even something involving `if' or `cond' or `random'. (Fortune cookies, anyone?)" (interactive (list bbdb-records (read-string "Subject: ") (read-string "Body: "))) (while records (when (bbdb-record-net (caar records)) ;; (1) (let ((record (caar records))) (bbdb-send-mail record (if (stringp subject) (condition-case nil (eval (read subject)) ;; (2) (error subject)) ;; (3) (eval subject))) ;; (4) (goto-char (point-min)) (re-search-forward "--text " nil t) (forward-line 1) (when text (insert (if (stringp text) (condition-case nil (eval (read text)) ;; (5) (error text)) ;; (6) (eval text)))))) ;; (7) (setq records (cdr records)))) (defun sacha/gnus-add-notes-to-message () "Inserts notes in messages." (interactive) (save-excursion (let ((bbdb-get-addresses-headers (list (assoc 'recipients bbdb-get-addresses-headers))) notes) (setq notes (mapconcat (lambda (rec) (concat (bbdb-record-name rec) "\n====================\n\n" (bbdb-record-notes rec) "\n\n\n" )) (bbdb-update-records (bbdb-get-addresses nil gnus-ignored-from-addresses 'gnus-fetch-field) nil nil) "")) (goto-char (point-min)) (message-goto-signature) (forward-line -2) (insert "\n--- NOTES ---\n" notes "\n--- END NOTES ---\n")))) (add-hook 'message-setup-hook 'sacha/gnus-add-notes-to-message) (add-to-list 'nnmail-extra-headers 'To) (add-to-list 'nnmail-extra-headers 'Cc) (defun sacha/gnus-count-recipients (header) "Given a Gnus message header, returns priority mark. If I am the only recipient, return \"!\". If I am one of a few recipients, but I'm listed in To:, return \"*\". If I am one of a few recipients, return \"/\". If I am one of many recipients, return \".\". Else, return \" \"." (let* ((to (or (cdr (assoc 'To (mail-header-extra header))) "")) (cc (or (cdr (assoc 'Cc (mail-header-extra header))) "")) (threshold 5)) (cond ((string-match gnus-ignored-from-addresses to) (let ((len (length (bbdb-split to ",")))) (cond ((= len 1) "!") ((< len threshold) "*") (t "/")))) ((string-match gnus-ignored-from-addresses (concat to ", " cc)) (if (< (length (bbdb-split (concat to ", " cc) ",")) threshold) "-" ".")) (t " ")))) (defalias 'gnus-user-format-function-s 'sacha/gnus-count-recipients) (setq gnus-simplify-ignored-prefixes "re: ") (setq gnus-simplify-subject-functions '(gnus-simplify-subject-re gnus-simplify-subject-fuzzy gnus-simplify-all-whitespace)) ;; Personalized signatures (defun sacha/gnus-personalize-signature () "Personalizes signature based on BBDB signature field. BBDB signature field should be a lambda expression. First person with a custom signature field gets used." (let* ((bbdb-get-addresses-headers (list (assoc 'recipients bbdb-get-addresses-headers))) (records (bbdb-update-records (bbdb-get-addresses nil gnus-ignored-from-addresses 'gnus-fetch-field) nil nil)) signature) (while (and records (not signature)) (when (bbdb-record-getprop (car records) 'signature) (setq signature (eval (read (bbdb-record-getprop (car records) 'signature))))) (setq records (cdr records))) (or signature t))) (setq-default message-signature 'sacha/gnus-personalize-signature) ;;;_+ Keep track of the age of messages (defadvice gnus-post-news (around sacha/gnus-track-message-age activate) "Insert a header showing how old a message is, to shame me into replying faster." ;; Before you post the news, figure out how old it is (let (days) (when article-buffer (setq days (- (time-to-days (current-time)) (time-to-days (gnus-date-get-time (mail-header-date (gnus-summary-article-header (gnus-summary-article-number)))))))) ad-do-it (when days (goto-char (point-min)) (when (re-search-forward "--text follows this line--" nil t) (forward-line 1) (insert "In reply to a message sent by " (mail-header-from message-reply-headers) " " (cond ((= days 0) "today") ((= days 1) "yesterday") (t (format "%d days ago" days))) ": \n\n"))))) (defadvice gnus-summary-reply (around sacha/gnus-track-message-age activate) "Insert a header showing how old a message is, to shame me into replying faster." ;; Before you post the news, figure out how old it is (let (days) (with-current-buffer (gnus-copy-article-buffer) (setq days (- (time-to-days (current-time)) (time-to-days (gnus-date-get-time (mail-header-date (gnus-summary-article-header (gnus-summary-article-number)))))))) ad-do-it (when days (goto-char (point-min)) (when (re-search-forward "--text follows this line--" nil t) (forward-line 1) (insert "In reply to a message sent by " (mail-header-from message-reply-headers) " " (cond ((= days 0) "today") ((= days 1) "yesterday") (t (format "%d days ago" days))) ": \n\n"))))) (setq message-citation-line-function nil) ;;;_+ GTD action hack (defun sacha/gnus-next-action (header) "Given a Gnus message header, returns priority mark. If I am the only recipient, return \"!\". If I am one of a few recipients, but I'm listed in To:, return \"*\". If I am one of a few recipients, return \"/\". If I am one of many recipients, return \".\". Else, return \" \"." (let ((my-action (cdr (assoc 'X-NextAction (mail-header-extra header)))) (waiting (cdr (assoc 'X-Waiting (mail-header-extra header))))) (cond (my-action "<") (waiting ">") (t " ")))) (defalias 'gnus-user-format-function-A 'sacha/gnus-next-action) ;; From Aaditya Sood file:///mnt/media/sacha/static/AadityaSood.html ;;don't break threads when entering groups with new messages (setq gnus-fetch-old-headers 'some) ;;_+ Display mail author, or recipient if from me (copy-face 'default 'my-gray) (set-face-foreground 'my-gray "gray50") (setq gnus-face-1 'my-gray gnus-summary-line-format "%uA%us%U%R %30,30ua%ut%-40,40s\n") (defalias 'gnus-user-format-function-a 'sacha/bbdb/gnus-summary-get-author) (defalias 'gnus-user-format-function-t 'sacha/gnus-summary-get-direction) (defun sacha/gnus-summary-get-direction (header) "Returns direction of message." (let ((from (mail-header-from header))) (if (and (cadr (mail-extract-address-components from)) (string-match gnus-ignored-from-addresses (cadr (mail-extract-address-components from)))) "<- " "-> "))) (defun sacha/bbdb/gnus-summary-get-author (header) "Given a Gnus message header, returns the appropriate piece of information to identify the author in a Gnus summary line, depending on the settings of the various configuration variables. Returns the recipient if the author is in `gnus-ignored-from-addresses'. See the documentation for the following variables for more details: `bbdb/gnus-summary-mark-known-posters' `bbdb/gnus-summary-known-poster-mark' `bbdb/gnus-summary-prefer-bbdb-data' `bbdb/gnus-summary-prefer-real-names' This function is meant to be used with the user function defined in `bbdb/gnus-summary-user-format-letter'" (let* ((from (mail-header-from header)) (to (cdr (assoc 'To (mail-header-extra header)))) (from-me (and (cadr (mail-extract-address-components from)) (string-match gnus-ignored-from-addresses (cadr (mail-extract-address-components from))))) (data (and bbdb/gnus-summary-show-bbdb-names (condition-case nil (mail-extract-address-components (if from-me to from)) (error nil)))) (name (car data)) (net (car (cdr data))) (record (and data (bbdb-search-simple name (if (and net bbdb-canonicalize-net-hook) (bbdb-canonicalize-address net) net))))) (if (and record name (member (downcase name) (bbdb-record-net record))) ;; bogon! (setq record nil)) (setq name (or (and bbdb/gnus-summary-prefer-bbdb-data (or (and bbdb/gnus-summary-prefer-real-names (and record (bbdb-record-name record))) (and record (bbdb-record-net record) (nth 0 (bbdb-record-net record))))) (and bbdb/gnus-summary-prefer-real-names (or (and (equal bbdb/gnus-summary-prefer-real-names 'bbdb) net) name)) net from "**UNKNOWN**")) (format "%s%s%s " (or (and record bbdb/gnus-summary-mark-known-posters (or (bbdb-record-getprop record bbdb-message-marker-field) bbdb/gnus-summary-known-poster-mark)) " ") name (or (and record bbdb/gnus-summary-mark-known-posters (or (bbdb-record-getprop record bbdb-message-marker-field) bbdb/gnus-summary-known-poster-mark)) " ")))) ;;_+ Browse URLs (defun gnus-article-browse-urls () "Visit a URL from the `gnus-article-buffer' by prompting via a poping up a buffer showing the list of URLs found with the `gnus-button-url-regexp'." (interactive) (gnus-configure-windows 'article) (gnus-summary-select-article nil nil 'pseudo) (let ((temp-buffer (generate-new-buffer " *Article URLS*")) (urls (gnus-article-get-current-urls)) (this-window (selected-window)) (browse-window (or (get-buffer-window gnus-article-buffer) )) (count 0)) (save-excursion (save-window-excursion (set-buffer temp-buffer) (mapcar (lambda (string) (insert (format "\t%d: %s\n" count string)) (setq count (1+ count))) urls) (not-modified) (pop-to-buffer temp-buffer) (setq count (string-to-number (read-input "Browse which URL: "))) (kill-buffer temp-buffer)) (if browse-window (progn (select-window browse-window) (browse-url (nth count urls))))) (select-window this-window))) (defun gnus-article-get-current-urls () "Return a list of the urls found in the current `gnus-article-buffer'" (let (url-list) (save-excursion (set-buffer gnus-article-buffer) (setq url-list (gnus-article-get-urls-region (point-min) (point-max)))) url-list)) (defun gnus-article-get-urls-region (min max) "Return a list of urls found in the region between MIN and MAX" (let (url-list) (save-excursion (save-restriction (narrow-to-region min max) (goto-char (point-min)) (while (re-search-forward gnus-button-url-regexp nil t) (let ((match-string (match-string-no-properties 0))) (if (and (not (equal (substring match-string 0 4) "file")) (not (member match-string url-list))) (setq url-list (cons match-string url-list))))))) url-list)) ;;_+ E-mail commands ;; !!f +1 ;; +3 by default ;; !!t +1 follow up etc etc (planner-create-task entry) ;; !!a ;; !!n (defvar sacha/gnus-cmd-message-commands nil "List of commands from message.") ;; Two parts: remove commands before sending and store in buffer-local variable (defvar sacha/gnus-cmd-list '(("a" . sacha/gnus-cmd-alias) ("t" . sacha/gnus-cmd-task) ("n" . sacha/gnus-cmd-note) ("f" . sacha/gnus-cmd-followup))) (defun sacha/gnus-cmd-remove-commands () "Save and delete e-mail commands." (interactive) (setq sacha/gnus-cmd-message-commands nil) (goto-char (point-min)) (while (re-search-forward "^!!\\(.+\\)\n" nil t) (add-to-list 'sacha/gnus-cmd-message-commands (match-string 1)) (replace-match ""))) (defun sacha/gnus-cmd-process-commands () "Execute commands." (interactive) (while sacha/gnus-cmd-message-commands (let ((s (car sacha/gnus-cmd-message-commands))) (when (string-match "\\([^ ]+\\) *\\(.*\\)" s) (let ((command (match-string 1 s)) (arguments (match-string 2 s))) (save-match-data (funcall (or (cdr (assoc command sacha/gnus-cmd-list)) 'ignore) arguments)))) (setq sacha/gnus-cmd-message-commands (cdr sacha/gnus-cmd-message-commands))))) (add-to-list 'message-send-hook 'sacha/gnus-cmd-remove-commands) (add-to-list 'message-sent-hook 'sacha/gnus-cmd-process-commands) (defun sacha/gnus-cmd-task (args) "Create a task on Planner." (when (string-match "\\([^ ]+\\) +\\(.+\\)" args) (save-excursion (let ((date (match-string 1 args)) (title (match-string 2 args))) (planner-create-task (concat title " : " (planner-make-link (concat "gnus://" (or gnus-newsgroup-name "nnml:mail.misc") "/" (planner-gnus-get-message-id)) (concat "E-mail to " (planner-gnus-get-address "To")))) (planner-expand-name date)))))) (defun sacha/gnus-cmd-followup (args) "Create a follow-up task on Planner." (planner-create-task (concat "Follow up on " (planner-make-link (concat "gnus://" (or gnus-newsgroup-name "nnml:mail.misc") "/" (planner-gnus-get-message-id)) (concat "E-mail to " (planner-gnus-get-address "To")))) (planner-expand-name (or (and (> (length args) 0) args) "+3"))))