summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-10-30 09:20:10 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-12-19 12:19:58 +0100
commit2d3e3f562a37d3f3375ab44a3e452319bf7be0f6 (patch)
treede834c70261fb25b22369c9e0c3d058f216267a9
parent45d57bb4db7130e0b8b8995eed7976308e60237b (diff)
downloadorg-mode-2d3e3f562a37d3f3375ab44a3e452319bf7be0f6.tar.gz
ox-publish: Improve control over site map
* lisp/ox-publish.el (org-publish-project-alist): Document new :sitemap-format-entry property, and change to `:sitemap-function'. (org-publish-sitemap-file-entry-format): Make variable obsolete. (org-publish-org-sitemap): Remove function. (org-publish--sitemap-files-to-lisp): (org-publish-sitemap): (org-publish-sitemap-default-entry): (org-publish-sitemap-default): New functions. (org-publish-projects): Use new functions. * lisp/org-compat: Implement directory-name-p when not available. * doc/org.texi (Sitemap): Update documentation. :sitemap-function is more specialized so it is easier to manipulate. In particular, it can make use of built-in `org-list-to-*' functions. Also, :sitemap-format-entry, as a function, is less limited than `org-publish-sitemap-file-entry-format' format string.
-rw-r--r--doc/org.texi24
-rw-r--r--etc/ORG-NEWS22
-rw-r--r--lisp/org-compat.el25
-rw-r--r--lisp/ox-publish.el219
4 files changed, 166 insertions, 124 deletions
diff --git a/doc/org.texi b/doc/org.texi
index 6be76d8..d30ec69 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -14532,10 +14532,20 @@ becomes @file{sitemap.html}).
@item @code{:sitemap-title}
@tab Title of sitemap page. Defaults to name of file.
+@item @code{:sitemap-format-entry}
+@tab With this option one can tell how a site-map entry is formatted in the
+site-map. It is a function called with three arguments: the absolute file or
+directory name, the base directory of the project and the site-map style. It
+is expected to return a string. Default value turns file names into links
+and use document titles as descriptions.
+
@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.
+@tab Plug-in function to use for generation of the sitemap. It is called
+with two arguments: the title of the site-map and a representation of the
+files and directories involved in the project as a radio list (@pxref{Radio
+lists}). The latter can further be transformed using
+@code{org-list-to-generic}, @code{org-list-to-subtree} and alike. Default
+value generates a plain list of links to all files in the project.
@item @code{:sitemap-sort-folders}
@tab Where folders should appear in the sitemap. Set this to @code{first}
@@ -14553,14 +14563,6 @@ a file is retrieved with @code{org-publish-find-date}.
@item @code{:sitemap-ignore-case}
@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-date-format}
@tab Format string for the @code{format-time-string} function that tells how
a sitemap entry's date is to be formatted. This property bypasses
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 3f5529f..2161c39 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -12,11 +12,6 @@ Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
** Incompatible changes
-*** Change signature for some properties in ~org-list-to-generic~
-
-~:istart~, ~:icount~, ~:iend~ and ~:isep~ now expect the type of the
-list as their first argument.
-
*** ~org-capture-templates~ no longer accepts S-expressions as file names
Since functions are allowed there, a straightforward way to migrate
@@ -28,6 +23,16 @@ into
: (file (lambda () (sexp)))
+*** Change signature for ~:sitemap-function~
+
+~:sitemap-function~ now expects to be called with two arguments. See
+~org-publish-project-alist~ for details.
+
+*** Change signature for some properties in ~org-list-to-generic~
+
+~:istart~, ~:icount~, ~:iend~ and ~:isep~ now expect the type of the
+list as their first argument.
+
** New features
*** Agenda
**** New variable : ~org-agenda-show-future-repeats~
@@ -121,6 +126,13 @@ For an equivalent to a ~nil~ value, set
~org-agenda-show-future-repeats~ to nil and
~org-agenda-prefer-last-repeat~ to ~t~.
+** Removed options
+
+*** ~org-publish-sitemap-file-entry-format~ is deprecated
+
+One can provide new ~:sitemap-format-entry~ property for a function
+equivalent to the removed format string.
+
** New functions
*** ~org-list-to-org~
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 7491464..69e2ff6 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -60,6 +60,17 @@
(defalias 'format-message 'format)
(defalias 'gui-get-selection 'x-get-selection))
+ ;; From "files.el"
+ (defsubst directory-name-p (name)
+ "Return non-nil if NAME ends with a directory separator character."
+ (let ((len (length name))
+ (lastc ?.))
+ (if (> len 0)
+ (setq lastc (aref name (1- len))))
+ (or (= lastc ?/)
+ (and (memq system-type '(windows-nt ms-dos))
+ (= lastc ?\\)))))
+
;;; Obsolete aliases (remove them once the next major release is released).
@@ -288,6 +299,20 @@ See `org-link-parameters' for documentation on the other parameters."
(org-unbracket-string "\"" "\"" s))
(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0")
+(defcustom org-publish-sitemap-file-entry-format "%t"
+ "Format string for site-map file entry.
+You could use brackets to delimit on what part the link will be.
+
+%t is the title.
+%a is the author.
+%d is the date formatted using `org-publish-sitemap-date-format'."
+ :group 'org-export-publish
+ :type 'string)
+(make-obsolete-variable
+ 'org-publish-sitemap-file-entry-format
+ "set `:sitemap-format-entry' in `org-publish-project-alist' instead."
+ "Org 9.1")
+
;;;; Obsolete link types
(eval-after-load 'org
diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el
index e8271f6..a188e69 100644
--- a/lisp/ox-publish.el
+++ b/lisp/ox-publish.el
@@ -208,18 +208,12 @@ a site-map of files or summary page for a given project.
`:sitemap-filename'
- Filename for output of sitemap. Defaults to \"sitemap.org\".
+ Filename for output of site-map. Defaults to \"sitemap.org\".
`:sitemap-title'
Title of site-map page. Defaults to name of file.
- `:sitemap-function'
-
- Plugin function to use for generation of site-map. Defaults
- to `org-publish-org-sitemap', which generates a plain list of
- links to all files in the project.
-
`:sitemap-style'
Can be `list' (site-map is just an itemized list of the
@@ -233,6 +227,26 @@ 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-format-entry'
+
+ Plugin function used to format entries in the site-map. It
+ is called with three arguments: the absolute file or
+ directory name to format, the base directory of the project
+ and the site-map style. It has to return a string. Defaults
+ to `org-publish-sitemap-default-entry', which turns file
+ names into links and use document titles as descriptions.
+
+ `:sitemap-function'
+
+ Plugin function to use for generation of site-map. It is
+ called with two arguments: the title of the site-map, as
+ a string, and a representation of the files involved in the
+ project, as returned by `org-list-to-lisp'. The latter can
+ further be transformed using `org-list-to-generic',
+ `org-list-to-subtree' and alike. It has to return a string.
+ Defaults to `org-publish-sitemap-default', which generates
+ a plain list of links to all files in the project.
+
If you create a site-map file, adjust the sorting like this:
`:sitemap-sort-folders'
@@ -327,16 +341,6 @@ See `format-time-string' for allowed formatters."
:group 'org-export-publish
:type 'string)
-(defcustom org-publish-sitemap-file-entry-format "%t"
- "Format string for site-map file entry.
-You could use brackets to delimit on what part the link will be.
-
-%t is the title.
-%a is the author.
-%d is the date formatted using `org-publish-sitemap-date-format'."
- :group 'org-export-publish
- :type 'string)
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -403,7 +407,6 @@ This splices all the components into the list."
(defvar org-publish-sitemap-ignore-case)
(defvar org-publish-sitemap-requested)
(defvar org-publish-sitemap-date-format)
-(defvar org-publish-sitemap-file-entry-format)
(defun org-publish-compare-directory-files (a b)
"Predicate for `sort', that sorts folders and files for sitemap."
(let ((retval t))
@@ -687,16 +690,10 @@ If `:auto-sitemap' is set, publish the sitemap too. If
(let ((sitemap-filename
(or (plist-get project-plist :sitemap-filename)
"sitemap.org"))
- (sitemap-function
- (or (plist-get project-plist :sitemap-function)
- #'org-publish-org-sitemap))
(org-publish-sitemap-date-format
(or (plist-get project-plist :sitemap-date-format)
- 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)))
- (funcall sitemap-function project sitemap-filename)))
+ org-publish-sitemap-date-format)))
+ (org-publish-sitemap project sitemap-filename)))
;; Publish all files from PROJECT excepted "theindex.org". Its
;; publishing will be deferred until "theindex.inc" is
;; populated.
@@ -717,92 +714,78 @@ If `:auto-sitemap' is set, publish the sitemap too. If
((functionp fun) (funcall fun project-plist))))
(org-publish-write-cache-file))))
-(defun org-publish-org-sitemap (project &optional sitemap-filename)
+(defun org-publish--sitemap-files-to-lisp (files root style entry-format)
+ "Represent FILES as a parsed plain list.
+FILES is the list of files in the site map. ROOT is the project
+base directory. STYLE determines is either `list' or `tree'.
+ENTRY-FORMAT is a function called on each file which should
+return a string. Return value is a list as returned by
+`org-list-to-lisp'."
+ (pcase style
+ (`list
+ (cons 'unordered
+ (mapcar (lambda (f) (list (funcall entry-format f root style)))
+ files)))
+ (`tree
+ (letrec ((files-only (cl-remove-if #'directory-name-p files))
+ ;; Extract directories from true files so as to avoid
+ ;; publishing empty, or missing (e.g., when using
+ ;; `:include' property) directories.
+ (directories (org-uniquify
+ (mapcar #'file-name-directory files-only)))
+ (subtree-to-list
+ (lambda (dir)
+ (cons 'unordered
+ (nconc
+ ;; Files in DIR.
+ (mapcar
+ (lambda (f) (list (funcall entry-format f root style)))
+ (cl-remove-if-not
+ (lambda (f) (string= dir (file-name-directory f)))
+ files-only))
+ ;; Direct sub-directories.
+ (mapcar
+ (lambda (sub)
+ (list (funcall entry-format sub root style)
+ (funcall subtree-to-list sub)))
+ (cl-remove-if-not
+ (lambda (f)
+ (string=
+ dir
+ ;; Parent directory.
+ (file-name-directory (directory-file-name f))))
+ directories)))))))
+ (funcall subtree-to-list root)))
+ (_ (user-error "Unknown sitemap style: `%s'" style))))
+
+(defun org-publish-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")))
- (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))
- (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))))
- (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"))))))))
- (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)))))
+ (root (expand-file-name
+ (file-name-as-directory
+ (plist-get project-plist :base-directory))))
+ (sitemap-filename (concat root (or sitemap-filename "sitemap.org")))
+ (title (or (plist-get project-plist :sitemap-title)
+ (concat "Sitemap for project " (car project))))
+ (style (or (plist-get project-plist :sitemap-style) 'tree))
+ (sitemap-builder (or (plist-get project-plist :sitemap-function)
+ #'org-publish-sitemap-default))
+ (format-entry (or (plist-get project-plist :sitemap-format-entry)
+ #'org-publish-sitemap-default-entry)))
+ (message "Generating sitemap for %s" title)
+ (with-temp-file sitemap-filename
+ (insert
+ (let ((files (remove sitemap-filename
+ (org-publish-get-base-files
+ project (plist-get project-plist :exclude)))))
+ (when (plist-get project-plist :sitemap-sans-extension)
+ (setq files (mapcar #'file-name-sans-extension files)))
+ (funcall sitemap-builder
+ title
+ (org-publish--sitemap-files-to-lisp
+ files root style format-entry)))))))
(defun org-publish-find-title (file &optional reset)
"Find the title of FILE in project."
@@ -856,6 +839,26 @@ time in `current-time' format."
((file-exists-p file) (nth 5 (file-attributes file)))
(t (error "No such file: \"%s\"" file))))))
+(defun org-publish-sitemap-default-entry (entry root style)
+ "Default format for site map ENTRY, as a string.
+ENTRY is a file name. ROOT is the base directory of the current
+project. STYLE is the style of the sitemap."
+ (cond ((not (directory-name-p entry))
+ (format "[[file:%s][%s]]"
+ (file-relative-name entry root)
+ (org-publish-find-title entry)))
+ ((eq style 'tree)
+ ;; Return only last subdir.
+ (file-name-nondirectory (directory-file-name entry)))
+ (t (file-relative-name entry root))))
+
+(defun org-publish-sitemap-default (title list)
+ "Default site map, as a string.
+TITLE is the the title of the site map. LIST is an internal
+representation for the files to include, as returned by
+`org-list-to-lisp'."
+ (concat "#+TITLE: " title "\n\n"
+ (org-list-to-org list)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;