diff options
| -rw-r--r-- | doc/misc/ChangeLog | 5 | ||||
| -rw-r--r-- | doc/misc/gnus.texi | 39 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 39 | ||||
| -rw-r--r-- | lisp/gnus/gnus-icalendar.el | 837 | ||||
| -rw-r--r-- | lisp/gnus/gnus-int.el | 4 | ||||
| -rw-r--r-- | lisp/gnus/gnus-start.el | 3 | ||||
| -rw-r--r-- | lisp/gnus/gnus-uu.el | 4 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 2 | ||||
| -rw-r--r-- | lisp/gnus/mm-decode.el | 21 | ||||
| -rw-r--r-- | lisp/gnus/mml2015.el | 24 | ||||
| -rw-r--r-- | lisp/gnus/nnmbox.el | 53 |
11 files changed, 976 insertions, 55 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 9b45ac06f4c..7f5c70e07e3 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2013-08-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Basic Usage): Mention that warp means jump here. + (The notmuch Engine): Mention notmuch. + 2013-07-30 Tassilo Horn <tsdh@gnu.org> * gnus.texi (Sorting the Summary Buffer): Document new defcustom diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 808bd2b114b..4edc1d62f1a 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -21109,17 +21109,17 @@ the articles that match this query, and takes you to a summary buffer showing these articles. Articles may then be read, moved and deleted using the usual commands. -The @code{nnir} group made in this way is an @code{ephemeral} group, and -some changes are not permanent: aside from reading, moving, and +The @code{nnir} group made in this way is an @code{ephemeral} group, +and some changes are not permanent: aside from reading, moving, and deleting, you can't act on the original article. But there is an -alternative: you can @emph{warp} to the original group for the article -on the current line with @kbd{A W}, aka +alternative: you can @emph{warp} (i.e., jump) to the original group +for the article on the current line with @kbd{A W}, aka @code{gnus-warp-to-article}. Even better, the function -@code{gnus-summary-refer-thread}, bound by default in summary buffers to -@kbd{A T}, will first warp to the original group before it works its -magic and includes all the articles in the thread. From here you can -read, move and delete articles, but also copy them, alter article marks, -whatever. Go nuts. +@code{gnus-summary-refer-thread}, bound by default in summary buffers +to @kbd{A T}, will first warp to the original group before it works +its magic and includes all the articles in the thread. From here you +can read, move and delete articles, but also copy them, alter article +marks, whatever. Go nuts. You say you want to search more than just the group on the current line? No problem: just process-mark the groups you want to search. You want @@ -21161,6 +21161,7 @@ query language anyway. * The swish++ Engine:: Swish++ configuration and usage. * The swish-e Engine:: Swish-e configuration and usage. * The namazu Engine:: Namazu configuration and usage. +* The notmuch Engine:: Notmuch configuration and usage. * The hyrex Engine:: Hyrex configuration and usage. * Customizations:: User customizable settings. @end menu @@ -21390,6 +21391,26 @@ mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/ For maximum searching efficiency you might want to have a cron job run this command periodically, say every four hours. + +@node The notmuch Engine +@subsubsection The notmuch Engine + +@table @code +@item nnir-notmuch-program +The name of the notmuch search executable. Defaults to +@samp{notmuch}. + +@item nnir-notmuch-additional-switches +A list of strings, to be given as additional arguments to notmuch. + +@item nnir-notmuch-remove-prefix +The prefix to remove from each file name returned by notmuch in order +to get a group name (albeit with @samp{/} instead of @samp{.}). This +is a regular expression. + +@end table + + @node The hyrex Engine @subsubsection The hyrex Engine This engine is obsolete. diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index dd00eebe6f3..069935b4406 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,5 +1,44 @@ 2013-08-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + * message.el (message-ignored-news-headers): Delete X-Gnus-Delayed + before sending. + + * dgnushack.el (dgnushack-compile): Add a temporary check for + gnus-icalendar. + + * mm-decode.el (mm-command-output): New face. + (mm-display-external): Use it. + +2013-08-01 Kan-Ru Chen (陳侃如) <kanru@kanru.info> (tiny change) + + * nnmbox.el (nnmbox-request-article): Don't change point. + +2013-08-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-icalendar.el (gnus-icalendar-event:inline-reply-buttons): + Include `handle' parameter. + +2013-08-01 Jan Tatarik <jan.tatarik@gmail.com> + + * gnus-icalendar.el: New file. + +2013-08-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-int.el (gnus-warp-to-article): Mention that warp means jump. + + * gnus-uu.el (gnus-uu-mark-thread, gnus-uu-unmark-thread): Work with + dummy roots, too. + +2013-08-01 David Edmondson <dme@dme.org> + + * mml2015.el (mml2015-epg-key-image-to-string): Protect against bugging + out on ttys. + +2013-08-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-dribble-save): Only save the dribble file if it's + not empty. + * nnrss.el (nnrss-discover-feed): Indent. 2013-08-01 Katsumi Yamaoka <yamaoka@jpl.org> diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el new file mode 100644 index 00000000000..0286fd5dd89 --- /dev/null +++ b/lisp/gnus/gnus-icalendar.el @@ -0,0 +1,837 @@ +;;; gnus-icalendar.el --- reply to iCalendar meeting requests + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: Jan Tatarik <Jan.Tatarik@gmail.com> +;; Keywords: mail, icalendar, org + +;; 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 3 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, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; To install: +;; (require 'gnus-icalendar) +;; (gnus-icalendar-setup) + +;; to enable optional iCalendar->Org sync functionality +;; NOTE: both the capture file and the headline(s) inside must already exist +;; (setq gnus-icalendar-org-capture-file "~/org/notes.org") +;; (setq gnus-icalendar-org-capture-headline '("Calendar")) +;; (gnus-icalendar-org-setup) + + +;;; Code: + +(require 'icalendar) +(require 'eieio) +(require 'mm-decode) +(require 'gnus-sum) + +(eval-when-compile (require 'cl)) + +(defun gnus-icalendar-find-if (pred seq) + (catch 'found + (while seq + (when (funcall pred (car seq)) + (throw 'found (car seq))) + (pop seq)))) + +;;; +;;; ical-event +;;; + +(defclass gnus-icalendar-event () + ((organizer :initarg :organizer + :accessor gnus-icalendar-event:organizer + :initform "" + :type (or null string)) + (summary :initarg :summary + :accessor gnus-icalendar-event:summary + :initform "" + :type (or null string)) + (description :initarg :description + :accessor gnus-icalendar-event:description + :initform "" + :type (or null string)) + (location :initarg :location + :accessor gnus-icalendar-event:location + :initform "" + :type (or null string)) + (start :initarg :start + :accessor gnus-icalendar-event:start + :initform "" + :type (or null string)) + (end :initarg :end + :accessor gnus-icalendar-event:end + :initform "" + :type (or null string)) + (recur :initarg :recur + :accessor gnus-icalendar-event:recur + :initform "" + :type (or null string)) + (uid :initarg :uid + :accessor gnus-icalendar-event:uid + :type string) + (method :initarg :method + :accessor gnus-icalendar-event:method + :initform "PUBLISH" + :type (or null string)) + (rsvp :initarg :rsvp + :accessor gnus-icalendar-event:rsvp + :initform nil + :type (or null boolean))) + "generic iCalendar Event class") + +(defclass gnus-icalendar-event-request (gnus-icalendar-event) + nil + "iCalendar class for REQUEST events") + +(defclass gnus-icalendar-event-cancel (gnus-icalendar-event) + nil + "iCalendar class for CANCEL events") + +(defclass gnus-icalendar-event-reply (gnus-icalendar-event) + nil + "iCalendar class for REPLY events") + +(defmethod gnus-icalendar-event:recurring-p ((event gnus-icalendar-event)) + "Return t if EVENT is recurring." + (not (null (gnus-icalendar-event:recur event)))) + +(defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) + "Return recurring frequency of EVENT." + (let ((rrule (gnus-icalendar-event:recur event))) + (string-match "FREQ=\\([[:alpha:]]+\\)" rrule) + (match-string 1 rrule))) + +(defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) + "Return recurring interval of EVENT." + (let ((rrule (gnus-icalendar-event:recur event)) + (default-interval 1)) + + (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule) + (or (match-string 1 rrule) + default-interval))) + +(defmethod gnus-icalendar-event:start-time ((event gnus-icalendar-event)) + "Return time value of the EVENT start date." + (date-to-time (gnus-icalendar-event:start event))) + +(defmethod gnus-icalendar-event:end-time ((event gnus-icalendar-event)) + "Return time value of the EVENT end date." + (date-to-time (gnus-icalendar-event:end event))) + + +(defun gnus-icalendar-event--decode-datefield (ical field zone-map &optional date-style) + (let* ((calendar-date-style (or date-style 'european)) + (date (icalendar--get-event-property ical field)) + (date-zone (icalendar--find-time-zone + (icalendar--get-event-property-attributes + ical field) + zone-map)) + (date-decoded (icalendar--decode-isodatetime date nil date-zone))) + + (concat (icalendar--datetime-to-iso-date date-decoded "-") + " " + (icalendar--datetime-to-colontime date-decoded)))) + +(defun gnus-icalendar-event--find-attendee (ical name-or-email) + (let* ((event (car (icalendar--all-events ical))) + (event-props (caddr event))) + (labels ((attendee-name (att) (plist-get (cadr att) 'CN)) + (attendee-email (att) + (replace-regexp-in-string "^.*MAILTO:" "" (caddr att))) + (attendee-prop-matches-p (prop) + (and (eq (car prop) 'ATTENDEE) + (or (member (attendee-name prop) name-or-email) + (let ((att-email (attendee-email prop))) + (gnus-icalendar-find-if (lambda (email) + (string-match email att-email)) + name-or-email)))))) + + (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) + + +(defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email) + (let* ((event (car (icalendar--all-events ical))) + (zone-map (icalendar--convert-all-timezones ical)) + (organizer (replace-regexp-in-string + "^.*MAILTO:" "" + (or (icalendar--get-event-property event 'ORGANIZER) ""))) + (prop-map '((summary . SUMMARY) + (description . DESCRIPTION) + (location . LOCATION) + (recur . RRULE) + (uid . UID))) + (method (caddr (assoc 'METHOD (caddr (car (nreverse ical)))))) + (attendee (when attendee-name-or-email + (gnus-icalendar-event--find-attendee ical attendee-name-or-email))) + (args (list :method method + :organizer organizer + :start (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map) + :end (gnus-icalendar-event--decode-datefield event 'DTEND zone-map) + :rsvp (string= (plist-get (cadr attendee) 'RSVP) + "TRUE"))) + (event-class (pcase method + ("REQUEST" 'gnus-icalendar-event-request) + ("CANCEL" 'gnus-icalendar-event-cancel) + ("REPLY" 'gnus-icalendar-event-reply) + (_ 'gnus-icalendar-event)))) + + (labels ((map-property (prop) + (let ((value (icalendar--get-event-property event prop))) + (when value + ;; ugly, but cannot get + ;;replace-regexp-in-string work with "\\" as + ;;REP, plus we should also handle "\\;" + (replace-regexp-in-string + "\\\\," "," + (replace-regexp-in-string + "\\\\n" "\n" (substring-no-properties value)))))) + (accumulate-args (mapping) + (destructuring-bind (slot . ical-property) mapping + (setq args (append (list + (intern (concat ":" (symbol-name slot))) + (map-property ical-property)) + args))))) + + (mapc #'accumulate-args prop-map) + (apply 'make-instance event-class args)))) + +(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) + "Parse RFC5545 iCalendar in buffer BUF and return an event object. + +Return a gnus-icalendar-event object representing the first event +contained in the invitation. Return nil for calendars without an event entry. + +ATTENDEE-NAME-OR-EMAIL is a list of strings that will be matched +against the event's attendee names and emails. Invitation rsvp +status will be retrieved from the first matching attendee record." + (let ((ical (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) + (goto-char (point-min)) + (icalendar--read-element nil nil)))) + + (when ical + (gnus-icalendar-event-from-ical ical attendee-name-or-email)))) + +;;; +;;; gnus-icalendar-event-reply +;;; + +(defun gnus-icalendar-event--build-reply-event-body (ical-request status identities) + (let ((summary-status (capitalize (symbol-name status))) + (attendee-status (upcase (symbol-name status))) + reply-event-lines) + (labels ((update-summary (line) + (if (string-match "^[^:]+:" line) + (replace-match (format "\\&%s: " summary-status) t nil line) + line)) + (update-dtstamp () + (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) + (attendee-matches-identity (line) + (gnus-icalendar-find-if (lambda (name) (string-match-p name line)) + identities)) + (update-attendee-status (line) + (when (and (attendee-matches-identity line) + (string-match "\\(PARTSTAT=\\)[^;]+" line)) + (replace-match (format "\\1%s" attendee-status) t nil line))) + (process-event-line (line) + (when (string-match "^\\([^;:]+\\)" line) + (let* ((key (match-string 0 line)) + ;; NOTE: not all of the below fields are mandatory, + ;; but they are often present in other clients' + ;; replies. Can be helpful for debugging, too. + (new-line (pcase key + ("ATTENDEE" (update-attendee-status line)) + ("SUMMARY" (update-summary line)) + ("DTSTAMP" (update-dtstamp)) + ((or "ORGANIZER" "DTSTART" "DTEND" + "LOCATION" "DURATION" "SEQUENCE" + "RECURRENCE-ID" "UID") line) + (_ nil)))) + (when new-line + (push new-line reply-event-lines)))))) + + (mapc #'process-event-line (split-string ical-request "\n")) + + (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) + reply-event-lines) + (error "Could not find an event attendee matching given identity")) + + (mapconcat #'identity `("BEGIN:VEVENT" + ,@(nreverse reply-event-lines) + "END:VEVENT") + "\n")))) + +(defun gnus-icalendar-event-reply-from-buffer (buf status identities) + "Build a calendar event reply for request contained in BUF. +The reply will have STATUS (`accepted', `tentative' or `declined'). +The reply will be composed for attendees matching any entry +on the IDENTITIES list." + (flet ((extract-block (blockname) + (save-excursion + (let ((block-start-re (format "^BEGIN:%s" blockname)) + (block-end-re (format "^END:%s" blockname)) + start) + (when (re-search-forward block-start-re nil t) + (setq start (line-beginning-position)) + (re-search-forward block-end-re) + (buffer-substring-no-properties start (line-end-position))))))) + + (let (zone event) + (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) + (goto-char (point-min)) + (setq zone (extract-block "VTIMEZONE") + event (extract-block "VEVENT"))) + + (when event + (let ((contents (list "BEGIN:VCALENDAR" + "METHOD:REPLY" + "PRODID:Gnus" + "VERSION:2.0" + zone + (gnus-icalendar-event--build-reply-event-body event status identities) + "END:VCALENDAR"))) + + (mapconcat #'identity (delq nil contents) "\n")))))) + +;;; +;;; gnus-icalendar-org +;;; +;;; TODO: this is an optional feature, and it's only available with org-mode +;;; 7+, so will need to properly handle emacsen with no/outdated org-mode + +(require 'org) +(require 'org-capture) + +(defgroup gnus-icalendar-org nil + "Settings for Calendar Event gnus/org integration." + :group 'gnus-icalendar + :prefix "gnus-icalendar-org-") + +(defcustom gnus-icalendar-org-capture-file nil + "Target Org file for storing captured calendar events." + :type 'file + :group 'gnus-icalendar-org) + +(defcustom gnus-icalendar-org-capture-headline nil + "Target outline in `gnus-icalendar-org-capture-file' for storing captured events." + :type '(repeat string) + :group 'gnus-icalendar-org) + +(defcustom gnus-icalendar-org-template-name "used by gnus-icalendar-org" + "Org-mode template name." + :type '(string) + :group 'gnus-icalendar-org) + +(defcustom gnus-icalendar-org-template-key "#" + "Org-mode template hotkey." + :type '(string) + :group 'gnus-icalendar-org) + +(defvar gnus-icalendar-org-enabled-p nil) + + +(defmethod gnus-icalendar-event:org-repeat ((event gnus-icalendar-event)) + "Return `org-mode' timestamp repeater string for recurring EVENT. +Return nil for non-recurring EVENT." + (when (gnus-icalendar-event:recurring-p event) + (let* ((freq-map '(("HOURLY" . "h") + ("DAILY" . "d") + ("WEEKLY" . "w") + ("MONTHLY" . "m") + ("YEARLY" . "y"))) + (org-freq (cdr (assoc (gnus-icalendar-event:recurring-freq event) freq-map)))) + + (when org-freq + (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) + +(defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) + "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." + (let* ((start (gnus-icalendar-event:start-time event)) + (end (gnus-icalendar-event:end-time event)) + (start-date (format-time-string "%Y-%m-%d %a" start t)) + (start-time (format-time-string "%H:%M" start t)) + (end-date (format-time-string "%Y-%m-%d %a" end t)) + (end-time (format-time-string "%H:%M" end t)) + (org-repeat (gnus-icalendar-event:org-repeat event)) + (repeat (if org-repeat (concat " " org-repeat) ""))) + + (if (equal start-date end-date) + (format "<%s %s-%s%s>" start-date start-time end-time repeat) + (format "<%s %s>--<%s %s>" start-date start-time end-date end-time)))) + +;; TODO: make the template customizable +(defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) + "Return string with new `org-mode' entry describing EVENT." + (with-temp-buffer + (org-mode) + (with-slots (organizer summary description location + recur uid) event + (let* ((reply (if reply-status (capitalize (symbol-name reply-status)) + "Not replied yet")) + (props `(("ICAL_EVENT" . "t") + ("ID" . ,uid) + ("DT" . ,(gnus-icalendar-event:org-timestamp event)) + ("ORGANIZER" . ,(gnus-icalendar-event:organizer event)) + ("LOCATION" . ,(gnus-icalendar-event:location event)) + ("RRULE" . ,(gnus-icalendar-event:recur event)) + ("REPLY" . ,reply)))) + + (insert (format "* %s (%s)\n\n" summary location)) + (mapc (lambda (prop) + (org-entry-put (point) (car prop) (cdr prop))) + props)) + + (when description + (save-restriction + (narrow-to-region (point) (point)) + (insert description) + (indent-region (point-min) (point-max) 2) + (fill-region (point-min) (point-max)))) + + (buffer-string)))) + +(defun gnus-icalendar--deactivate-org-timestamp (ts) + (replace-regexp-in-string "[<>]" + (lambda (m) (pcase m ("<" "[") (">" "]"))) + ts)) + +(defun gnus-icalendar-find-org-event-file (event &optional org-file) + "Return the name of the file containing EVENT org entry. +Return nil when not found. + +All org agenda files are searched for the EVENT entry. When +the optional ORG-FILE argument is specified, only that one file +is searched." + (let ((uid (gnus-icalendar-event:uid event)) + (files (or org-file (org-agenda-files t 'ifmode)))) + (flet + ((find-event-in (file) + (org-check-agenda-file file) + (with-current-buffer (find-file-noselect file) + (let ((event-pos (org-find-entry-with-id uid))) + (when (and event-pos + (string= (cdr (assoc "ICAL_EVENT" (org-entry-properties event-pos))) + "t")) + (throw 'found file)))))) + + (gnus-icalendar-find-if #'find-event-in files)))) + + +(defun gnus-icalendar--show-org-event (event &optional org-file) + (let ((file (gnus-icalendar-find-org-event-file event org-file))) + (when file + (switch-to-buffer (find-file file)) + (goto-char (org-find-entry-with-id (gnus-icalendar-event:uid event))) + (org-show-entry)))) + + +(defun gnus-icalendar--update-org-event (event reply-status &optional org-file) + (let ((file (gnus-icalendar-find-org-event-file event org-file))) + (when file + (with-current-buffer (find-file-noselect file) + (with-slots (uid summary description organizer location recur) event + (let ((event-pos (org-find-entry-with-id uid))) + (when event-pos + (goto-char event-pos) + + ;; update the headline, keep todo, priority and tags, if any + (save-excursion + (let* ((priority (org-entry-get (point) "PRIORITY")) + (headline (delq nil (list + (org-entry-get (point) "TODO") + (when priority (format "[#%s]" priority)) + (format "%s (%s)" summary location) + (org-entry-get (point) "TAGS"))))) + + (re-search-forward "^\\*+ " (line-end-position)) + (delete-region (point) (line-end-position)) + (insert (mapconcat #'identity headline " ")))) + + ;; update props and description + (let ((entry-end (org-entry-end-position)) + (entry-outline-level (org-outline-level))) + + ;; delete body of the entry, leave org drawers intact + (save-restriction + (org-narrow-to-element) + (goto-char entry-end) + (re-search-backward "^[\t ]*:END:") + (forward-line) + (delete-region (point) entry-end)) + + ;; put new event description in the entry body + (when description + (save-restriction + (narrow-to-region (point) (point)) + (insert "\n" (replace-regexp-in-string "[\n]+$" "\n" description) "\n") + (indent-region (point-min) (point-max) (1+ entry-outline-level)) + (fill-region (point-min) (point-max)))) + + ;; update entry properties + (org-entry-put event-pos "DT" (gnus-icalendar-event:org-timestamp event)) + (org-entry-put event-pos "ORGANIZER" organizer) + (org-entry-put event-pos "LOCATION" location) + (org-entry-put event-pos "RRULE" recur) + (when reply-status (org-entry-put event-pos "REPLY" + (capitalize (symbol-name reply-status)))) + (save-buffer))))))))) + + +(defun gnus-icalendar--cancel-org-event (event &optional org-file) + (let ((file (gnus-icalendar-find-org-event-file event org-file))) + (when file + (with-current-buffer (find-file-noselect file) + (let ((event-pos (org-find-entry-with-id (gnus-icalendar-event:uid event)))) + (when event-pos + (let ((ts (org-entry-get event-pos "DT"))) + (when ts + (org-entry-put event-pos "DT" (gnus-icalendar--deactivate-org-timestamp ts)) + (save-buffer))))))))) + + +(defun gnus-icalendar--get-org-event-reply-status (event &optional org-file) + (let ((file (gnus-icalendar-find-org-event-file event org-file))) + (when file + (save-excursion + (with-current-buffer (find-file-noselect file) + (let ((event-pos (org-find-entry-with-id (gnus-icalendar-event:uid event)))) + (org-entry-get event-pos "REPLY"))))))) + + +(defun gnus-icalendar-insinuate-org-templates () + (unless (gnus-icalendar-find-if (lambda (x) (string= (cadr x) gnus-icalendar-org-template-name)) + org-capture-templates) + (setq org-capture-templates + (append `((,gnus-icalendar-org-template-key + ,gnus-icalendar-org-template-name + entry + (file+olp ,gnus-icalendar-org-capture-file ,@gnus-icalendar-org-capture-headline) + "%i" + :immediate-finish t)) + org-capture-templates)) + + ;; hide the template from interactive template selection list + ;; (org-capture) + ;; NOTE: doesn't work when capturing from string + ;; (when (boundp 'org-capture-templates-contexts) + ;; (push `(,gnus-icalendar-org-template-key "" ((in-mode . "gnus-article-mode"))) + ;; org-capture-templates-contexts)) + )) + +(defun gnus-icalendar:org-event-save (event reply-status) + (with-temp-buffer + (org-capture-string (gnus-icalendar-event->org-entry event reply-status) + gnus-icalendar-org-template-key))) + +(defun gnus-icalendar-show-org-agenda (event) + (let* ((time-delta (time-subtract (gnus-icalendar-event:end-time event) + (gnus-icalendar-event:start-time event))) + (duration-days (1+ (/ (+ (* (car time-delta) (expt 2 16)) + (cadr time-delta)) + 86400)))) + + (org-agenda-list nil (gnus-icalendar-event:start event) duration-days))) + +(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-request) reply-status) + (if (gnus-icalendar-find-org-event-file event) + (gnus-icalendar--update-org-event event reply-status) + (gnus-icalendar:org-event-save event reply-status))) + +(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel)) + (when (gnus-icalendar-find-org-event-file event) + (gnus-icalendar--cancel-org-event event))) + +(defun gnus-icalendar-org-setup () + (if (and gnus-icalendar-org-capture-file gnus-icalendar-org-capture-headline) + (progn + (gnus-icalendar-insinuate-org-templates) + (setq gnus-icalendar-org-enabled-p t)) + (message "Cannot enable Calendar->Org: missing capture file, headline"))) + +;;; +;;; gnus-icalendar +;;; + +(defgroup gnus-icalendar nil + "Settings for inline display of iCalendar invitations." + :group 'gnus-article + :prefix "gnus-icalendar-") + +(defcustom gnus-icalendar-reply-bufname "*CAL*" + "Buffer used for building iCalendar invitation reply." + :type '(string) + :group 'gnus-icalendar) + +(make-variable-buffer-local + (defvar gnus-icalendar-reply-status nil)) + +(make-variable-buffer-local + (defvar gnus-icalendar-event nil)) + +(make-variable-buffer-local + (defvar gnus-icalendar-handle nil)) + +(defvar gnus-icalendar-identities + (apply #'append + (mapcar (lambda (x) (if (listp x) x (list x))) + (list user-full-name (regexp-quote user-mail-address) + ; NOTE: this one can be a list + gnus-ignored-from-addresses)))) + +;; TODO: make the template customizable +(defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status) + "Format an overview of EVENT details." + (flet ((format-header (x) + (format "%-12s%s" + (propertize (concat (car x) ":") 'face 'bold) + (cadr x)))) + + (with-slots (organizer summary description location recur uid method rsvp) event + (let ((headers `(("Summary" ,summary) + ("Location" ,location) + ("Time" ,(gnus-icalendar-event:org-timestamp event)) + ("Organizer" ,organizer) + ("Method" ,method)))) + + (when (and (not (gnus-icalendar-event-reply-p event)) rsvp) + (setq headers (append headers + `(("Status" ,(or reply-status "Not replied yet")))))) + + (concat + (mapconcat #'format-header headers "\n") + "\n\n" + description))))) + +(defmacro gnus-icalendar-with-decoded-handle (handle &rest body) + "Execute BODY in buffer containing the decoded contents of HANDLE." + (let ((charset (make-symbol "charset"))) + `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle))))) + (with-temp-buffer + (mm-insert-part ,handle) + (when (string= ,charset "utf-8") + (mm-decode-coding-region (point-min) (point-max) 'utf-8)) + + ,@body)))) + + +(defun gnus-icalendar-event-from-handle (handle &optional attendee-name-or-email) + (gnus-icalendar-with-decoded-handle handle + (gnus-icalendar-event-from-buffer (current-buffer) attendee-name-or-email))) + +(defun gnus-icalendar-insert-button (text callback data) + ;; FIXME: the gnus-mime-button-map keymap does not make sense for this kind + ;; of button. + (let ((start (point))) + (gnus-add-text-properties + start + (progn + (insert "[ " text " ]") + (point)) + `(gnus-callback + ,callback + keymap ,gnus-mime-button-map + face ,gnus-article-button-face + gnus-data ,data)) + (widget-convert-button 'link start (point) + :action 'gnus-widget-press-button + :button-keymap gnus-widget-button-keymap))) + +(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject) + (let ((message-signature nil)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-reply) + (message-goto-body) + (mml-insert-multipart "alternative") + (mml-insert-empty-tag 'part 'type "text/plain") + (mml-attach-buffer buffer-name "text/calendar; method=REPLY; charset=UTF-8") + (message-goto-subject) + (delete-region (line-beginning-position) (line-end-position)) + (insert "Subject: " subject) + (message-send-and-exit)))) + +(defun gnus-icalendar-reply (data) + (let* ((handle (car data)) + (status (cadr data)) + (event (caddr data)) + (reply (gnus-icalendar-with-decoded-handle handle + (gnus-icalendar-event-reply-from-buffer + (current-buffer) status gnus-icalendar-identities)))) + + (when reply + (flet ((fold-icalendar-buffer () + (goto-char (point-min)) + (while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t) + (replace-match "\\1\n \\2") + (goto-char (line-beginning-position))))) + (let ((subject (concat (capitalize (symbol-name status)) + ": " (gnus-icalendar-event:summary event)))) + + (with-current-buffer (get-buffer-create gnus-icalendar-reply-bufname) + (delete-region (point-min) (point-max)) + (insert reply) + (fold-icalendar-buffer) + (gnus-icalendar-send-buffer-by-mail (buffer-name) subject)) + + ;; Back in article buffer + (setq-local gnus-icalendar-reply-status status) + (when gnus-icalendar-org-enabled-p + (gnus-icalendar--update-org-event event status) + ;; refresh article buffer to update the reply status + (with-current-buffer gnus-summary-buffer + (gnus-summary-show-article)))))))) + +(defun gnus-icalendar-sync-event-to-org (event) + (gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status)) + +(defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) + (when (gnus-icalendar-event:rsvp event) + `(("Accept" gnus-icalendar-reply (,handle accepted ,event)) + ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) + ("Decline" gnus-icalendar-reply (,handle declined ,event))))) + +(defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event-reply) handle) + "No buttons for REPLY events." + nil) + +(defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event)) + (or (when gnus-icalendar-org-enabled-p + (gnus-icalendar--get-org-event-reply-status event)) + "Not replied yet")) + +(defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event-reply)) + "No reply status for REPLY events." + nil) + + +(defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event)) + (let* ((org-entry-exists-p (gnus-icalendar-find-org-event-file event)) + (export-button-text (if org-entry-exists-p "Update Org Entry" "Export to Org"))) + + (delq nil (list + `("Show Agenda" gnus-icalendar-show-org-agenda ,event) + (when (gnus-icalendar-event-request-p event) + `(,export-button-text gnus-icalendar-sync-event-to-org ,event)) + (when org-entry-exists-p + `("Show Org Entry" gnus-icalendar--show-org-event ,event)))))) + +(defun gnus-icalendar-mm-inline (handle) + (let ((event (gnus-icalendar-event-from-handle handle gnus-icalendar-identities))) + + (setq gnus-icalendar-reply-status nil) + + (when event + (flet ((insert-button-group (buttons) + (when buttons + (mapc (lambda (x) + (apply 'gnus-icalendar-insert-button x) + (insert " ")) + buttons) + (insert "\n\n")))) + + (insert-button-group + (gnus-icalendar-event:inline-reply-buttons event handle)) + + (when gnus-icalendar-org-enabled-p + (insert-button-group (gnus-icalendar-event:inline-org-buttons event))) + + (setq gnus-icalendar-event event + gnus-icalendar-handle handle) + + (insert (gnus-icalendar-event->gnus-calendar + event + (gnus-icalendar-event:inline-reply-status event))))))) + +(defun gnus-icalendar-save-part (handle) + (let (event) + (when (and (equal (car (mm-handle-type handle)) "text/calendar") + (setq event (gnus-icalendar-event-from-handle handle gnus-icalendar-identities))) + + (gnus-icalendar-event:sync-to-org event)))) + + +(defun gnus-icalendar-save-event () + "Save the Calendar event in the text/calendar part under point." + (interactive) + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-data))) + (when data + (gnus-icalendar-save-part data)))) + +(defun gnus-icalendar-reply-accept () + "Accept invitation in the current article." + (interactive) + (with-current-buffer gnus-article-buffer + (gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event)) + (setq-local gnus-icalendar-reply-status 'accepted))) + +(defun gnus-icalendar-reply-tentative () + "Send tentative response to invitation in the current article." + (interactive) + (with-current-buffer gnus-article-buffer + (gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event)) + (setq-local gnus-icalendar-reply-status 'tentative))) + +(defun gnus-icalendar-reply-decline () + "Decline invitation in the current article." + (interactive) + (with-current-buffer gnus-article-buffer + (gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event)) + (setq-local gnus-icalendar-reply-status 'declined))) + +(defun gnus-icalendar-event-export () + "Export calendar event to `org-mode', or update existing agenda entry." + (interactive) + (with-current-buffer gnus-article-buffer + (gnus-icalendar-sync-event-to-org gnus-icalendar-event)) + ;; refresh article buffer in case the reply had been sent before initial org + ;; export + (with-current-buffer gnus-summary-buffer + (gnus-summary-show-article))) + +(defun gnus-icalendar-event-show () + "Display `org-mode' agenda entry related to the calendar event." + (interactive) + (gnus-icalendar--show-org-event + (with-current-buffer gnus-article-buffer + gnus-icalendar-event))) + +(defun gnus-icalendar-event-check-agenda () + "Display `org-mode' agenda for days between event start and end dates." + (interactive) + (gnus-icalendar-show-org-agenda + (with-current-buffer gnus-article-buffer gnus-icalendar-event))) + +(defun gnus-icalendar-setup () + (add-to-list 'mm-inlined-types "text/calendar") + (add-to-list 'mm-automatic-display "text/calendar") + (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity)) + + (gnus-define-keys (gnus-summary-calendar-map "i" gnus-summary-mode-map) + "a" gnus-icalendar-reply-accept + "t" gnus-icalendar-reply-tentative + "d" gnus-icalendar-reply-decline + "c" gnus-icalendar-event-check-agenda + "e" gnus-icalendar-event-export + "s" gnus-icalendar-event-show) + + (require 'gnus-art) + (add-to-list 'gnus-mime-action-alist + (cons "save calendar event" 'gnus-icalendar-save-event) + t)) + +(provide 'gnus-icalendar) + +;;; gnus-icalendar.el ends here diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 2378b598eeb..6aa874f0347 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -582,8 +582,8 @@ This is the string that Gnus uses to identify the group." (gnus-group-method group))) (defun gnus-warp-to-article () - "Warps from an article in a virtual group to the article in its -real group. Does nothing on a real group." + "Jump from an article in a virtual group to the article in its real group. +Does nothing in a real group." (interactive) (when (gnus-virtual-group-p gnus-newsgroup-name) (let ((gnus-command-method diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index e27fb522b86..9f3f469ad43 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -944,7 +944,8 @@ If REGEXP is given, lines that match it will be deleted." (when (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer)) (with-current-buffer gnus-dribble-buffer - (save-buffer)))) + (when (> (buffer-size) 0) + (save-buffer))))) (defun gnus-dribble-clear () (when (gnus-buffer-exists-p gnus-dribble-buffer) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index c50dcde0034..16ed4f17801 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -640,7 +640,7 @@ When called interactively, prompt for REGEXP." (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1 nil t)) + (zerop (forward-line 1)) (> (gnus-summary-thread-level) level))))) (gnus-summary-position-point)) @@ -650,7 +650,7 @@ When called interactively, prompt for REGEXP." (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-remove-process-mark (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) + (zerop (forward-line 1)) (> (gnus-summary-thread-level) level)))) (gnus-summary-position-point)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index b35eb9dca12..d6d6b3f8bed 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -264,7 +264,7 @@ This is a list of regexps and regexp matches." :type 'sexp) (defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:" + "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:\\|^X-Gnus-Delayed:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 98be1c5def2..7274708f014 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -63,6 +63,18 @@ :group 'news :group 'multimedia) +(defface mm-command-output + '((((class color) + (background dark)) + (:foreground "ForestGreen")) + (((class color) + (background light)) + (:foreground "red3")) + (t + (:italic t))) + "Face used for displaying output from commands." + :group 'mime-display) + ;;; Convenience macros. (defmacro mm-handle-buffer (handle) @@ -983,9 +995,12 @@ external if displayed external." (let ((buffer-read-only nil) (point (point))) (forward-line 2) - (mm-insert-inline - handle (with-current-buffer buffer - (buffer-string))) + (let ((start (point))) + (mm-insert-inline + handle (with-current-buffer buffer + (buffer-string))) + (put-text-property start (point) + 'face 'mm-command-output)) (goto-char point)))) (when (buffer-live-p buffer) (kill-buffer buffer))) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 2c2187a5f8d..3efa5c23bb3 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -885,17 +885,19 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defun mml2015-epg-key-image-to-string (key-id) "Return a string with the image of a key, if any" - (let* ((result "") - (key-image (mml2015-epg-key-image key-id))) - (when key-image - (setq result " ") - (put-text-property - 1 2 'display - (gnus-rescale-image key-image - (cons mml2015-maximum-key-image-dimension - mml2015-maximum-key-image-dimension)) - result)) - result)) + (let ((key-image (mml2015-epg-key-image key-id))) + (if (not key-image) + "" + (condition-case error + (let ((result " ")) + (put-text-property + 1 2 'display + (gnus-rescale-image key-image + (cons mml2015-maximum-key-image-dimension + mml2015-maximum-key-image-dimension)) + result) + result) + (error ""))))) (defun mml2015-epg-signature-to-string (signature) (concat (epg-signature-to-string signature) diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index 3228eacdd0a..c605541e7f1 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -148,28 +148,29 @@ (deffoo nnmbox-request-article (article &optional newsgroup server buffer) (nnmbox-possibly-change-newsgroup newsgroup server) (with-current-buffer nnmbox-mbox-buffer - (when (nnmbox-find-article article) - (let (start stop) - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (setq start (point)) - (forward-line 1) - (setq stop (if (re-search-forward (concat "^" - message-unix-mail-delimiter) - nil 'move) - (match-beginning 0) - (point))) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnmbox-mbox-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnmbox-current-group article) - (nnmbox-article-group-number nil))))))) + (save-excursion + (when (nnmbox-find-article article) + (let (start stop) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (setq start (point)) + (forward-line 1) + (setq stop (if (re-search-forward (concat "^" + message-unix-mail-delimiter) + nil 'move) + (match-beginning 0) + (point))) + (let ((nntp-server-buffer (or buffer nntp-server-buffer))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring nnmbox-mbox-buffer start stop) + (goto-char (point-min)) + (while (looking-at "From ") + (delete-char 5) + (insert "X-From-Line: ") + (forward-line 1)) + (if (numberp article) + (cons nnmbox-current-group article) + (nnmbox-article-group-number nil)))))))) (deffoo nnmbox-request-group (group &optional server dont-check info) (nnmbox-possibly-change-newsgroup nil server) @@ -255,14 +256,14 @@ (if (setq is-old (nnmail-expired-article-p newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) + (buffer-substring (point) (line-end-position)) + force)) (progn (unless (eq nnmail-expiry-target 'delete) (with-temp-buffer (nnmbox-request-article (car articles) - newsgroup server - (current-buffer)) + newsgroup server + (current-buffer)) (let ((nnml-current-directory nil)) (nnmail-expiry-target-group nnmail-expiry-target newsgroup))) |