From mboxrd@z Thu Jan 1 00:00:00 1970 From: Carsten Dominik Subject: Re: Re: [patch] Sort the sitemap again Date: Thu, 22 Apr 2010 17:46:03 +0200 Message-ID: <33FA9502-97A4-4F34-BD35-7F41D8E2EDF1@gmail.com> References: <87wrw02ric.fsf@gmx.de> <43C32696-E65A-4337-A75C-3ECE447CE51F@gmail.com> <87fx2n21z7.fsf@gmx.de> <87zl0vzj08.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 1O4zVa-000751-Fp for emacs-orgmode@gnu.org; Thu, 22 Apr 2010 12:44:10 -0400 Received: from [140.186.70.92] (port=36470 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1O4zVY-00071f-6g for emacs-orgmode@gnu.org; Thu, 22 Apr 2010 12:44:10 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1O4zVW-0003MG-Fr for emacs-orgmode@gnu.org; Thu, 22 Apr 2010 12:44:08 -0400 Received: from mail-pw0-f41.google.com ([209.85.160.41]:34457) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1O4zVW-0003Ln-4F for emacs-orgmode@gnu.org; Thu, 22 Apr 2010 12:44:06 -0400 Received: by pwi10 with SMTP id 10so230152pwi.0 for ; Thu, 22 Apr 2010 09:44:05 -0700 (PDT) In-Reply-To: <87zl0vzj08.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 Hi Sebastian, I have applied your patch, thanks. - Carsten On Apr 22, 2010, at 3:58 PM, Sebastian Rose wrote: > Hi Carsten, > > > here is a neccessary improvement for the sitemap-sorting. > > This is diffed against the current master, thus the last patch is > included here, too. > > Some files still do not want to sort correctly, if we turn off > folder-sorting :-P Hmm - I am not sure if I understand? Another fix needed, or your patch does now fix it? Sorry for being slow today... - Carsten > > > > diff --git a/lisp/org-publish.el b/lisp/org-publish.el > index 496f4d1..866133d 100644 > --- a/lisp/org-publish.el > +++ b/lisp/org-publish.el > @@ -384,23 +384,32 @@ eventually alphabetically." > (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))))) > + (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 (org-publish-find-title a) a)) > + (B (if borg (org-publish-find-title b) b))) > + ;; If we have a directory and an Org file, we need to > combine > + ;; directory and title as filename of the Org file: > + (when (and adir borg) > + (setq B (concat (file-name-directory b) B))) > + (when (and bdir aorg) > + (setq A (concat (file-name-directory a) A))) > + ;; > (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)))))) > + (string-lessp (upcase A) (upcase B)) > + (string-lessp A 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 (eq sitemap-sort-folders 'first))) > + (setq retval (equal sitemap-sort-folders 'first))) > ;; a is not a directory, but b is: > ((and (not (file-directory-p a)) (file-directory-p b)) > - (setq retval (eq sitemap-sort-folders 'last)))))) > + (setq retval (equal sitemap-sort-folders 'last)))))) > retval)) > > (defun org-publish-get-base-files-1 (base-dir &optional recurse > match skip-file skip-dir) > @@ -618,9 +627,9 @@ If :makeindex is set, also produce a file > theindex.org." > (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"))) > + (when (and (not (null sitemap-sort-folders)) > + (not (equal sitemap-sort-folders 'first)) > + (not (equal 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)) > > > > Sebastian > > > > > > > Sebastian Rose writes: >> Carsten Dominik writes: >>> 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 >> >> >> We'll have to use `equal' then, not `eq': >> >> >> >> diff --git a/lisp/org-publish.el b/lisp/org-publish.el >> index 496f4d1..34589db 100644 >> --- a/lisp/org-publish.el >> +++ b/lisp/org-publish.el >> @@ -397,10 +397,10 @@ eventually alphabetically." >> ;; a is directory, b not: >> (cond >> ((and (file-directory-p a) (not (file-directory-p b))) >> - (setq retval (eq sitemap-sort-folders 'first))) >> + (setq retval (equal sitemap-sort-folders 'first))) >> ;; a is not a directory, but b is: >> ((and (not (file-directory-p a)) (file-directory-p b)) >> - (setq retval (eq sitemap-sort-folders 'last)))))) >> + (setq retval (equal sitemap-sort-folders 'last)))))) >> retval)) >> >> (defun org-publish-get-base-files-1 (base-dir &optional recurse >> match skip-file skip-dir) >> @@ -609,7 +609,7 @@ If :makeindex is set, also produce a file >> theindex.org." >> 'org-publish-org-sitemap)) >> (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) >> 'first)) >> (sitemap-alphabetically >> (if (plist-member project-plist :sitemap-alphabetically) >> @@ -618,9 +618,9 @@ If :makeindex is set, also produce a file >> theindex.org." >> (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"))) >> + (when (and (not (null sitemap-sort-folders)) >> + (not (equal sitemap-sort-folders 'first)) >> + (not (equal 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)) >> >> >> >>> - Minor changes to the docstring >>> - Adding documentation to the manual >> >> Thanks! >> >>> Please check that I have not broken anything. >> >> Please apply the patch above - then it works again :) >> Haarghh ... symbols... >> >> >> >> Sebastian >> >> >>> >>> 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 >>> >>> > > -- > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > Sebastian Rose Fachinformatiker / Anwendungsentwicklung > Viktoriastr. 22 Entwicklung von Anwendungen mit freien Werkzeugen > 30451 Hannover und Bibliotheken. > > 0173 83 93 417 sebastian_rose@gmx.de s.rose@emma-stil.de > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Carsten