On Apr 22, 2010, at 11:01 PM, Sebastian Rose wrote:
Carsten Dominik <carsten.domi...@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 :-PHmm - 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- Carstendiff --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 matchskip-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 andfolders.:sitemap-alphabetically Set to `t' to sort filenames alphabetically. Alphatical sorting is the default. Hence youmust 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 absolutepaths 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 insteadof 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 stringsWe'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 matchskip-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 manualThanks!Please check that I have not broken anything.Please apply the patch above - then it works again :) Haarghh ... symbols... SebastianThanks, this is really a useful addition. - CarstenBest 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 matchskip-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 throughBASE-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 / AnwendungsentwicklungViktoriastr. 22 Entwicklung von Anwendungen mit freien Werkzeugen30451 Hannover und Bibliotheken. 0173 83 93 417 sebastian_r...@gmx.de s.r...@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_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
