emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [patch] Sort the sitemap again
@ 2010-04-22  1:41 Sebastian Rose
  2010-04-22  8:25 ` Carsten Dominik
  0 siblings, 1 reply; 10+ messages in thread
From: Sebastian Rose @ 2010-04-22  1:41 UTC (permalink / raw)
  To: Emacs-orgmode mailing list

[-- Attachment #1: Type: text/plain, Size: 978 bytes --]

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.
I have to call it when sorting the files, to sort them by title instead
of file name.



Best wishes

  Sebastian





[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-diff, Size: 5984 bytes --]

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


[-- Attachment #3: Type: text/plain, Size: 201 bytes --]

_______________________________________________
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

^ permalink raw reply related	[flat|nested] 10+ messages in thread

end of thread, other threads:[~2010-04-22 22:07 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
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

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).