emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [ox-publish, patch] More flexible sitemaps
@ 2016-05-19 15:39 Rasmus
  2016-05-22 22:58 ` Nicolas Goaziou
  0 siblings, 1 reply; 8+ messages in thread
From: Rasmus @ 2016-05-19 15:39 UTC (permalink / raw)
  To: emacs-orgmode

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

Hi,

I've long wanted to use ox to auto-generate something that looks like a
blog index.

This patch makes ox sitemaps a bit more flexible.  For instance, it would
allow me to use something like this for ‘:sitemap-file-entry-format’,

    :sitemap-file-entry-format "* [[file:%l][%t]]
    #+include: \"%f::lead\"

    [[file:%l][Read more]]"

Which would come out as;

    * [[file:link][Title]]
    #+Include: "file.org::lead"

    [[File:link][Read more]]

For the tests I did, it matches the "old" sitemap for list and tree.

WDYT?

I would particularly like feedback on simplification for the ordering of
the tree’ed filenames.

Rasmus

-- 
This space is left intentionally blank

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-ox-publish-More-flexible-sitemaps.patch --]
[-- Type: text/x-diff, Size: 18582 bytes --]

From e6b35524ba0959b6ca4057555325ec7d755248da Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Sun, 27 Mar 2016 17:33:06 +0200
Subject: [PATCH 1/2] ox-publish: More flexible sitemaps

* lisp/ox-publish.el (org-publish-sitemap-file-entry-format): Support
  more formatters.
(org-publish-sitemap-dir-entry-format): New defcustom.
(org-publish-org-sitemap): Use new variables and functions.
(org-publish-org-sitemap-as-list): New function.
(org-publish--tree-assoc): New function.
(org-pubish--order-files-by-dir-tree): New function.
(org-publish-find-title): New function.
(org-publish-find-subtitle): New function.
(org-publish-org-sitemap-as-tree): New function.
(org-publish--find-property): Find arbirary property.
(org-publish-project-alist): Document changes.
* doc/org.texi (Sitemap): Update documentation.
---
 doc/org.texi       |  20 ++--
 lisp/ox-publish.el | 319 ++++++++++++++++++++++++++++++++++++++---------------
 2 files changed, 241 insertions(+), 98 deletions(-)

diff --git a/doc/org.texi b/doc/org.texi
index 025baaa..b3517c0 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -14570,8 +14570,9 @@ becomes @file{sitemap.html}).
 
 @item @code{:sitemap-function}
 @tab Plug-in function to use for generation of the sitemap.
-Defaults to @code{org-publish-org-sitemap}, which generates a plain list
-of links to all files in the project.
+Defaults to @code{org-publish-org-sitemap}, which generates a plain list of
+links to all files in the project.  See further details in
+@code{org-publish-project-alist}.
 
 @item @code{:sitemap-sort-folders}
 @tab Where folders should appear in the sitemap.  Set this to @code{first}
@@ -14590,12 +14591,9 @@ a file is retrieved with @code{org-publish-find-date}.
 @tab Should sorting be case-sensitive?  Default @code{nil}.
 
 @item @code{:sitemap-file-entry-format}
-@tab With this option one can tell how a sitemap's entry is formatted in the
-sitemap.  This is a format string with some escape sequences: @code{%t} stands
-for the title of the file, @code{%a} stands for the author of the file and
-@code{%d} stands for the date of the file.  The date is retrieved with the
-@code{org-publish-find-date} function and formatted with
-@code{org-publish-sitemap-date-format}.  Default @code{%t}.
+@item @code{:sitemap-dir-entry-format}
+@tab With this option one can tell how the entries of the sitemap is
+formatted.  See @code{org-publish-sitemap-file-entry-format} for details.
 
 @item @code{:sitemap-date-format}
 @tab Format string for the @code{format-time-string} function that tells how
@@ -14607,6 +14605,12 @@ a sitemap entry's date is to be formatted.  This property bypasses
 Useful to have cool URIs (see @uref{http://www.w3.org/Provider/Style/URI}).
 Defaults to @code{nil}.
 
+@item @code{:sitemap-preamble}
+@item @code{:sitemap-postamble}
+@tab Preamble and postamble for sitemap.  Useful for inserting
+    @code{#+OPTIONS}, footers etc.  See @code{org-publish-sitemap-preamble}
+    for details.
+
 @end multitable
 
 @node Generating an index
diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el
index 8ccba99..b791e9a 100644
--- a/lisp/ox-publish.el
+++ b/lisp/ox-publish.el
@@ -41,6 +41,8 @@
 (require 'cl-lib)
 (require 'format-spec)
 (require 'ox)
+(autoload 'message-flatten-list "message")
+(autoload 'dired-tree-lessp "dired-aux")
 
 
 \f
@@ -217,10 +219,15 @@ a site-map of files or summary page for a given project.
 
   `:sitemap-style'
 
