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

[Sebastian Rose]

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



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 <address@hidden> writes:
> 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
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~