From mboxrd@z Thu Jan 1 00:00:00 1970 From: Carsten Dominik Subject: Re: [patch] Sort the sitemap again Date: Thu, 22 Apr 2010 10:25:24 +0200 Message-ID: <43C32696-E65A-4337-A75C-3ECE447CE51F@gmail.com> References: <87wrw02ric.fsf@gmx.de> Mime-Version: 1.0 (Apple Message framework v936) Content-Type: text/plain; charset=US-ASCII; format=flowed; delsp=yes Content-Transfer-Encoding: 7bit Return-path: Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1O4rj8-00048P-AO for emacs-orgmode@gnu.org; Thu, 22 Apr 2010 04:25:38 -0400 Received: from [140.186.70.92] (port=60466 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1O4rj2-000482-Dt for emacs-orgmode@gnu.org; Thu, 22 Apr 2010 04:25:36 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1O4riz-0002DQ-9T for emacs-orgmode@gnu.org; Thu, 22 Apr 2010 04:25:32 -0400 Received: from mail-wy0-f169.google.com ([74.125.82.169]:59554) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1O4rix-0002D6-51 for emacs-orgmode@gnu.org; Thu, 22 Apr 2010 04:25:29 -0400 Received: by wyg36 with SMTP id 36so1348757wyg.0 for ; Thu, 22 Apr 2010 01:25:26 -0700 (PDT) In-Reply-To: <87wrw02ric.fsf@gmx.de> 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: Sebastian Rose Cc: Emacs-orgmode mailing list On Apr 22, 2010, at 3:41 AM, Sebastian Rose wrote: > Hi Carsten, > > > here is a patch, that sorts the sitemap-file on html-export. > > > One my configure the sorting per project, by adding these lines to his > `org-publish-project-alist': > > :sitemap-sort-folders Set this to one of "first" (default), > "last". Any other value will mixe files and > folders. > :sitemap-alphabetically Set to `t' to sort filenames alphabetically. > Alphatical sorting is the default. Hence you > must set this to nil explicitly. > :sitemap-ignore-case If non-nil, alphabetical sorting is done > case-insensitive. Default: nil." > > > I added a variable `org-publish-file-title-cache' to cache absolute > paths and titles of the files. Otherwise, `org-publish-find-title' > would > be called twice for each file. Great idea. This would be a lot of overhead. > I have to call it when sorting the files, to sort them by title > instead > of file name. Yes. I have applied the patch, with minor changes: - Some code formatting to stay below 80 characters width - Replacing '() with nil - Using symbols `first' and `last' instead of strings - Minor changes to the docstring - Adding documentation to the manual Please check that I have not broken anything. Thanks, this is really a useful addition. - Carsten > > > > Best wishes > > Sebastian > > > > > diff --git a/lisp/org-publish.el b/lisp/org-publish.el > index 6ef1e24..a455997 100644 > --- a/lisp/org-publish.el > +++ b/lisp/org-publish.el > @@ -174,7 +174,17 @@ sitemap of files or summary page for a given > project. > of the titles of the files involved) or > `tree' (the directory structure of the source > files is reflected in the sitemap). > Defaults to > - `tree'." > + `tree'. > + > + If you create a sitemap file, adjust the sorting like this: > + > + :sitemap-sort-folders Set this to one of \"first\" (default), > \"last\". > + Any other value will mixe files and > folders. > + :sitemap-alphabetically Set to `t' to sort filenames > alphabetically. > + Alphatical sorting is the default. Hence > you > + must set this to nil explecitly. > + :sitemap-ignore-case If non-nil, alphabetical sorting is done > + case-insensitive. Default: nil." > :group 'org-publish > :type 'alist) > > @@ -287,11 +297,16 @@ Each element of this alist is of the form: > (defvar org-publish-temp-files nil > "Temporary list of files to be published.") > > +;; Here, so you find the variable right before it's used the first > time: > +(defvar org-publish-file-title-cache nil > + "List of absolute filenames and titles.") > + > (defun org-publish-initialize-files-alist (&optional refresh) > "Set `org-publish-files-alist' if it is not set. > Also set it if the optional argument REFRESH is non-nil." > (interactive "P") > (when (or refresh (not org-publish-files-alist)) > + (setq org-publish-file-title-cache '()) > (setq org-publish-files-alist > (org-publish-get-files org-publish-project-alist)))) > > @@ -355,6 +370,32 @@ This splices all the components into the list." > (push p rtn))) > (nreverse (org-publish-delete-dups (delq nil rtn))))) > > +(defun org-publish-sort-directory-files (a b) > + "Predicate for `sort', that sorts folders-first/last and > +eventually alphabetically." > + (let ((retval t)) > + (when (or sitemap-alphabetically sitemap-sort-folders) > + ;; First we sort alphabetically: > + (when sitemap-alphabetically > + (let ((aorg (and (string-match "\\.org$" a) (not (file- > directory-p a)))) > + (borg (and (string-match "\\.org$" b) (not (file- > directory-p b))))) > + (setq retval > + (if sitemap-ignore-case > + (string-lessp (if borg (upcase (org-publish- > find-title a)) (upcase a)) > + (if aorg (upcase (org-publish- > find-title b)) (upcase b))) > + (string-lessp (if borg (org-publish-find-title a) > a) > + (if aorg (org-publish-find-title b) > b)))))) > + ;; Directory-wise wins: > + (when sitemap-sort-folders > + ;; a is directory, b not: > + (cond > + ((and (file-directory-p a) (not (file-directory-p b))) > + (setq retval (string= sitemap-sort-folders "first"))) > + ;; a is not a directory, but b is: > + ((and (not (file-directory-p a)) (file-directory-p b)) > + (setq retval (string= sitemap-sort-folders "last")))))) > + retval)) > + > (defun org-publish-get-base-files-1 (base-dir &optional recurse > match skip-file skip-dir) > "Set `org-publish-temp-files' with files from BASE-DIR directory. > If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is > @@ -374,7 +415,7 @@ matching the regexp SKIP-DIR when recursing > through BASE-DIR." > (not (file-exists-p (file-truename f))) > (not (string-match match fnd))) > (pushnew f org-publish-temp-files))))) > - (directory-files base-dir t (unless recurse match)))) > + (sort (directory-files base-dir t (unless recurse match)) 'org- > publish-sort-directory-files))) > > (defun org-publish-get-base-files (project &optional exclude-regexp) > "Return a list of all files in PROJECT. > @@ -558,9 +599,18 @@ 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-sort-folders (if (plist-member project- > plist :sitemap-sort-folders) > + (plist-get project-plist :sitemap- > sort-folders) "first")) > + (sitemap-alphabetically (if (plist-member project- > plist :sitemap-alphabetically) > + (plist-get project-plist :sitemap- > alphabetically) t)) > + (sitemap-ignore-case (plist-get project-plist :sitemap-ignore- > case)) > (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) > + (when (and (not (stringp sitemap-sort-folders)) > + (not (string= sitemap-sort-folders "first")) > + (not (string= sitemap-sort-folders "last"))) > + (setq sitemap-sort-folders nil)) > (when preparation-function (run-hooks 'preparation-function)) > (if sitemap-p (funcall sitemap-function project sitemap- > filename)) > (while (setq file (pop files)) > @@ -640,6 +690,8 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." > > (defun org-publish-find-title (file) > "Find the title of file in project." > + (if (member file org-publish-file-title-cache) > + (cadr (member file org-publish-file-title-cache)) > (let* ((visiting (find-buffer-visiting file)) > (buffer (or visiting (find-file-noselect file))) > title) > @@ -654,7 +706,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." > (file-name-nondirectory (file-name-sans-extension file)))))) > (unless visiting > (kill-buffer buffer)) > - title)) > + (setq org-publish-file-title-cache > + (append org-publish-file-title-cache (list file title))) > + title))) > > ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; > ;;; Interactive publishing functions > - Carsten