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

[Nicolas Goaziou]

Hello,

Rasmus <address@hidden> 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