>From e6b35524ba0959b6ca4057555325ec7d755248da Mon Sep 17 00:00:00 2001 From: Rasmus 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 address@hidden @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} address@hidden 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 address@hidden stands for the date of the file. The date is retrieved with the address@hidden function and formatted with address@hidden Default @code{%t}. address@hidden @code{:sitemap-dir-entry-format} address@hidden 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}. address@hidden @code{:sitemap-preamble} address@hidden @code{:sitemap-postamble} address@hidden 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") @@ -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")) @@ -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