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:
parent
45d57bb4db
commit
2d3e3f562a
24
doc/org.texi
24
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
|
||||
|
|
22
etc/ORG-NEWS
22
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~
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
Loading…
Reference in New Issue