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

[Sebastian Rose]

Carsten Dominik <address@hidden> writes:
> 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...


I'm bad in explaining... There was still a problem with alphabetical
sorting I didn't fix. But it didn't show up with any combination of
files (it had with thorough debugging...).

But anyway, here's the final patch, that fixes it. Sorry, I'll try to
send just _one_ patch the next time :-/



diff --git a/lisp/org-publish.el b/lisp/org-publish.el
index b93c92f..ac22603 100644
--- a/lisp/org-publish.el
+++ b/lisp/org-publish.el
@@ -388,18 +388,15 @@ eventually alphabetically."
                (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)))
-          ;;
+               (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
-                          (string-lessp (upcase A) (upcase B))
-                        (string-lessp A B)))))
+                          (not (string-lessp (upcase B) (upcase A)))
+                        (not (string-lessp B A))))))
 
       ;; Directory-wise wins:
       (when sitemap-sort-folders



As always with things I write, it's a good sign if the number of lines
decreases :)


   Sebastian



> - 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 <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
>> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
>
> - 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
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~