[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r113640: Merge changes made in Gnus master
|
From: |
Katsumi Yamaoka |
|
Subject: |
[Emacs-diffs] trunk r113640: Merge changes made in Gnus master |
|
Date: |
Thu, 01 Aug 2013 22:59:17 +0000 |
|
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 113640
revision-id: address@hidden
parent: address@hidden
author: Gnus developers <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Thu 2013-08-01 22:58:40 +0000
message:
Merge changes made in Gnus master
2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
* gnus.texi (Basic Usage): Mention that warp means jump here.
(The notmuch Engine): Mention notmuch.
2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
* 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 (陳侃如) <address@hidden> (tiny change)
* nnmbox.el (nnmbox-request-article): Don't change point.
2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
* gnus-icalendar.el (gnus-icalendar-event:inline-reply-buttons):
Include `handle' parameter.
2013-08-01 Jan Tatarik <address@hidden>
* gnus-icalendar.el: New file.
2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
* 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 <address@hidden>
* mml2015.el (mml2015-epg-key-image-to-string): Protect against bugging
out on ttys.
2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
* gnus-start.el (gnus-dribble-save): Only save the dribble file if it's
not empty.
added:
lisp/gnus/gnus-icalendar.el
gnusicalendar.el-20130801225830-k3bdrwt8427ren1n-1
modified:
doc/misc/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-6331
doc/misc/gnus.texi gnus.texi-20091113204419-o5vbwnq5f7feedwu-6305
lisp/gnus/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1433
lisp/gnus/gnus-int.el gnusint.el-20091113204419-o5vbwnq5f7feedwu-1121
lisp/gnus/gnus-start.el
gnusstart.el-20091113204419-o5vbwnq5f7feedwu-1136
lisp/gnus/gnus-uu.el gnusuu.el-20091113204419-o5vbwnq5f7feedwu-1141
lisp/gnus/message.el message.el-20091113204419-o5vbwnq5f7feedwu-1145
lisp/gnus/mm-decode.el
mmdecode.el-20091113204419-o5vbwnq5f7feedwu-1971
lisp/gnus/mml2015.el mml2015.el-20091113204419-o5vbwnq5f7feedwu-3261
lisp/gnus/nnmbox.el nnmbox.el-20091113204419-o5vbwnq5f7feedwu-1157
=== modified file 'doc/misc/ChangeLog'
--- a/doc/misc/ChangeLog 2013-07-30 08:16:20 +0000
+++ b/doc/misc/ChangeLog 2013-08-01 22:58:40 +0000
@@ -1,3 +1,8 @@
+2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
+
+ * gnus.texi (Basic Usage): Mention that warp means jump here.
+ (The notmuch Engine): Mention notmuch.
+
2013-07-30 Tassilo Horn <address@hidden>
* gnus.texi (Sorting the Summary Buffer): Document new defcustom
=== modified file 'doc/misc/gnus.texi'
--- a/doc/misc/gnus.texi 2013-07-30 08:16:20 +0000
+++ b/doc/misc/gnus.texi 2013-08-01 22:58:40 +0000
@@ -21109,17 +21109,17 @@
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
address@hidden, bound by default in summary buffers to
address@hidden 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.
address@hidden, 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 @@
* 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 @@
For maximum searching efficiency you might want to have a cron job run
this command periodically, say every four hours.
+
address@hidden The notmuch Engine
address@hidden The notmuch Engine
+
address@hidden @code
address@hidden nnir-notmuch-program
+The name of the notmuch search executable. Defaults to
address@hidden
+
address@hidden nnir-notmuch-additional-switches
+A list of strings, to be given as additional arguments to notmuch.
+
address@hidden 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.
+
address@hidden table
+
+
@node The hyrex Engine
@subsubsection The hyrex Engine
This engine is obsolete.
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2013-08-01 11:23:38 +0000
+++ b/lisp/gnus/ChangeLog 2013-08-01 22:58:40 +0000
@@ -1,5 +1,44 @@
2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
+ * 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 (陳侃如) <address@hidden> (tiny change)
+
+ * nnmbox.el (nnmbox-request-article): Don't change point.
+
+2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
+
+ * gnus-icalendar.el (gnus-icalendar-event:inline-reply-buttons):
+ Include `handle' parameter.
+
+2013-08-01 Jan Tatarik <address@hidden>
+
+ * gnus-icalendar.el: New file.
+
+2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
+
+ * 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 <address@hidden>
+
+ * mml2015.el (mml2015-epg-key-image-to-string): Protect against bugging
+ out on ttys.
+
+2013-08-01 Lars Magne Ingebrigtsen <address@hidden>
+
+ * 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 <address@hidden>
=== added file 'lisp/gnus/gnus-icalendar.el'
--- a/lisp/gnus/gnus-icalendar.el 1970-01-01 00:00:00 +0000
+++ b/lisp/gnus/gnus-icalendar.el 2013-08-01 22:58:40 +0000
@@ -0,0 +1,837 @@
+;;; gnus-icalendar.el --- reply to iCalendar meeting requests
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: Jan Tatarik <address@hidden>
+;; 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
=== modified file 'lisp/gnus/gnus-int.el'
--- a/lisp/gnus/gnus-int.el 2013-01-30 22:45:32 +0000
+++ b/lisp/gnus/gnus-int.el 2013-08-01 22:58:40 +0000
@@ -582,8 +582,8 @@
(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
=== modified file 'lisp/gnus/gnus-start.el'
--- a/lisp/gnus/gnus-start.el 2013-07-30 22:09:37 +0000
+++ b/lisp/gnus/gnus-start.el 2013-08-01 22:58:40 +0000
@@ -944,7 +944,8 @@
(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)
=== modified file 'lisp/gnus/gnus-uu.el'
--- a/lisp/gnus/gnus-uu.el 2013-01-01 09:11:05 +0000
+++ b/lisp/gnus/gnus-uu.el 2013-08-01 22:58:40 +0000
@@ -640,7 +640,7 @@
(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 @@
(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))
=== modified file 'lisp/gnus/message.el'
--- a/lisp/gnus/message.el 2013-07-06 23:40:56 +0000
+++ b/lisp/gnus/message.el 2013-08-01 22:58:40 +0000
@@ -264,7 +264,7 @@
: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
=== modified file 'lisp/gnus/mm-decode.el'
--- a/lisp/gnus/mm-decode.el 2013-06-18 07:16:09 +0000
+++ b/lisp/gnus/mm-decode.el 2013-08-01 22:58:40 +0000
@@ -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 @@
(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)))
=== modified file 'lisp/gnus/mml2015.el'
--- a/lisp/gnus/mml2015.el 2013-07-02 02:34:12 +0000
+++ b/lisp/gnus/mml2015.el 2013-08-01 22:58:40 +0000
@@ -885,17 +885,19 @@
(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)
=== modified file 'lisp/gnus/nnmbox.el'
--- a/lisp/gnus/nnmbox.el 2013-01-01 09:11:05 +0000
+++ b/lisp/gnus/nnmbox.el 2013-08-01 22:58:40 +0000
@@ -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)))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r113640: Merge changes made in Gnus master,
Katsumi Yamaoka <=