[Orgmode] Re: [patch] Sort the sitemap again

[Sebastian Rose]

Carsten Dominik <address@hidden> 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      address@hidden         address@hidden
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~