From: Carsten Dominik <carsten.dominik@gmail.com>
To: Sebastian Rose <sebastian_rose@gmx.de>
Cc: Emacs-orgmode mailing list <emacs-orgmode@gnu.org>
Subject: Re: Re: [patch] Sort the sitemap again
Date: Fri, 23 Apr 2010 00:07:00 +0200 [thread overview]
Message-ID: <67F0E53A-E246-46E9-9CD9-1C526F36B708@gmail.com> (raw)
In-Reply-To: <87bpdb6w2o.fsf@gmx.de>
On Apr 22, 2010, at 11:01 PM, Sebastian Rose wrote:
> Carsten Dominik <carsten.dominik@gmail.com> 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 :-/
:-) I have applied the patch....
- Carsten
>
>
>
> 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 <sebastian_rose@gmx.de> writes:
>>>> Carsten Dominik <carsten.dominik@gmail.com> 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
>>
>>
>>
>
> --
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> 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
prev parent reply other threads:[~2010-04-22 22:07 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2010-04-22 1:41 [patch] Sort the sitemap again Sebastian Rose
2010-04-22 8:25 ` Carsten Dominik
2010-04-22 10:52 ` Sebastian Rose
2010-04-22 12:56 ` Nick Dokos
2010-04-22 15:20 ` Sebastian Rose
2010-04-22 13:16 ` Carsten Dominik
2010-04-22 13:58 ` Sebastian Rose
2010-04-22 15:46 ` Carsten Dominik
2010-04-22 21:01 ` Sebastian Rose
2010-04-22 22:07 ` Carsten Dominik [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=67F0E53A-E246-46E9-9CD9-1C526F36B708@gmail.com \
--to=carsten.dominik@gmail.com \
--cc=emacs-orgmode@gnu.org \
--cc=sebastian_rose@gmx.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).