From mboxrd@z Thu Jan 1 00:00:00 1970 From: Manuel Giraud Subject: [Patch 1/2] org-publish Date: Wed, 01 Dec 2010 11:06:16 +0100 Message-ID: <87mxop7qp3.fsf@univ-nantes.fr> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from [140.186.70.92] (port=33727 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PNjZu-0002Nq-Pg for emacs-orgmode@gnu.org; Wed, 01 Dec 2010 05:06:24 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PNjZt-0001YC-3a for emacs-orgmode@gnu.org; Wed, 01 Dec 2010 05:06:22 -0500 Received: from smtp-tls2.univ-nantes.fr ([193.52.101.146]:53273 helo=smtp-tls.univ-nantes.fr) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PNjZs-0001Xk-QI for emacs-orgmode@gnu.org; Wed, 01 Dec 2010 05:06:21 -0500 Received: from localhost (debian [127.0.0.1]) by smtp-tls.univ-nantes.fr (Postfix) with ESMTP id F3006400644 for ; Wed, 1 Dec 2010 11:09:14 +0100 (CET) Received: from smtp-tls.univ-nantes.fr ([127.0.0.1]) by localhost (smtp-tls2.d101.univ-nantes.fr [127.0.0.1]) (amavisd-new, port 10024) with LMTP id o1io64JZ0ti6 for ; Wed, 1 Dec 2010 11:09:14 +0100 (CET) Received: from K (unknown [172.16.13.134]) (using TLSv1 with cipher DHE-RSA-AES128-SHA (128/128 bits)) (No client certificate requested) by smtp-tls.univ-nantes.fr (Postfix) with ESMTPSA id CB91D400631 for ; Wed, 1 Dec 2010 11:09:14 +0100 (CET) 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 --=-=-= Hi, This first patch adds sort options to the sitemap. In addition to alphabetical order, one can choose chronological or anti-chronological ordering of sitemap entries. To retrieve file date, it tries to parse the "#+date" keyword and if not present defaults to file modification time. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=sitemap-chrono.patch diff --git a/doc/org.texi b/doc/org.texi index 4e8eb63..c283503 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -10859,9 +10859,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/org-publish.el b/lisp/org-publish.el index c66cd29..edc0b5c 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. @@ -360,30 +366,37 @@ 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) (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 ((A (org-publish-find-date a)) + (B (org-publish-find-date b))) + (setq retval (if (equal sitemap-sort-files 'chronologically) + (<= A B) + (>= A B))))))) ;; Directory-wise wins: (when sitemap-sort-folders ;; a is directory, b not: @@ -438,10 +451,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) @@ -481,10 +498,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))) @@ -780,6 +797,23 @@ 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." + (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 + (let ((dt (org-time-string-to-time date))) + (+ (lsh (car dt) 16) (cadr dt))) + (when (file-exists-p file) + (org-publish-cache-ctime-of-src file))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Interactive publishing functions --=-=-= -- Manuel Giraud --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Emacs-orgmode mailing list Please use `Reply All' to send replies to the list. Emacs-orgmode@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-orgmode --=-=-=--