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.
This commit is contained in:
Nicolas Goaziou 2016-10-30 09:20:10 +01:00
parent 45d57bb4db
commit 2d3e3f562a
4 changed files with 166 additions and 124 deletions

View File

@ -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

View File

@ -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~

View File

@ -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

View File

@ -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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;