Przeglądaj źródła

Merge branch 'master' of orgmode.org:org-mode

Eric Schulte 14 lat temu
rodzic
commit
840052b910
11 zmienionych plików z 249 dodań i 103 usunięć
  1. 24 17
      doc/org.texi
  2. 1 1
      lisp/ob-exp.el
  3. 15 8
      lisp/org-agenda.el
  4. 18 9
      lisp/org-bbdb.el
  5. 20 6
      lisp/org-crypt.el
  6. 3 3
      lisp/org-datetree.el
  7. 2 1
      lisp/org-exp.el
  8. 29 1
      lisp/org-gnus.el
  9. 1 1
      lisp/org-latex.el
  10. 22 21
      lisp/org-mhe.el
  11. 114 35
      lisp/org-publish.el

+ 24 - 17
doc/org.texi

@@ -6880,7 +6880,7 @@ the easiest way to maintain it is through the following commands
 
 
 @cindex files, adding to agenda list
 @cindex files, adding to agenda list
 @table @kbd
 @table @kbd
-@orgcmd{C-c [,org-agenda-to-front}
+@orgcmd{C-c [,org-agenda-file-to-front}
 Add current file to the list of agenda files.  The file is added to
 Add current file to the list of agenda files.  The file is added to
 the front of the list.  If it was already in the list, it is moved to
 the front of the list.  If it was already in the list, it is moved to
 the front.  With a prefix argument, file is added/moved to the end.
 the front.  With a prefix argument, file is added/moved to the end.
@@ -7098,14 +7098,15 @@ following to one your your agenda files:
 
 
 You can then go ahead and define anniversaries for a BBDB record.  Basically,
 You can then go ahead and define anniversaries for a BBDB record.  Basically,
 you need to press @kbd{C-o anniversary @key{RET}} with the cursor in a BBDB
 you need to press @kbd{C-o anniversary @key{RET}} with the cursor in a BBDB
-record and then add the date in the format @code{YYYY-MM-DD}, followed by a
-space and the class of the anniversary (@samp{birthday} or @samp{wedding}, or
-a format string).  If you omit the class, it will default to @samp{birthday}.
-Here are a few examples, the header for the file @file{org-bbdb.el} contains
-more detailed information.
+record and then add the date in the format @code{YYYY-MM-DD} or @code{MM-DD},
+followed by a space and the class of the anniversary (@samp{birthday} or
+@samp{wedding}, or a format string).  If you omit the class, it will default to
+@samp{birthday}. Here are a few examples, the header for the file
+@file{org-bbdb.el} contains more detailed information.
 
 
 @example
 @example
 1973-06-22
 1973-06-22
+06-22
 1955-08-02 wedding
 1955-08-02 wedding
 2008-04-14 %s released version 6.01 of org-mode, %d years ago
 2008-04-14 %s released version 6.01 of org-mode, %d years ago
 @end example
 @end example
@@ -7451,12 +7452,14 @@ will still be searched for stuck projects.
 @cindex presentation, of agenda items
 @cindex presentation, of agenda items
 
 
 @vindex org-agenda-prefix-format
 @vindex org-agenda-prefix-format
-Before displaying items in an agenda view, Org-mode visually prepares
-the items and sorts them.  Each item occupies a single line.  The line
-starts with a @emph{prefix} that contains the @emph{category}
-(@pxref{Categories}) of the item and other important information.  You can
-customize the prefix using the option @code{org-agenda-prefix-format}.
-The prefix is followed by a cleaned-up version of the outline headline
+@vindex org-agenda-tags-column
+Before displaying items in an agenda view, Org-mode visually prepares the
+items and sorts them.  Each item occupies a single line.  The line starts
+with a @emph{prefix} that contains the @emph{category} (@pxref{Categories})
+of the item and other important information.  You can customize in which
+column tags will be displayed through @code{org-agenda-tags-column}.  You can
+also customize the prefix using the option @code{org-agenda-prefix-format}.
+This prefix is followed by a cleaned-up version of the outline headline
 associated with the item.
 associated with the item.
 
 
 @menu
 @menu
@@ -8685,8 +8688,8 @@ syntax; it is exported verbatim.
 @node Horizontal rules, Comment lines, Emphasis and monospace, Structural markup elements
 @node Horizontal rules, Comment lines, Emphasis and monospace, Structural markup elements
 @subheading  Horizontal rules
 @subheading  Horizontal rules
 @cindex horizontal rules, markup rules
 @cindex horizontal rules, markup rules
-A line consisting of only dashes, and at least 5 of them, will be
-exported as a horizontal line (@samp{<hr/>} in HTML).
+A line consisting of only dashes, and at least 5 of them, will be exported as
+a horizontal line (@samp{<hr/>} in HTML and @code{\hrule} in @LaTeX{}).
 
 
 @node Comment lines,  , Horizontal rules, Structural markup elements
 @node Comment lines,  , Horizontal rules, Structural markup elements
 @subheading Comment lines
 @subheading Comment lines
@@ -10973,9 +10976,13 @@ of links to all files in the project.
 (default) or @code{last} to display folders first or last,
 (default) or @code{last} to display folders first or last,
 respectively.  Any other value will mix files and folders.
 respectively.  Any other value will mix files and folders.
 
 
-@item @code{:sitemap-alphabetically}
-@tab The site map is normally sorted alphabetically.  Set this explicitly to
-@code{nil} to turn off sorting.
+@item @code{:sitemap-sort-files}
+@tab How the files are sorted in the site map.  Set this
+@code{alphabetically} (default), @code{chronologically} or
+@code{anti-chronologically}. @code{chronologically} sorts the files with
+older date first while @code{anti-chronologically} sorts the files with newer
+date first. @code{alphabetically} sorts the files alphabetically. The date of
+a file is retrieved with @code{org-publish-find-date}.
 
 
 @item @code{:sitemap-ignore-case}
 @item @code{:sitemap-ignore-case}
 @tab Should sorting be case-sensitive?  Default @code{nil}.
 @tab Should sorting be case-sensitive?  Default @code{nil}.

+ 1 - 1
lisp/ob-exp.el

@@ -222,7 +222,7 @@ options are taken from `org-babel-default-header-args'."
 			 (car (last lob-info)))
 			 (car (last lob-info)))
 		   'lob))))
 		   'lob))))
 	(setq end (+ end (- (length replacement) (length (match-string 0)))))
 	(setq end (+ end (- (length replacement) (length (match-string 0)))))
-	(replace-match replacement t t)))))
+	(if replacement (replace-match replacement t t))))))
 
 
 (defun org-babel-exp-do-export (info type)
 (defun org-babel-exp-do-export (info type)
   "Return a string with the exported content of a code block.
   "Return a string with the exported content of a code block.

+ 15 - 8
lisp/org-agenda.el

@@ -2161,6 +2161,7 @@ Pressing `<' twice means to restrict to the current subtree or region
       (put 'org-agenda-redo-command 'org-lprops nil)
       (put 'org-agenda-redo-command 'org-lprops nil)
       ;; Remember where this call originated
       ;; Remember where this call originated
       (setq org-agenda-last-dispatch-buffer (current-buffer))
       (setq org-agenda-last-dispatch-buffer (current-buffer))
+      (kill-local-variable 'org-agenda-current-span)
       (unless keys
       (unless keys
 	(setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
 	(setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
 	      keys (car ans)
 	      keys (car ans)
@@ -3609,7 +3610,7 @@ given in `org-agenda-start-on-weekday'."
     (when (and org-agenda-clockreport-mode clocktable-start)
     (when (and org-agenda-clockreport-mode clocktable-start)
       (let ((org-agenda-files (org-agenda-files nil 'ifmode))
       (let ((org-agenda-files (org-agenda-files nil 'ifmode))
 	    ;; the above line is to ensure the restricted range!
 	    ;; the above line is to ensure the restricted range!
-	    (p org-agenda-clockreport-parameter-plist)
+	    (p (copy-sequence org-agenda-clockreport-parameter-plist))
 	    tbl)
 	    tbl)
 	(setq p (org-plist-delete p :block))
 	(setq p (org-plist-delete p :block))
 	(setq p (plist-put p :tstart clocktable-start))
 	(setq p (plist-put p :tstart clocktable-start))
@@ -3623,7 +3624,6 @@ given in `org-agenda-start-on-weekday'."
 						      ""
 						      ""
 						    x))
 						    x))
 						filter ""))))
 						filter ""))))
