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_r...@gmx.de> writes:
Carsten Dominik <carsten.domi...@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_r...@gmx.de s.r...@emma-stil.de
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- Carsten
_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
