From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nicolas Goaziou Subject: Re: [ox-publish, patch] More flexible sitemaps Date: Mon, 23 May 2016 00:58:14 +0200 Message-ID: <87twhpk8e1.fsf@saiph.selenimh> References: <87eg8ydpli.fsf@gmx.us> Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:53115) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1b4cKJ-00009f-En for emacs-orgmode@gnu.org; Sun, 22 May 2016 18:58:28 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1b4cKG-0007vO-R1 for emacs-orgmode@gnu.org; Sun, 22 May 2016 18:58:26 -0400 Received: from relay4-d.mail.gandi.net ([2001:4b98:c:538::196]:40851) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1b4cKG-0007v1-DV for emacs-orgmode@gnu.org; Sun, 22 May 2016 18:58:24 -0400 In-Reply-To: <87eg8ydpli.fsf@gmx.us> (rasmus@gmx.us's message of "Thu, 19 May 2016 17:39:21 +0200") List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: Rasmus Cc: emacs-orgmode@gnu.org Hello, Rasmus 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 =E2=80=98:sitemap-file-entry-form= at=E2=80=99, > > :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-p= list. > + (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-extensio= n) > + '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 fi= le 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) =20=20 > + (?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, --=20 Nicolas Goaziou