-	(message "%s" (plist-get p :tags)) (sit-for 2)
 	(setq tbl (apply 'org-get-clocktable p))
 	(setq tbl (apply 'org-get-clocktable p))
 	(insert tbl)))
 	(insert tbl)))
     (goto-char (point-min))
     (goto-char (point-min))
@@ -4489,7 +4489,8 @@ the documentation of `org-diary'."
 	      (while (setq arg (pop args))
 	      (while (setq arg (pop args))
 		(cond
 		(cond
 		 ((and (eq arg :todo)
 		 ((and (eq arg :todo)
-		       (equal date (calendar-current-date)))
+		       (equal date (calendar-gregorian-from-absolute
+				    (org-today))))
 		  (setq rtn (org-agenda-get-todos))
 		  (setq rtn (org-agenda-get-todos))
 		  (setq results (append results rtn)))
 		  (setq results (append results rtn)))
 		 ((eq arg :timestamp)
 		 ((eq arg :timestamp)
@@ -5921,7 +5922,7 @@ to switch to narrowing."
 	 (effort-prompt "")
 	 (effort-prompt "")
 	 (inhibit-read-only t)
 	 (inhibit-read-only t)
 	 (current org-agenda-filter)
 	 (current org-agenda-filter)
-	 a n tag)
+	 maybe-reftresh a n tag)
     (unless char
     (unless char
       (message
       (message
        "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
        "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
@@ -5967,11 +5968,13 @@ to switch to narrowing."
 	    (if modifier
 	    (if modifier
 		(push modifier org-agenda-filter))))
 		(push modifier org-agenda-filter))))
 	(if (not (null org-agenda-filter))
 	(if (not (null org-agenda-filter))
-	    (org-agenda-filter-apply org-agenda-filter))))
+	    (org-agenda-filter-apply org-agenda-filter)))
+      (setq maybe-reftresh t))
      ((equal char ?/)
      ((equal char ?/)
       (org-agenda-filter-by-tag-show-all)
       (org-agenda-filter-by-tag-show-all)
       (when (get 'org-agenda-filter :preset-filter)
       (when (get 'org-agenda-filter :preset-filter)
-	(org-agenda-filter-apply org-agenda-filter)))
+	(org-agenda-filter-apply org-agenda-filter))
+      (setq maybe-reftresh t))
      ((or (equal char ?\ )
      ((or (equal char ?\ )
 	  (setq a (rassoc char alist))
 	  (setq a (rassoc char alist))
 	  (and (>= char ?0) (<= char ?9)
 	  (and (>= char ?0) (<= char ?9)
@@ -5987,8 +5990,12 @@ to switch to narrowing."
       (setq org-agenda-filter
       (setq org-agenda-filter
 	    (cons (concat (if strip "-" "+") tag)
 	    (cons (concat (if strip "-" "+") tag)
 		  (if narrow current nil)))
 		  (if narrow current nil)))
-      (org-agenda-filter-apply org-agenda-filter))
-     (t (error "Invalid tag selection character %c" char)))))
+      (org-agenda-filter-apply org-agenda-filter)
+      (setq maybe-reftresh t))
+     (t (error "Invalid tag selection character %c" char)))
+    (when (and maybe-reftresh
+	       (eq org-agenda-clockreport-mode 'with-filter))
+      (org-agenda-redo))))
 
 
 (defun org-agenda-get-represented-tags ()
 (defun org-agenda-get-represented-tags ()
   "Get a list of all tags currently represented in the agenda."
   "Get a list of all tags currently represented in the agenda."

+ 18 - 9
lisp/org-bbdb.el

@@ -136,12 +136,12 @@
   '(("birthday" lambda
   '(("birthday" lambda
      (name years suffix)
      (name years suffix)
      (concat "Birthday: [[bbdb:" name "][" name " ("
      (concat "Birthday: [[bbdb:" name "][" name " ("
-	     (number-to-string years)
+	     (format "%s" years)        ; handles numbers as well as strings
 	     suffix ")]]"))
 	     suffix ")]]"))
     ("wedding" lambda
     ("wedding" lambda
      (name years suffix)
      (name years suffix)
      (concat "[[bbdb:" name "][" name "'s "
      (concat "[[bbdb:" name "][" name "'s "
-	     (number-to-string years)
+	     (format "%s" years)
 	     suffix " wedding anniversary]]")))
 	     suffix " wedding anniversary]]")))
   "How different types of anniversaries should be formatted.
   "How different types of anniversaries should be formatted.
 An alist of elements (STRING . FORMAT) where STRING is the name of an
 An alist of elements (STRING . FORMAT) where STRING is the name of an
@@ -239,11 +239,16 @@ italicized, in all other cases it is left unchanged."
 
 
 (defun org-bbdb-anniv-extract-date (time-str)
 (defun org-bbdb-anniv-extract-date (time-str)
   "Convert YYYY-MM-DD to (month date year).
   "Convert YYYY-MM-DD to (month date year).
-Argument TIME-STR is the value retrieved from BBDB."
-  (multiple-value-bind (y m d) (values-list (bbdb-split time-str "-"))
-    (list (string-to-number m)
-	  (string-to-number d)
-	  (string-to-number y))))
+Argument TIME-STR is the value retrieved from BBDB.  If YYYY- is omitted
+it will be considered unknown."
+  (multiple-value-bind (a b c) (values-list (bbdb-split time-str "-"))
+    (if (eq c nil)
+        (list (string-to-number a)
+              (string-to-number b)
+              nil)
+      (list (string-to-number b)
+            (string-to-number c)
+            (string-to-number a)))))
 
 
 (defun org-bbdb-anniv-split (str)
 (defun org-bbdb-anniv-split (str)
   "Split multiple entries in the BBDB anniversary field.
   "Split multiple entries in the BBDB anniversary field.
@@ -326,8 +331,12 @@ This is used by Org to re-create the anniversary hash table."
 				 class org-bbdb-anniversary-format-alist t))
 				 class org-bbdb-anniversary-format-alist t))
                            class))	; (as format string)
                            class))	; (as format string)
                  (name (nth 1 rec))
                  (name (nth 1 rec))
-                 (years (- y (car rec)))
-                 (suffix (diary-ordinal-suffix years))
+                 (years (if (eq (car rec) nil)
+                            "unknown"
+                          (- y (car rec))))
+                 (suffix (if (eq (car rec) nil)
+                             ""
+                           (diary-ordinal-suffix years)))
                  (tmp (cond
                  (tmp (cond
                        ((functionp form)
                        ((functionp form)
                         (funcall form name years suffix))
                         (funcall form name years suffix))

+ 20 - 6
lisp/org-crypt.el

@@ -103,6 +103,15 @@ This setting can also be overridden in the CRYPTKEY property."
         (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to)
         (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to)
         (message "No crypt key set, using symmetric encryption."))))
         (message "No crypt key set, using symmetric encryption."))))
 
 
+(defun org-encrypt-string (str crypt-key)
+  "Return STR encrypted with CRYPT-KEY."
+  ;; Text and key have to be identical, otherwise we re-crypt.
+  (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str))
+	   (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str)))
+      (get-text-property 0 'org-crypt-text str)
+    (let ((epg-context (epg-make-context nil t t)))
+      (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))))
+
 (defun org-encrypt-entry ()
 (defun org-encrypt-entry ()
   "Encrypt the content of the current headline."
   "Encrypt the content of the current headline."
   (interactive)
   (interactive)
@@ -122,10 +131,7 @@ This setting can also be overridden in the CRYPTKEY property."
           (org-back-over-empty-lines)
           (org-back-over-empty-lines)
           (setq end (point)
           (setq end (point)
                 encrypted-text
                 encrypted-text
-                (epg-encrypt-string
-                 epg-context
-                 (buffer-substring-no-properties beg end)
-                 (epg-list-keys epg-context crypt-key)))
+		(org-encrypt-string (buffer-substring beg end) crypt-key))
           (delete-region beg end)
           (delete-region beg end)
           (insert encrypted-text)
           (insert encrypted-text)
           (when folded
           (when folded
@@ -152,16 +158,24 @@ This setting can also be overridden in the CRYPTKEY property."
 			(forward-line)
 			(forward-line)
 			(point)))
 			(point)))
 		 (epg-context (epg-make-context nil t t))
 		 (epg-context (epg-make-context nil t t))
+		 (encrypted-text (buffer-substring-no-properties (point) end))
 		 (decrypted-text
 		 (decrypted-text
 		  (decode-coding-string
 		  (decode-coding-string
 		   (epg-decrypt-string
 		   (epg-decrypt-string
 		    epg-context
 		    epg-context
-		    (buffer-substring-no-properties (point) end))
+		    encrypted-text)
 		   'utf-8)))
 		   'utf-8)))
 	    ;; Delete region starting just before point, because the
 	    ;; Delete region starting just before point, because the
 	    ;; outline property starts at the \n of the heading.
 	    ;; outline property starts at the \n of the heading.
 	    (delete-region (1- (point)) end)
 	    (delete-region (1- (point)) end)
-	    (insert "\n" decrypted-text)
+	    ;; Store a checksum of the decrypted and the encrypted
+	    ;; text value. This allow to reuse the same encrypted text
+	    ;; if the text does not change, and therefore avoid a
+	    ;; re-encryption process.
+	    (insert "\n" (propertize decrypted-text
+				     'org-crypt-checksum (sha1 decrypted-text)
+				     'org-crypt-key (org-crypt-key-for-heading)
+				     'org-crypt-text encrypted-text))
 	    (when heading-was-invisible-p
 	    (when heading-was-invisible-p
 	      (goto-char heading-point)
 	      (goto-char heading-point)
 	      (org-flag-subtree t))
 	      (org-flag-subtree t))

+ 3 - 3
lisp/org-datetree.el

@@ -64,7 +64,7 @@ tree can be found."
       (goto-char (prog1 (point) (widen))))))
       (goto-char (prog1 (point) (widen))))))
 
 
 (defun org-datetree-find-year-create (year)
 (defun org-datetree-find-year-create (year)
-  (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)[ \t\n]")
+  (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)[ \t]*$")
 	match)
 	match)
     (goto-char (point-min))
     (goto-char (point-min))
     (while (and (setq match (re-search-forward re nil t))
     (while (and (setq match (re-search-forward re nil t))
@@ -83,7 +83,7 @@ tree can be found."
 
 
 (defun org-datetree-find-month-create (year month)
 (defun org-datetree-find-month-create (year month)
   (org-narrow-to-subtree)
   (org-narrow-to-subtree)
-  (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\)[ \t\n]" year))
+  (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\)[ \t]*$" year))
 	match)
 	match)
     (goto-char (point-min))
     (goto-char (point-min))
     (while (and (setq match (re-search-forward re nil t))
     (while (and (setq match (re-search-forward re nil t))
@@ -102,7 +102,7 @@ tree can be found."
 
 
 (defun org-datetree-find-day-create (year month day)
 (defun org-datetree-find-day-create (year month day)
   (org-narrow-to-subtree)
   (org-narrow-to-subtree)
-  (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\)[ \t\n]" year month))
+  (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\)[ \t]*$" year month))
 	match)
 	match)
     (goto-char (point-min))
     (goto-char (point-min))
     (while (and (setq match (re-search-forward re nil t))
     (while (and (setq match (re-search-forward re nil t))

+ 2 - 1
lisp/org-exp.el

@@ -388,7 +388,7 @@ Good for general initialization")
   "Hook for preprocessing an export buffer.
   "Hook for preprocessing an export buffer.
 Pretty much the first thing when exporting is running this hook.
 Pretty much the first thing when exporting is running this hook.
 Point will be in a temporary buffer that contains a copy of
 Point will be in a temporary buffer that contains a copy of
-the original buffer, or of the section that is being export.
+the original buffer, or of the section that is being exported.
 All the other hooks in the org-export-preprocess... category
 All the other hooks in the org-export-preprocess... category
 also work in that temporary buffer, already modified by various
 also work in that temporary buffer, already modified by various
 stages of the processing.")
 stages of the processing.")
@@ -963,6 +963,7 @@ value of `org-export-run-in-background'."
 		  (setq r1 (read-char-exclusive)))
 		  (setq r1 (read-char-exclusive)))
 	      (error "No enclosing node with LaTeX_CLASS or EXPORT_FILE_NAME")
 	      (error "No enclosing node with LaTeX_CLASS or EXPORT_FILE_NAME")
 	      )))))
 	      )))))
