Re: [ox-publish, patch] More flexible sitemaps

[Nicolas Goaziou <mail@nicolasgoaziou.fr>]

Hello,

Rasmus <rasmus@gmx.us> writes:

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

It sounds interesting. Usual nitpicking follows.

> * 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.

This is not a 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.

All in all, I think this deserves to be split into 3 patches: one for
the preamble-postamble feature, another one for implementing
`org-publish--find-property' and associated refactoring, and the latter
for the sitemap itself.

> +(autoload 'message-flatten-list "message")
> +(autoload 'dired-tree-lessp "dired-aux")

I hope we can avoid these. In particular, why are you using
`dired-tree-lessp' instead of `org-publish-compare-directory-files'?

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

The above is not necessary.

> +	 (files (nreverse
> +		 ;; Sitemap shouldn't list itself.
> +		 (cl-delete-if (lambda (f)
> +				 (equal (file-truename f)
> +					(file-truename sitemap-filename)))

See `file-equal-p'.

> +			       (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)

No need to wrap `function' around `lambda'.  Also, it doesn't "insert"
anything, does it? IOW, isn't the name a bit confusing ?

> +					      (when pre-or-postamble

You can include the `when' in the cond:

  (cond ((not pre-or-postamble) nil)
        ((stringp 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)

You can drop the `let' part, which is a no-op here.

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

(intern (format "org-publish-org-sitemap-as-%s" (or (plist-get ...) 'tree))

You may want to check that it does exist before and raise an error
otherwise.

> +      ;; Insert sitemap-postamble.
> +      (funcall insert-pre-or-postamble
> +	       (plist-get project-plist :sitemap-postamble))
>        (save-buffer))

Not directly related, but `save-buffer' here is suspicious. It may be
better to use `with-temp-file' instead.

> +(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"))

Mind indentation

  (lambda (file)
    (org-publish-format-file-entry ...))

> +(defun org-publish--dir-parent (dir)
> +  "Return directory parent of DIR"
> +  (let ((dir (file-name-directory dir)))
> +    (substring dir 0 (string-match-p "[^/]+/?\\'" dir))))

  (file-name-directory (directory-file-name 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)))

I don't understand why you need the 2 functions above. You are working
with plain lists, not nested ones. Besides, once the file name are
standardized, isn't tree order equivalent to lexicographic one?

> +  (let ((basedir (file-truename (plist-get project-plist :base-directory))))
> +    (when (and (file-exists-p file)
> +	       (not (equal file basedir)))

`file-equal-p'

> +      (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)

#'file-name-sans-extension and #'identity

> +	(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) ? ) "-"))

  (make-string (* 2 depth) ?\s)
  
> +	   (?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-subtitle (file &optional reset)
> +  "Find the title of FILE in project."
> +  (org-publish--find-property file :subtitle reset))

I don't think this would work. :subtitle is not defined in default
export properties, it is back-end specific. `org-export-get-environment'
without any argument, doesn't catch these. You need to somehow provide
it the back-end.

Regards,

-- 
Nicolas Goaziou