From mboxrd@z Thu Jan 1 00:00:00 1970 From: Bastien Guerry Subject: [Accepted] [Orgmode,2/2] org-publish Date: Wed, 9 Feb 2011 17:13:23 +0100 (CET) Message-ID: <20110209161323.E7AEB80FF@myhost.localdomain> References: <87bp2lcs6d.fsf@univ-nantes.fr> Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit Return-path: Received: from [140.186.70.92] (port=45309 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PnCfS-0004zs-Qx for emacs-orgmode@gnu.org; Wed, 09 Feb 2011 11:13:25 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PnCfP-0000zW-Pg for emacs-orgmode@gnu.org; Wed, 09 Feb 2011 11:13:21 -0500 Received: from mail-ww0-f49.google.com ([74.125.82.49]:65221) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PnCfP-0000zE-FP for emacs-orgmode@gnu.org; Wed, 09 Feb 2011 11:13:19 -0500 Received: by wwb17 with SMTP id 17so329220wwb.30 for ; Wed, 09 Feb 2011 08:13:18 -0800 (PST) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org Patch 590 (http://patchwork.newartisans.com/patch/590/) is now "Accepted". Maintainer comment: none This relates to the following submission: http://mid.gmane.org/%3C87bp2lcs6d.fsf%40univ-nantes.fr%3E Here is the original message containing the patch: > Content-Type: text/plain; charset="utf-8" > MIME-Version: 1.0 > Content-Transfer-Encoding: 7bit > Subject: [Orgmode,2/2] org-publish > Date: Wed, 09 Feb 2011 17:23:54 -0000 > From: Manuel Giraud > X-Patchwork-Id: 590 > Message-Id: <87bp2lcs6d.fsf@univ-nantes.fr> > To: Bastien > Cc: emacs-orgmode > > Bastien writes: > > > I'd welcome a reworked version of this idea! > > Hi Bastien, > > Thanks for accepting my previous patch. Here's a new version of this last > patch that support formated sitemap entry. > > --8<---------------cut here---------------start------------->8--- > commit 660ece15eca316075da6529560bf66565934b713 > Author: Manuel Giraud > Date: Tue Nov 23 16:20:15 2010 +0100 > > formated sitemap > > Modified lisp/org-publish.el > --8<---------------cut here---------------end--------------->8--- > > Best regards, > > > diff --git a/lisp/org-publish.el b/lisp/org-publish.el > index 47b80db..98e09f3 100644 > --- a/lisp/org-publish.el > +++ b/lisp/org-publish.el > @@ -267,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 > > @@ -370,6 +386,8 @@ This splices all the components into the list." > (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 and files for sitemap." > (let ((retval t)) > @@ -392,8 +410,10 @@ This splices all the components into the list." > (not (string-lessp B A)))))) > ((or (equal sitemap-sort-files 'chronologically) > (equal sitemap-sort-files 'anti-chronologically)) > - (let ((A (org-publish-find-date a)) > - (B (org-publish-find-date b))) > + (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))))))) > @@ -701,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) > @@ -776,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 > @@ -806,7 +850,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." > (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." > +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))) > @@ -815,10 +861,9 @@ system's modification time." > (unless visiting > (kill-buffer (current-buffer))) > (if date > - (let ((dt (org-time-string-to-time date))) > - (+ (lsh (car dt) 16) (cadr dt))) > + (org-time-string-to-time date) > (when (file-exists-p file) > - (org-publish-cache-ctime-of-src file))))))) > + (nth 5 (file-attributes file)))))))) > > ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; > ;;; Interactive publishing functions >