-    Can be `list' (site-map is just an itemized list of the
-    titles of the files involved) or `tree' (the directory
-    structure of the source files is reflected in the site-map).
-    Defaults to `tree'.
+    By default `list' (site-map is a list of files) or
+    `tree' (the directory structure of the source files is
+    reflected in the site-map).  Defaults to `tree'.  Files are
+    formatted according to `:sitemap-file-entry-format',
+    directories according to `:sitemap-dir-entry-format'.  To add
+    new styles STYLE define a new function
+    `org-publish-org-sitemap-as-STYLE' that takes a list of files
+    and project-plist as arguments (assuming `:sitemap-function'
+    is `org-publish-org-sitemap').
 
   `:sitemap-sans-extension'
 
@@ -228,6 +235,20 @@ a site-map of files or summary page for a given project.
     cool URIs (see http://www.w3.org/Provider/Style/URI).
     Defaults to nil.
 
+  `:sitemap-file-entry-format'
+  `:sitemap-dir-entry-format'
+
+    Format of filenames and directories included in the sitemap.
+    See `org-publish-sitemap-file-entry-format' for details.
+
+  `:sitemap-preamble'
+  `:sitemap-postamble'
+
+    Preamble and postamble for sitemap.  Useful for inserting
+    #+OPTIONS: keywords, footers etc.  See
+    `org-publish-sitemap-preamble' for details.
+
+
 If you create a site-map file, adjust the sorting like this:
 
   `:sitemap-sort-folders'
@@ -322,15 +343,64 @@ See `format-time-string' for allowed formatters."
   :group 'org-export-publish
   :type 'string)
 
-(defcustom org-publish-sitemap-file-entry-format "%t"
+(defcustom org-publish-sitemap-file-entry-format "%i [[file:%l][%t]]"
   "Format string for site-map file entry.
-You could use brackets to delimit on what part the link will be.
+
+This format string can contain these elements:
 
 %t is the title.
+%s is the subtitle.
 %a is the author.
-%d is the date formatted using `org-publish-sitemap-date-format'."
+%l is the link.
+%h is a leveled headline relative to the base directory.
+%i is an indented item relative to the base directory.
+%d is the date formatted using `org-publish-sitemap-date-format'.
+%f is the directory or filename relative to the base directory.
+%F is the plain directory or filename.
+
+See also `org-publish-sitemap-dir-entry-format'."
   :group 'org-export-publish
-  :type 'string)
+  :type 'string
+  :version "25.1"
+  :package-version '(Org . "9.0"))
+
+(defcustom org-publish-sitemap-dir-entry-format "%i %f"
+  "Format string for site-map file entry.
+See also `org-publish-sitemap-file-entry-format'."
+  :group 'org-export-publish
+  :type 'string
+  :version "25.1"
+  :package-version '(Org . "9.0"))
+
+(defcustom org-publish-sitemap-preamble nil
+  "Sitemap preamble.
+
+Can be either a string, a list of strings, or a function that
+takes a project-plist as an argument and return a string."
+  :group 'org-export-publish
+  :type '(choice
+	  (const :tag "None" nil)
+	  (string :tag "String")
+	  (repeat :tag "List of strings"
+		  (string :tag "String"))
+	  (function :tag "Function"))
+  :version "25.1"
+  :package-version '(Org . "9.0"))
+
+(defcustom org-publish-sitemap-postamble nil
+  "Sitemap postamble.
+
+Can be either a string, a list of strings, or a function that
+takes a project-plist as an argument and return a string."
+  :group 'org-export-publish
+  :type '(choice
+	  (const :tag "None" nil)
+	  (string :tag "String")
+	  (repeat :tag "List of strings"
+		  (string :tag "String"))
+	  (function :tag "Function"))
+  :version "25.1"
+  :package-version '(Org . "9.0"))
 
 
 \f
@@ -399,6 +469,7 @@ This splices all the components into the list."
 (defvar org-publish-sitemap-requested)
 (defvar org-publish-sitemap-date-format)
 (defvar org-publish-sitemap-file-entry-format)
+(defvar org-publish-sitemap-dir-entry-format)
 (defun org-publish-compare-directory-files (a b)
   "Predicate for `sort', that sorts folders and files for sitemap."
   (let ((retval t))
@@ -690,7 +761,16 @@ If `:auto-sitemap' is set, publish the sitemap too.  If
 		   org-publish-sitemap-date-format))
 	      (org-publish-sitemap-file-entry-format
 	       (or (plist-get project-plist :sitemap-file-entry-format)
-		   org-publish-sitemap-file-entry-format)))
+		   org-publish-sitemap-file-entry-format))
+	      (org-publish-sitemap-dir-entry-format
+	       (or (plist-get project-plist :sitemap-dir-entry-format)
+		   org-publish-sitemap-dir-entry-format))
+	      (org-publish-sitemap-preamble
+	       (or (plist-get project-plist :sitemap-preamble)
+		   org-publish-sitemap-preamble))
+	      (org-publish-sitemap-postamble
+	       (or (plist-get project-plist :sitemap-postamble)
+		   org-publish-sitemap-postamble)))
 	  (funcall sitemap-function project sitemap-filename)))
       ;; Publish all files from PROJECT excepted "theindex.org".  Its
       ;; publishing will be deferred until "theindex.inc" is
@@ -715,112 +795,171 @@ If `:auto-sitemap' is set, publish the sitemap too.  If
 (defun org-publish-org-sitemap (project &optional sitemap-filename)
   "Create a sitemap of pages in set defined by PROJECT.
 Optionally set the filename of the sitemap with SITEMAP-FILENAME.
+
 Default for SITEMAP-FILENAME is `sitemap.org'."
   (let* ((project-plist (cdr project))
 	 (dir (file-name-as-directory
 	       (plist-get project-plist :base-directory)))
-	 (localdir (file-name-directory dir))
-	 (indent-str (make-string 2 ?\ ))
-	 (exclude-regexp (plist-get project-plist :exclude))
-	 (files (nreverse
-		 (org-publish-get-base-files project exclude-regexp)))
 	 (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
+	 (files (nreverse
+		 ;; Sitemap shouldn't list itself.
+		 (cl-delete-if (lambda (f)
+				 (equal (file-truename f)
+					(file-truename sitemap-filename)))
+			       (org-publish-get-base-files
+				project
+				(plist-get project-plist :exclude)))))
 	 (sitemap-title (or (plist-get project-plist :sitemap-title)
-			  (concat "Sitemap for project " (car project))))
-	 (sitemap-style (or (plist-get project-plist :sitemap-style)
-			    'tree))
-	 (sitemap-sans-extension
-	  (plist-get project-plist :sitemap-sans-extension))
+			    (concat "Sitemap for project " (car project))))
 	 (visiting (find-buffer-visiting sitemap-filename))
-	 file sitemap-buffer)
-    (with-current-buffer
-	(let ((org-inhibit-startup t))
-	  (setq sitemap-buffer
-		(or visiting (find-file sitemap-filename))))
+	 (sitemap-buffer (or visiting (find-file sitemap-filename)))
+	 (insert-pre-or-postamble (function (lambda (pre-or-postamble)
+					      (when pre-or-postamble
+						(cond ((stringp pre-or-postamble) pre-or-postamble)
+						      ((listp pre-or-postamble)
+						       (mapconcat 'identity preamble "\n"))
+						      ((functionp pre-or-postamble)
+						       (funcall pre-or-postamble project-plist))
+						      (t (error (concat "unknown `:sitemap-preamble' or "
+									"`:sitemap-postamble' format")))))))))
+    (with-current-buffer (let ((org-inhibit-startup t)) sitemap-buffer)
       (erase-buffer)
       (insert (concat "#+TITLE: " sitemap-title "\n\n"))
-      (while (setq file (pop files))
-	(let ((link (file-relative-name file dir))
-	      (oldlocal localdir))
-	  (when sitemap-sans-extension
-	    (setq link (file-name-sans-extension link)))
-	  ;; sitemap shouldn't list itself
-	  (unless (equal (file-truename sitemap-filename)
-			 (file-truename file))
-	    (if (eq sitemap-style 'list)
-		(message "Generating list-style sitemap for %s" sitemap-title)
-	      (message "Generating tree-style sitemap for %s" sitemap-title)
-	      (setq localdir (concat (file-name-as-directory dir)
-				     (file-name-directory link)))
-	      (unless (string= localdir oldlocal)
-		(if (string= localdir dir)
-		    (setq indent-str (make-string 2 ?\ ))
-		  (let ((subdirs
-			 (split-string
-			  (directory-file-name
-			   (file-name-directory
-			    (file-relative-name localdir dir))) "/"))
-			(subdir "")
-			(old-subdirs (split-string
-				      (file-relative-name oldlocal dir) "/")))
-		    (setq indent-str (make-string 2 ?\ ))
-		    (while (string= (car old-subdirs) (car subdirs))
-		      (setq indent-str (concat indent-str (make-string 2 ?\ )))
-		      (pop old-subdirs)
-		      (pop subdirs))
-		    (dolist (d subdirs)
-		      (setq subdir (concat subdir d "/"))
-		      (insert (concat indent-str " + " d "\n"))
-		      (setq indent-str (make-string
-					(+ (length indent-str) 2) ?\ )))))))
-	    ;; This is common to 'flat and 'tree
-	    (let ((entry
-		   (org-publish-format-file-entry
-		    org-publish-sitemap-file-entry-format file project-plist))
-		  (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
-	      (cond ((string-match-p regexp entry)
-		     (string-match regexp entry)
-		     (insert (concat indent-str " + " (match-string 1 entry)
-				     "[[file:" link "]["
-				     (match-string 2 entry)
-				     "]]" (match-string 3 entry) "\n")))
-		    (t
-		     (insert (concat indent-str " + [[file:" link "]["
-				     entry
-				     "]]\n"))))))))
+      ;; Insert sitemap-preamble.
+      (funcall insert-pre-or-postamble
+	       (plist-get project-plist :sitemap-preamble))
+      ;; Call function to build sitemap based on files and the project-plist.
+      (insert (funcall (intern
+			(concat "org-publish-org-sitemap-as-"
+				(symbol-name (or (plist-get project-plist :sitemap-style) 'tree))))
+		       files project-plist))
+      ;; Insert sitemap-postamble.
+      (funcall insert-pre-or-postamble
+	       (plist-get project-plist :sitemap-postamble))
       (save-buffer))
     (or visiting (kill-buffer sitemap-buffer))))
 
-(defun org-publish-format-file-entry (fmt file project-plist)
-  (format-spec
-   fmt
-   `((?t . ,(org-publish-find-title file t))
-     (?d . ,(format-time-string org-publish-sitemap-date-format
-				(org-publish-find-date file)))
-     (?a . ,(or (plist-get project-plist :author) user-full-name)))))
+(defun org-publish-org-sitemap-as-list (files project-plist)
+  "Insert FILES as simple list separated by newlines.
+PROJECT-PLIST holds the project information."
+  (mapconcat
+   (lambda (file) (org-publish-format-file-entry
+	      org-publish-sitemap-file-entry-format
+	      file project-plist))
+   files "\n"))
+
+(defun org-publish--dir-parent (dir)
+  "Return directory parent of DIR"
+  (let ((dir (file-name-directory dir)))
+    (substring dir 0 (string-match-p "[^/]+/?\\'" dir))))
+
+(defun org-publish--tree-assoc (key tree)
+  "Traverse TREE to find list for which the car is `equal' to KEY."
+  (and (consp tree)
+       (cl-destructuring-bind (tree-car . tree-cdr) tree
+	 (if (equal tree-car key) tree
+	   (or (org-publish--tree-assoc key tree-car)
+	       (org-publish--tree-assoc key tree-cdr))))))
+
+(defun org-pubish--order-files-by-dir-tree (files)
+  "Order FILES according to the file tree."
+  (let* ((dirs (sort
+		(delq nil (delete-dups (mapcar 'file-name-directory files)))
+		'dired-tree-lessp))
+         (file-list (list (pop dirs))))
+    (dolist (dir dirs)
+      (or (nconc (org-publish--tree-assoc
+		  (org-publish--dir-parent dir)
+		  file-list)
+		 (list (list dir)))
+	  (nconc file-list dir)))
+    (dolist (file files)
+      (nconc (org-publish--tree-assoc
+	      (file-name-directory file) file-list)
+             (list file)))
+    (message-flatten-list file-list)))
+
+(defun org-publish-org-sitemap-as-tree (files project-plist)
+  "Insert FILES as a tree.
+PROJECT-PLIST holds the project information."
+  (mapconcat (lambda (elm)
+	       (org-publish-format-file-entry
+		(cond
+		 ((directory-name-p elm) org-publish-sitemap-dir-entry-format)
+		 (t org-publish-sitemap-file-entry-format))
+		elm project-plist))
+	     (org-pubish--order-files-by-dir-tree files)
+	     "\n"))
 
-(defun org-publish-find-title (file &optional reset)
-  "Find the title of FILE in project."
+(defun org-publish-format-file-entry (fmt file project-plist)
+  "Format FILE according to the format-string FMT.
+PROJECT-PLIST is a plist holding project options.
+See also `org-publish-sitemap-file-entry-format'.
+"
+  (let ((basedir (file-truename (plist-get project-plist :base-directory))))
+    (when (and (file-exists-p file)
+	       (not (equal file basedir)))
+      (let* ((filename (file-relative-name file basedir))
+	     (dirname (file-name-directory filename))
+	     (depth (if (or (eq 'list (plist-get project-plist :sitemap-style))
+			    (not dirname))
+			1
+		      (+ (if (not (directory-name-p filename)) 1 0)
+			 (length (split-string (file-name-directory filename) "/" t)))))
+	     (link (funcall (if (plist-get project-plist :sitemap-sans-extension)
+				'file-name-sans-extension
+			      'identity)
+			    filename)))
+	(format-spec
+	 fmt
+	 `((?t . ,(and (not (directory-name-p file)) (org-publish-find-title file t)))
+	   (?s . ,(and (not (directory-name-p file)) (org-publish-find-subtitle file t)))
+	   (?f . ,filename)
+	   (?F . ,(directory-file-name
+		    (if (directory-name-p filename)
+			(file-relative-name
+			 dirname (org-publish--dir-parent dirname))
+		      (file-relative-name filename dirname))))
+	   (?l . ,link)
+	   (?h . ,(concat (make-string depth ?*)))
+	   (?i . ,(concat (make-string (* 2 depth) ? ) "-"))
+	   (?d . ,(and (not (directory-name-p file))
+		       (format-time-string
+			(or (plist-get project-plist :sitemap-date-format)
+			    org-publish-sitemap-date-format)
+			(org-publish-find-date file))))
+	   (?a . ,(or (plist-get project-plist :author) user-full-name))))))))
+
+(defun org-publish--find-property (file property &optional reset)
+  "Find the PROPERTY of FILE in project"
   (or
-   (and (not reset) (org-publish-cache-get-file-property file :title nil t))
+   (and (not reset) (org-publish-cache-get-file-property file property nil t))
    (let* ((org-inhibit-startup t)
 	  (visiting (find-buffer-visiting file))
 	  (buffer (or visiting (find-file-noselect file))))
      (with-current-buffer buffer
-       (let ((title
-	      (let ((property
+       (let ((value
+	      (let ((found-property
 		     (plist-get
 		      ;; protect local variables in open buffers
 		      (if visiting
 			  (org-export-with-buffer-copy (org-export-get-environment))
 			(org-export-get-environment))
-		      :title)))
-		(if property
-		    (org-no-properties (org-element-interpret-data property))
+		      property)))
+		(if found-property
+		    (org-no-properties (org-element-interpret-data found-property))
 		  (file-name-nondirectory (file-name-sans-extension file))))))
 	 (unless visiting (kill-buffer buffer))
-	 (org-publish-cache-set-file-property file :title title)
-	 title)))))
+	 (org-publish-cache-set-file-property file property value)
+	 value)))))
+
+(defun org-publish-find-title (file &optional reset)
+  "Find the title of FILE in project."
+  (org-publish--find-property file :title reset))
+
+(defun org-publish-find-subtitle (file &optional reset)
+  "Find the title of FILE in project."
+  (org-publish--find-property file :subtitle reset))
 
 (defun org-publish-find-date (file)
   "Find the date of FILE in project.
-- 
2.8.2


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

end of thread, other threads:[~2016-07-20  7:56 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-05-19 15:39 [ox-publish, patch] More flexible sitemaps Rasmus
2016-05-22 22:58 ` Nicolas Goaziou
2016-05-27 16:41   ` Rasmus
2016-06-01 15:34     ` Nicolas Goaziou
2016-07-05 11:08       ` Robert Klein
2016-07-06 11:17         ` Rasmus
2016-07-07  9:03       ` Rasmus
2016-07-20  7:56         ` Nicolas Goaziou

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