|
From: | Carsten Dominik |
Subject: | Re: [Orgmode] Re: [patch] Sort the sitemap again |
Date: | Thu, 22 Apr 2010 17:46:03 +0200 |
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 <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 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' wouldbe 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 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 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 / Anwendungsentwicklung Viktoriastr. 22 Entwicklung von Anwendungen mit freien Werkzeugen 30451 Hannover und Bibliotheken. 0173 83 93 417 address@hidden address@hidden ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- Carsten
[Prev in Thread] | Current Thread | [Next in Thread] |