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: Thu, 22 Apr 2010 17:46:03 +0200 [thread overview]
Message-ID: <33FA9502-97A4-4F34-BD35-7F41D8E2EDF1@gmail.com> (raw)
In-Reply-To: <87zl0vzj08.fsf@gmx.de>
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 <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
next prev parent reply other threads:[~2010-04-22 16:44 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 [this message]
2010-04-22 21:01 ` Sebastian Rose
2010-04-22 22:07 ` Carsten Dominik
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=33FA9502-97A4-4F34-BD35-7F41D8E2EDF1@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).