+    (redisplay)
     (and bpos (goto-char bpos))
     (and bpos (goto-char bpos))
     (setq r2 (if (< r1 27) (+ r1 96) r1))
     (setq r2 (if (< r1 27) (+ r1 96) r1))
     (unless (setq ass (assq r2 cmds))
     (unless (setq ass (assq r2 cmds))

+ 29 - 1
lisp/org-gnus.el

@@ -186,7 +186,35 @@ If `org-store-link' was called with a prefix arg the meaning of
 	    link (org-gnus-article-link
 	    link (org-gnus-article-link
 		  group	newsgroups message-id x-no-archive))
 		  group	newsgroups message-id x-no-archive))
       (org-add-link-props :link link :description desc)
       (org-add-link-props :link link :description desc)
-      link))))
+      link))
+   ((eq major-mode 'message-mode)
+    (setq org-store-link-plist nil)  ; reset
+    (save-excursion
+      (save-restriction
+        (message-narrow-to-headers)
+        (and (not (message-fetch-field "Message-ID"))
+             (message-generate-headers '(Message-ID)))
+        (goto-char (point-min))
+        (re-search-forward "^Message-ID: *.*$" nil t)
+        (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil)
+        (let ((gcc (car (last
+                         (message-unquote-tokens
+                          (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,")))))
+              (id (org-remove-angle-brackets (mail-fetch-field "Message-ID")))
+              (to (mail-fetch-field "To"))
+              (from (mail-fetch-field "From"))
+              (subject (mail-fetch-field "Subject"))
+              desc link
+              newsgroup xarchive)       ; those are always nil for gcc
+          (and (not gcc)
+               (error "Can not create link: No Gcc header found."))
+          (org-store-link-props :type "gnus" :from from :subject subject
+                                :message-id id :group gcc :to to)
+          (setq desc (org-email-link-description)
+                link (org-gnus-article-link
+                      gcc newsgroup id xarchive))
+          (org-add-link-props :link link :description desc)
+          link))))))
 
 
 (defun org-gnus-open-nntp (path)
 (defun org-gnus-open-nntp (path)
   "Follow the nntp: link specified by PATH."
   "Follow the nntp: link specified by PATH."

+ 1 - 1
lisp/org-latex.el

@@ -2270,7 +2270,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
 
 
   ;; Convert horizontal rules
   ;; Convert horizontal rules
   (goto-char (point-min))
   (goto-char (point-min))
-  (while (re-search-forward "^----+.$" nil t)
+  (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t)
     (org-if-unprotected
     (org-if-unprotected
      (replace-match (org-export-latex-protect-string "\\hrule") t t)))
      (replace-match (org-export-latex-protect-string "\\hrule") t t)))
 
 

+ 22 - 21
lisp/org-mhe.el

@@ -83,27 +83,28 @@ supported by MH-E."
   "Store a link to an MH-E folder or message."
   "Store a link to an MH-E folder or message."
   (when (or (equal major-mode 'mh-folder-mode)
   (when (or (equal major-mode 'mh-folder-mode)
 	    (equal major-mode 'mh-show-mode))
 	    (equal major-mode 'mh-show-mode))
-    (let* ((from (org-mhe-get-header "From:"))
-	   (to (org-mhe-get-header "To:"))
-	   (message-id (org-mhe-get-header "Message-Id:"))
-	   (subject (org-mhe-get-header "Subject:"))
-	   (date (org-mhe-get-header "Date:"))
-	   (date-ts (and date (format-time-string
-			       (org-time-stamp-format t) (date-to-time date))))
-	   (date-ts-ia (and date (format-time-string
-				  (org-time-stamp-format t t)
-				  (date-to-time date))))
-	   link desc)
-      (org-store-link-props :type "mh" :from from :to to
-			    :subject subject :message-id message-id)
-      (when date
-	(org-add-link-props :date date :date-timestamp date-ts
-			    :date-timestamp-inactive date-ts-ia))
-      (setq desc (org-email-link-description))
-      (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
-				(org-remove-angle-brackets message-id)))
-      (org-add-link-props :link link :description desc)
-      link)))
+    (save-window-excursion
+      (let* ((from (org-mhe-get-header "From:"))
+	     (to (org-mhe-get-header "To:"))
+	     (message-id (org-mhe-get-header "Message-Id:"))
+	     (subject (org-mhe-get-header "Subject:"))
+	     (date (org-mhe-get-header "Date:"))
+	     (date-ts (and date (format-time-string
+				 (org-time-stamp-format t) (date-to-time date))))
+	     (date-ts-ia (and date (format-time-string
+				    (org-time-stamp-format t t)
+				    (date-to-time date))))
+	     link desc)
+	(org-store-link-props :type "mh" :from from :to to
+			      :subject subject :message-id message-id)
+	(when date
+	  (org-add-link-props :date date :date-timestamp date-ts
+			      :date-timestamp-inactive date-ts-ia))
+	(setq desc (org-email-link-description))
+	(setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
+				  (org-remove-angle-brackets message-id)))
+	(org-add-link-props :link link :description desc)
+	link))))
 
 
 (defun org-mhe-open (path)
 (defun org-mhe-open (path)
   "Follow an MH-E message link specified by PATH."
   "Follow an MH-E message link specified by PATH."

+ 114 - 35
lisp/org-publish.el

@@ -186,8 +186,9 @@ sitemap of files or summary page for a given project.
                            Set this to `first' (default) or `last' to
                            Set this to `first' (default) or `last' to
                            display folders first or last, respectively.
                            display folders first or last, respectively.
                            Any other value will mix files and folders.
                            Any other value will mix files and folders.
-  :sitemap-alphabetically  The site map is normally sorted alphabetically.
-                           Set this explicitly to nil to turn off sorting.
+  :sitemap-sort-files      The site map is normally sorted alphabetically.
+                           You can change this behaviour setting this to
+                           `chronologically', `anti-chronologically' or nil.
   :sitemap-ignore-case     Should sorting be case-sensitive?  Default nil.
   :sitemap-ignore-case     Should sorting be case-sensitive?  Default nil.
 
 
 The following properties control the creation of a concept index.
 The following properties control the creation of a concept index.
@@ -233,13 +234,18 @@ Any changes made by this hook will be saved."
   :group 'org-publish
   :group 'org-publish
   :type 'hook)
   :type 'hook)
 
 
-(defcustom org-publish-sitemap-sort-alphabetically t
-  "Should sitemaps be sorted alphabetically by default?
+(defcustom org-publish-sitemap-sort-files 'alphabetically
+  "How sitemaps files should be sorted by default?
+Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil.
+If `alphabetically', files will be sorted alphabetically.
+If `chronologically', files will be sorted with older modification time first.
+If `anti-chronologically', files will be sorted with newer modification time first.
+nil won't sort files.
 
 
 You can overwrite this default per project in your
 You can overwrite this default per project in your
-`org-publish-project-alist', using `:sitemap-alphabetically'."
+`org-publish-project-alist', using `:sitemap-sort-files'."
   :group 'org-publish
   :group 'org-publish
-  :type 'boolean)
+  :type 'symbol)
 
 
 (defcustom org-publish-sitemap-sort-folders 'first
 (defcustom org-publish-sitemap-sort-folders 'first
   "A symbol, denoting if folders are sorted first in sitemaps.
   "A symbol, denoting if folders are sorted first in sitemaps.
@@ -261,6 +267,22 @@ You can overwrite this default per project in your
   :group 'org-publish
   :group 'org-publish
   :type 'boolean)
   :type 'boolean)
 
 
+(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
+  "Format for `format-time-string' which is used to print a date
+in the sitemap."
+  :group 'org-publish
+  :type 'string)
+
+(defcustom org-publish-sitemap-file-entry-format "%T"
+  "How a sitemap file entry is formated.
+You could use brackets to delimit on what part the link will be.
+
+%T is the title.
+%A is the author.
+%D is the date formated using `org-publish-sitemap-date-format'."
+  :group 'org-publish
+  :type 'string)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Timestamp-related functions
 ;;; Timestamp-related functions
 
 
@@ -360,30 +382,41 @@ This splices all the components into the list."
     (nreverse (org-publish-delete-dups (delq nil rtn)))))
     (nreverse (org-publish-delete-dups (delq nil rtn)))))
 
 
 
 
-(defvar sitemap-alphabetically)
+(defvar sitemap-sort-files)
 (defvar sitemap-sort-folders)
 (defvar sitemap-sort-folders)
 (defvar sitemap-ignore-case)
 (defvar sitemap-ignore-case)
 (defvar sitemap-requested)
 (defvar sitemap-requested)
+(defvar sitemap-date-format)
+(defvar sitemap-file-entry-format)
 (defun org-publish-compare-directory-files (a b)
 (defun org-publish-compare-directory-files (a b)
-  "Predicate for `sort', that sorts folders-first/last and alphabetically."
+  "Predicate for `sort', that sorts folders and files for sitemap."
   (let ((retval t))
   (let ((retval t))
-    (when (or sitemap-alphabetically sitemap-sort-folders)
-      ;; First we sort alphabetically:
-      (when sitemap-alphabetically
-        (let* ((adir (file-directory-p a))
-               (aorg (and (string-match "\\.org$" a) (not adir)))
-               (bdir (file-directory-p b))
-               (borg (and (string-match "\\.org$" b) (not bdir)))
-               (A (if aorg
-                      (concat (file-name-directory a)
-                              (org-publish-find-title a)) a))
-               (B (if borg
-                      (concat (file-name-directory b)
-                              (org-publish-find-title b)) b)))
-          (setq retval (if sitemap-ignore-case
-			   (not (string-lessp (upcase B) (upcase A)))
-			 (not (string-lessp B A))))))
-
+    (when (or sitemap-sort-files sitemap-sort-folders)
+      ;; First we sort files:
+      (when sitemap-sort-files
+	(cond ((equal sitemap-sort-files 'alphabetically)
+	       (let* ((adir (file-directory-p a))
+		      (aorg (and (string-match "\\.org$" a) (not adir)))
+		      (bdir (file-directory-p b))
+		      (borg (and (string-match "\\.org$" b) (not bdir)))
+		      (A (if aorg
+			     (concat (file-name-directory a)
+				     (org-publish-find-title a)) a))
+		      (B (if borg
+			     (concat (file-name-directory b)
+				     (org-publish-find-title b)) b)))
+		 (setq retval (if sitemap-ignore-case
+				  (not (string-lessp (upcase B) (upcase A)))
+				(not (string-lessp B A))))))
+		((or (equal sitemap-sort-files 'chronologically)
+		     (equal sitemap-sort-files 'anti-chronologically))
+		 (let* ((adate (org-publish-find-date a))
+			(bdate (org-publish-find-date b))
+			(A (+ (lsh (car adate) 16) (cadr adate)))
+			(B (+ (lsh (car bdate) 16) (cadr bdate))))
+		   (setq retval (if (equal sitemap-sort-files 'chronologically)
+				    (<= A B)
+				  (>= A B)))))))
       ;; Directory-wise wins:
       ;; Directory-wise wins:
       (when sitemap-sort-folders
       (when sitemap-sort-folders
         ;; a is directory, b not:
         ;; a is directory, b not:
@@ -441,10 +474,14 @@ matching filenames."
 	  (if (plist-member project-plist :sitemap-sort-folders)
 	  (if (plist-member project-plist :sitemap-sort-folders)
 	      (plist-get project-plist :sitemap-sort-folders)
 	      (plist-get project-plist :sitemap-sort-folders)
 	    org-publish-sitemap-sort-folders))
 	    org-publish-sitemap-sort-folders))
-	 (sitemap-alphabetically
-	  (if (plist-member project-plist :sitemap-alphabetically)
-	      (plist-get project-plist :sitemap-alphabetically)
-	    org-publish-sitemap-sort-alphabetically))
+	 (sitemap-sort-files
+	  (cond ((plist-member project-plist :sitemap-sort-files)
+		 (plist-get project-plist :sitemap-sort-files))
+		;; For backward compatibility:
+		((plist-member project-plist :sitemap-alphabetically)
+		 (if (plist-get project-plist :sitemap-alphabetically)
+		     'alphabetically nil))
+		(t org-publish-sitemap-sort-files)))
 	 (sitemap-ignore-case
 	 (sitemap-ignore-case
 	  (if (plist-member project-plist :sitemap-ignore-case)
 	  (if (plist-member project-plist :sitemap-ignore-case)
 	      (plist-get project-plist :sitemap-ignore-case)
 	      (plist-get project-plist :sitemap-ignore-case)
@@ -487,10 +524,10 @@ matching filenames."
 		 (e (plist-get (cdr prj) :exclude))
 		 (e (plist-get (cdr prj) :exclude))
 		 (i (plist-get (cdr prj) :include))
 		 (i (plist-get (cdr prj) :include))
 		 (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
 		 (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
-	    (when (or
+	    (when
+		(or
 		   (and 
 		   (and 
-		    i 
-		    (member filename 
+		  i (member filename
 			    (mapcar 
 			    (mapcar 
 			     (lambda (file) (expand-file-name file b))
 			     (lambda (file) (expand-file-name file b))
 			     i)))
 			     i)))
@@ -684,6 +721,10 @@ If :makeindex is set, also produce a file theindex.org."
 				"sitemap.org"))
 				"sitemap.org"))
 	  (sitemap-function (or (plist-get project-plist :sitemap-function)
 	  (sitemap-function (or (plist-get project-plist :sitemap-function)
 				'org-publish-org-sitemap))
 				'org-publish-org-sitemap))
+	  (sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
+				   org-publish-sitemap-date-format))
+	  (sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
+					 org-publish-sitemap-file-entry-format))
 	  (preparation-function (plist-get project-plist :preparation-function))
 	  (preparation-function (plist-get project-plist :preparation-function))
 	  (completion-function (plist-get project-plist :completion-function))
 	  (completion-function (plist-get project-plist :completion-function))
 	  (files (org-publish-get-base-files project exclude-regexp)) file)
 	  (files (org-publish-get-base-files project exclude-regexp)) file)
@@ -759,12 +800,32 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
 		      (setq indent-str (make-string
 		      (setq indent-str (make-string
 					(+ (length indent-str) 2) ?\ )))))))
 					(+ (length indent-str) 2) ?\ )))))))
 	    ;; This is common to 'flat and 'tree
 	    ;; This is common to 'flat and 'tree
-	    (insert (concat indent-str " + [[file:" link "]["
-			    (org-publish-find-title file)
-			    "]]\n")))))
+	    (let ((entry
+		   (org-publish-format-file-entry sitemap-file-entry-format 
+						  file project-plist))
+		  (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
+	      (cond ((string-match-p regexp entry)
+		     (string-match regexp entry)
+		     (insert (concat indent-str " + " (match-string 1 entry)
+				     "[[file:" link "]["
+				     (match-string 2 entry)
+				     "]]" (match-string 3 entry) "\n")))
+		    (t 
+		     (insert (concat indent-str " + [[file:" link "]["
+				     entry
+				     "]]\n"))))))))
       (save-buffer))
       (save-buffer))
     (or visiting (kill-buffer sitemap-buffer))))
     (or visiting (kill-buffer sitemap-buffer))))
 
 
+(defun org-publish-format-file-entry (fmt file project-plist)
+  (org-replace-escapes fmt
+		       (list (cons "%T" (org-publish-find-title file))
+			     (cons "%D" (format-time-string 
+					 sitemap-date-format 
+					 (org-publish-find-date file)))
+			     (cons "%A" (or (plist-get project-plist :author)
+					    user-full-name)))))
+			    
 (defun org-publish-find-title (file)
 (defun org-publish-find-title (file)
   "Find the title of FILE in project."
   "Find the title of FILE in project."
   (or
   (or
@@ -786,6 +847,24 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
     (org-publish-cache-set-file-property file :title title)
     (org-publish-cache-set-file-property file :title title)
     title)))
     title)))
 
 
+(defun org-publish-find-date (file)
+  "Find the date of FILE in project.
+If FILE provides a #+date keyword use it else use the file
+system's modification time.
+
+It returns time in `current-time' format."
+  (let ((visiting (find-buffer-visiting file)))
+    (save-excursion
+      (switch-to-buffer (or visiting (find-file file)))
+      (let* ((plist (org-infile-export-plist))
+	     (date (plist-get plist :date)))
+	(unless visiting
+	  (kill-buffer (current-buffer)))
+	(if date
+	    (org-time-string-to-time date)
+	  (when (file-exists-p file)
+	    (nth 5 (file-attributes file))))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Interactive publishing functions
 ;;; Interactive publishing functions