diff --git a/doc/org.texi b/doc/org.texi index b406d2910..bbbf804ae 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -6880,7 +6880,7 @@ the easiest way to maintain it is through the following commands @cindex files, adding to agenda list @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 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. @@ -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 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 1973-06-22 +06-22 1955-08-02 wedding 2008-04-14 %s released version 6.01 of org-mode, %d years ago @end example @@ -7451,12 +7452,14 @@ will still be searched for stuck projects. @cindex presentation, of agenda items @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. @menu @@ -8685,8 +8688,8 @@ syntax; it is exported verbatim. @node Horizontal rules, Comment lines, Emphasis and monospace, Structural markup elements @subheading Horizontal 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{
} in HTML). +A line consisting of only dashes, and at least 5 of them, will be exported as +a horizontal line (@samp{
} in HTML and @code{\hrule} in @LaTeX{}). @node Comment lines, , Horizontal rules, Structural markup elements @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, 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} @tab Should sorting be case-sensitive? Default @code{nil}. diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 96155a117..c99defc78 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -222,7 +222,7 @@ options are taken from `org-babel-default-header-args'." (car (last lob-info))) 'lob)))) (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) "Return a string with the exported content of a code block. diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 9e640c51f..2c81184b5 100644 --- a/lisp/org-agenda.el +++ b/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) ;; Remember where this call originated (setq org-agenda-last-dispatch-buffer (current-buffer)) + (kill-local-variable 'org-agenda-current-span) (unless keys (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) keys (car ans) @@ -3609,7 +3610,7 @@ given in `org-agenda-start-on-weekday'." (when (and org-agenda-clockreport-mode clocktable-start) (let ((org-agenda-files (org-agenda-files nil 'ifmode)) ;; the above line is to ensure the restricted range! - (p org-agenda-clockreport-parameter-plist) + (p (copy-sequence org-agenda-clockreport-parameter-plist)) tbl) (setq p (org-plist-delete p :block)) (setq p (plist-put p :tstart clocktable-start)) @@ -3623,7 +3624,6 @@ given in `org-agenda-start-on-weekday'." "" x)) filter "")))) - (message "%s" (plist-get p :tags)) (sit-for 2) (setq tbl (apply 'org-get-clocktable p)) (insert tbl))) (goto-char (point-min)) @@ -4489,7 +4489,8 @@ the documentation of `org-diary'." (while (setq arg (pop args)) (cond ((and (eq arg :todo) - (equal date (calendar-current-date))) + (equal date (calendar-gregorian-from-absolute + (org-today)))) (setq rtn (org-agenda-get-todos)) (setq results (append results rtn))) ((eq arg :timestamp) @@ -5921,7 +5922,7 @@ to switch to narrowing." (effort-prompt "") (inhibit-read-only t) (current org-agenda-filter) - a n tag) + maybe-reftresh a n tag) (unless char (message "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>== char ?0) (<= char ?9) @@ -5987,8 +5990,12 @@ to switch to narrowing." (setq org-agenda-filter (cons (concat (if strip "-" "+") tag) (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 () "Get a list of all tags currently represented in the agenda." diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el index 4155f58b5..c04b7ffae 100644 --- a/lisp/org-bbdb.el +++ b/lisp/org-bbdb.el @@ -136,12 +136,12 @@ '(("birthday" lambda (name years suffix) (concat "Birthday: [[bbdb:" name "][" name " (" - (number-to-string years) + (format "%s" years) ; handles numbers as well as strings suffix ")]]")) ("wedding" lambda (name years suffix) (concat "[[bbdb:" name "][" name "'s " - (number-to-string years) + (format "%s" years) suffix " wedding anniversary]]"))) "How different types of anniversaries should be formatted. 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) "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) "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)) ; (as format string) (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 ((functionp form) (funcall form name years suffix)) diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index 7c28d7031..291c540f1 100644 --- a/lisp/org-crypt.el +++ b/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) (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 () "Encrypt the content of the current headline." (interactive) @@ -122,10 +131,7 @@ This setting can also be overridden in the CRYPTKEY property." (org-back-over-empty-lines) (setq end (point) 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) (insert encrypted-text) (when folded @@ -152,16 +158,24 @@ This setting can also be overridden in the CRYPTKEY property." (forward-line) (point))) (epg-context (epg-make-context nil t t)) + (encrypted-text (buffer-substring-no-properties (point) end)) (decrypted-text (decode-coding-string (epg-decrypt-string epg-context - (buffer-substring-no-properties (point) end)) + encrypted-text) 'utf-8))) ;; Delete region starting just before point, because the ;; outline property starts at the \n of the heading. (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 (goto-char heading-point) (org-flag-subtree t)) diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el index 8014f8f1f..702b3a937 100644 --- a/lisp/org-datetree.el +++ b/lisp/org-datetree.el @@ -64,7 +64,7 @@ tree can be found." (goto-char (prog1 (point) (widen)))))) (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) (goto-char (point-min)) (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) (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) (goto-char (point-min)) (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) (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) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 96aded35e..c38436a56 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -388,7 +388,7 @@ Good for general initialization") "Hook for preprocessing an export buffer. Pretty much the first thing when exporting is running this hook. 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 also work in that temporary buffer, already modified by various stages of the processing.") @@ -963,6 +963,7 @@ value of `org-export-run-in-background'." (setq r1 (read-char-exclusive))) (error "No enclosing node with LaTeX_CLASS or EXPORT_FILE_NAME") ))))) + (redisplay) (and bpos (goto-char bpos)) (setq r2 (if (< r1 27) (+ r1 96) r1)) (unless (setq ass (assq r2 cmds)) diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el index e543f0eed..c342b402d 100644 --- a/lisp/org-gnus.el +++ b/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 group newsgroups message-id x-no-archive)) (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) "Follow the nntp: link specified by PATH." diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 9290c3593..7b80b9802 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2270,7 +2270,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; Convert horizontal rules (goto-char (point-min)) - (while (re-search-forward "^----+.$" nil t) + (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t) (org-if-unprotected (replace-match (org-export-latex-protect-string "\\hrule") t t))) diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el index c384062a3..c9b04811a 100644 --- a/lisp/org-mhe.el +++ b/lisp/org-mhe.el @@ -83,27 +83,28 @@ supported by MH-E." "Store a link to an MH-E folder or message." (when (or (equal major-mode 'mh-folder-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) "Follow an MH-E message link specified by PATH." diff --git a/lisp/org-publish.el b/lisp/org-publish.el index c3f337068..98e09f3e0 100644 --- a/lisp/org-publish.el +++ b/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 display folders first or last, respectively. 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. 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 :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 -`org-publish-project-alist', using `:sitemap-alphabetically'." +`org-publish-project-alist', using `:sitemap-sort-files'." :group 'org-publish - :type 'boolean) + :type 'symbol) (defcustom org-publish-sitemap-sort-folders 'first "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 :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 @@ -360,30 +382,41 @@ This splices all the components into the list." (nreverse (org-publish-delete-dups (delq nil rtn))))) -(defvar sitemap-alphabetically) +(defvar sitemap-sort-files) (defvar sitemap-sort-folders) (defvar sitemap-ignore-case) (defvar sitemap-requested) +(defvar sitemap-date-format) +(defvar sitemap-file-entry-format) (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)) - (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: (when sitemap-sort-folders ;; a is directory, b not: @@ -441,10 +474,14 @@ matching filenames." (if (plist-member project-plist :sitemap-sort-folders) (plist-get project-plist :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 (if (plist-member project-plist :sitemap-ignore-case) (plist-get project-plist :sitemap-ignore-case) @@ -487,10 +524,10 @@ matching filenames." (e (plist-get (cdr prj) :exclude)) (i (plist-get (cdr prj) :include)) (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) - (when (or + (when + (or (and - i - (member filename + i (member filename (mapcar (lambda (file) (expand-file-name file b)) i))) @@ -684,6 +721,10 @@ If :makeindex is set, also produce a file theindex.org." "sitemap.org")) (sitemap-function (or (plist-get project-plist :sitemap-function) '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)) (completion-function (plist-get project-plist :completion-function)) (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 (+ (length indent-str) 2) ?\ ))))))) ;; 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)) (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) "Find the title of FILE in project." (or @@ -786,6 +847,24 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (org-publish-cache-set-file-property file :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