From: Rasmus <rasmus@gmx.us>
To: emacs-orgmode@gnu.org
Subject: [ox-publish, patch] More flexible sitemaps
Date: Thu, 19 May 2016 17:39:21 +0200 [thread overview]
Message-ID: <87eg8ydpli.fsf@gmx.us> (raw)
[-- 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
next reply other threads:[~2016-05-19 15:39 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-05-19 15:39 Rasmus [this message]
2016-05-22 22:58 ` [ox-publish, patch] More flexible sitemaps 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87eg8ydpli.fsf@gmx.us \
--to=rasmus@gmx.us \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.