Browse Source

ox-publish: Provide relative file in sitemap generation

* doc/org.texi (Sitemap):
* lisp/ox-publish.el (org-publish-project-alist): Document change.

(org-publish-property):
(org-publish--expand-file-name): New functions

(org-publish-get-base-files):
(org-publish-file):
(org-publish-projects):
(org-publish--sitemap-files-to-lisp):
(org-publish-sitemap):
(org-publish-find-property):
(org-publish-find-title):
(org-publish-find-date):
(org-publish-sitemap-default-entry):
(org-publish-sitemap-default): Use new functions.

* testing/lisp/test-ox-publish.el (test-org-publish/sitemap): Update
  test.
Nicolas Goaziou 8 years ago
parent
commit
83827952db
4 changed files with 207 additions and 168 deletions
  1. 7 6
      doc/org.texi
  2. 4 4
      etc/ORG-NEWS
  3. 194 154
      lisp/ox-publish.el
  4. 2 4
      testing/lisp/test-ox-publish.el

+ 7 - 6
doc/org.texi

@@ -14534,12 +14534,13 @@ becomes @file{sitemap.html}).
 
 
 @item @code{:sitemap-format-entry}
 @item @code{:sitemap-format-entry}
 @tab With this option one can tell how a site-map entry is formatted in the
 @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.  For specific formatting needs, one
-can use @code{org-publish-find-property} to retrieve additional information
-about published documents.
+site-map.  It is a function called with three arguments: the file or
+directory name relative to base directory of the project, the site-map style
+and the current project.  It is expected to return a string.  Default value
+turns file names into links and use document titles as descriptions.  For
+specific formatting needs, one can use @code{org-publish-find-date},
+@cod{org-publish-find-title} and @code{org-publish-find-property}, to
+retrieve additional information about published documents.
 
 
 @item @code{:sitemap-function}
 @item @code{:sitemap-function}
 @tab Plug-in function to use for generation of the sitemap.  It is called
 @tab Plug-in function to use for generation of the sitemap.  It is called

+ 4 - 4
etc/ORG-NEWS

@@ -32,13 +32,13 @@ You can get the same functionality by setting ~:sitemap-format-entry~
 to the following
 to the following
 
 
 #+BEGIN_SRC elisp
 #+BEGIN_SRC elisp
-(lambda (entry root style)
+(lambda (entry style project)
   (cond ((not (directory-name-p entry))
   (cond ((not (directory-name-p entry))
 	 (format "[[file:%s][%s]]"
 	 (format "[[file:%s][%s]]"
-		 (file-name-sans-extension (file-relative-name entry root))
-		 (org-publish-find-title entry)))
+		 (file-name-sans-extension entry)
+		 (org-publish-find-title entry project)))
 	((eq style 'tree) (file-name-nondirectory (directory-file-name entry)))
 	((eq style 'tree) (file-name-nondirectory (directory-file-name entry)))
-	(t (file-relative-name entry root))))
+	(t entry)))
 #+END_SRC
 #+END_SRC
 
 
 *** Change signature for ~:sitemap-function~
 *** Change signature for ~:sitemap-function~

+ 194 - 154
lisp/ox-publish.el

@@ -221,13 +221,15 @@ a site-map of files or summary page for a given project.
   `:sitemap-format-entry'
   `:sitemap-format-entry'
 
 
     Plugin function used to format entries in the site-map.  It
     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.
-    For specific formatting needs, one can use
-    `org-publish-find-property' to retrieve additional
+    is called with three arguments: the file or directory name
+    relative to base directory, the site map style and the
+    current project.  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.  For specific formatting needs, one can use
+    `org-publish-find-date', `org-publish-find-title' and
+    `org-publish-find-property', to retrieve additional
     information about published documents.
     information about published documents.
 
 
   `:sitemap-function'
   `:sitemap-function'
@@ -238,6 +240,7 @@ a site-map of files or summary page for a given project.
     project, as returned by `org-list-to-lisp'.  The latter can
     project, as returned by `org-list-to-lisp'.  The latter can
     further be transformed using `org-list-to-generic',
     further be transformed using `org-list-to-generic',
     `org-list-to-subtree' and alike.  It has to return a string.
     `org-list-to-subtree' and alike.  It has to return a string.
+
     Defaults to `org-publish-sitemap-default', which generates
     Defaults to `org-publish-sitemap-default', which generates
     a plain list of links to all files in the project.
     a plain list of links to all files in the project.
 
 
@@ -391,6 +394,22 @@ If there is no timestamp, create one."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Getting project information out of `org-publish-project-alist'
 ;;; Getting project information out of `org-publish-project-alist'
 
 
+(defun org-publish-property (property project &optional default)
+  "Return value PROPERTY, as à symbol, in PROJECT.
+DEFAULT is returned when PROPERTY is not actually set in PROJECT
+definition."
+  (let ((properties (cdr project)))
+    (if (plist-member properties property)
+	(plist-get properties property)
+      default)))
+
+(defun org-publish--expand-file-name (file project)
+  "Return full file name for FILE in PROJECT.
+When FILE is a relative file name, it is expanded according to
+project base directory."
+  (if (file-name-absolute-p file) file
+    (expand-file-name file (org-publish-property :base-directory project))))
+
 (defun org-publish-expand-projects (projects-alist)
 (defun org-publish-expand-projects (projects-alist)
   "Expand projects in PROJECTS-ALIST.
   "Expand projects in PROJECTS-ALIST.
 This splices all the components into the list."
 This splices all the components into the list."
@@ -406,21 +425,20 @@ This splices all the components into the list."
 
 
 (defun org-publish-get-base-files (project)
 (defun org-publish-get-base-files (project)
   "Return a list of all files in PROJECT."
   "Return a list of all files in PROJECT."
-  (let* ((project-plist (cdr project))
-	 (base-dir (file-name-as-directory
-		    (plist-get project-plist :base-directory)))
-	 (extension (or (plist-get project-plist :base-extension) "org"))
+  (let* ((base-dir (file-name-as-directory
+		    (org-publish-property :base-directory project)))
+	 (extension (or (org-publish-property :base-extension project) "org"))
 	 (match (if (eq extension 'any) "^[^\\.]"
 	 (match (if (eq extension 'any) "^[^\\.]"
 		  (concat "^[^\\.].*\\.\\(" extension "\\)$")))
 		  (concat "^[^\\.].*\\.\\(" extension "\\)$")))
 	 (base-files
 	 (base-files
-	  (if (not (plist-get project-plist :recursive))
-	      (directory-files base-dir t match t)
-	    (directory-files-recursively base-dir match))))
+	  (if (org-publish-property :recursive project)
+	      (directory-files-recursively base-dir match)
+	    (directory-files base-dir t match t))))
     (org-uniquify
     (org-uniquify
      (append
      (append
       ;; Files from BASE-DIR.  Apply exclusion filter before adding
       ;; Files from BASE-DIR.  Apply exclusion filter before adding
       ;; included files.
       ;; included files.
-      (let ((exclude-regexp (plist-get project-plist :exclude)))
+      (let ((exclude-regexp (org-publish-property :exclude project)))
 	(if exclude-regexp
 	(if exclude-regexp
 	    (cl-remove-if
 	    (cl-remove-if
 	     (lambda (f)
 	     (lambda (f)
@@ -431,14 +449,14 @@ This splices all the components into the list."
 	     base-files)
 	     base-files)
 	  base-files))
 	  base-files))
       ;; Sitemap file.
       ;; Sitemap file.
-      (and (plist-get project-plist :auto-sitemap)
+      (and (org-publish-property :auto-sitemap project)
 	   (list (expand-file-name
 	   (list (expand-file-name
-		  (or (plist-get project-plist :sitemap-filename)
+		  (or (org-publish-property :sitemap-filename project)
 		      "sitemap.org")
 		      "sitemap.org")
 		  base-dir)))
 		  base-dir)))
       ;; Included files.
       ;; Included files.
       (mapcar (lambda (f) (expand-file-name f base-dir))
       (mapcar (lambda (f) (expand-file-name f base-dir))
-	      (plist-get project-plist :include))))))
+	      (org-publish-property :include project))))))
 
 
 (defun org-publish-get-project-from-filename (filename &optional up)
 (defun org-publish-get-project-from-filename (filename &optional up)
   "Return the project that FILENAME belongs to."
   "Return the project that FILENAME belongs to."
@@ -533,8 +551,7 @@ Return output file name."
 
 
 
 
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Publishing files, sets of files, and indices
+;;; Publishing files, sets of files
 
 
 (defun org-publish-file (filename &optional project no-cache)
 (defun org-publish-file (filename &optional project no-cache)
   "Publish file FILENAME from PROJECT.
   "Publish file FILENAME from PROJECT.
@@ -547,23 +564,23 @@ files, when entire projects are published (see
 	      (or (org-publish-get-project-from-filename filename)
 	      (or (org-publish-get-project-from-filename filename)
 		  (error "File %s not part of any known project"
 		  (error "File %s not part of any known project"
 			 (abbreviate-file-name filename)))))
 			 (abbreviate-file-name filename)))))
-	 (project-plist (cdr project))
+	 (plist (cdr project))
 	 (ftname (expand-file-name filename))
 	 (ftname (expand-file-name filename))
 	 (publishing-function
 	 (publishing-function
-	  (let ((fun (plist-get project-plist :publishing-function)))
+	  (let ((fun (org-publish-property :publishing-function project)))
 	    (cond ((null fun) (error "No publishing function chosen"))
 	    (cond ((null fun) (error "No publishing function chosen"))
 		  ((listp fun) fun)
 		  ((listp fun) fun)
 		  (t (list fun)))))
 		  (t (list fun)))))
 	 (base-dir
 	 (base-dir
 	  (file-name-as-directory
 	  (file-name-as-directory
 	   (expand-file-name
 	   (expand-file-name
-	    (or (plist-get project-plist :base-directory)
+	    (or (org-publish-property :base-directory project)
 		(error "Project %s does not have :base-directory defined"
 		(error "Project %s does not have :base-directory defined"
 		       (car project))))))
 		       (car project))))))
 	 (pub-dir
 	 (pub-dir
 	  (file-name-as-directory
 	  (file-name-as-directory
 	   (file-truename
 	   (file-truename
-	    (or (eval (plist-get project-plist :publishing-directory))
+	    (or (org-publish-property :publishing-directory project)
 		(error "Project %s does not have :publishing-directory defined"
 		(error "Project %s does not have :publishing-directory defined"
 		       (car project))))))
 		       (car project))))))
 	 tmp-pub-dir)
 	 tmp-pub-dir)
@@ -578,7 +595,7 @@ files, when entire projects are published (see
     ;; Allow chain of publishing functions.
     ;; Allow chain of publishing functions.
     (dolist (f publishing-function)
     (dolist (f publishing-function)
       (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
       (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
-	(let ((output (funcall f project-plist filename tmp-pub-dir)))
+	(let ((output (funcall f plist filename tmp-pub-dir)))
 	  (org-publish-update-timestamp filename pub-dir f base-dir)
 	  (org-publish-update-timestamp filename pub-dir f base-dir)
 	  (run-hook-with-args 'org-publish-after-publishing-hook
 	  (run-hook-with-args 'org-publish-after-publishing-hook
 			      filename
 			      filename
@@ -592,124 +609,143 @@ files, when entire projects are published (see
 If `:auto-sitemap' is set, publish the sitemap too.  If
 If `:auto-sitemap' is set, publish the sitemap too.  If
 `:makeindex' is set, also produce a file \"theindex.org\"."
 `:makeindex' is set, also produce a file \"theindex.org\"."
   (dolist (project (org-publish-expand-projects projects))
   (dolist (project (org-publish-expand-projects projects))
-    (let ((project-plist (cdr project)))
-      (let ((fun (plist-get project-plist :preparation-function)))
-	(cond ((consp fun) (dolist (f fun) (funcall f project-plist)))
-	      ((functionp fun) (funcall fun project-plist))))
+    (let ((plist (cdr project)))
+      (let ((fun (org-publish-property :preparation-function project)))
+	(cond
+	 ((consp fun) (dolist (f fun) (funcall f plist)))
+	 ((functionp fun) (funcall fun plist))))
       ;; Each project uses its own cache file.
       ;; Each project uses its own cache file.
       (org-publish-initialize-cache (car project))
       (org-publish-initialize-cache (car project))
-      (when  (plist-get project-plist :auto-sitemap)
+      (when (org-publish-property :auto-sitemap project)
 	(let ((sitemap-filename
 	(let ((sitemap-filename
-	       (or (plist-get project-plist :sitemap-filename)
+	       (or (org-publish-property :sitemap-filename project)
 		   "sitemap.org")))
 		   "sitemap.org")))
 	  (org-publish-sitemap project sitemap-filename)))
 	  (org-publish-sitemap project sitemap-filename)))
       ;; Publish all files from PROJECT excepted "theindex.org".  Its
       ;; Publish all files from PROJECT excepted "theindex.org".  Its
       ;; publishing will be deferred until "theindex.inc" is
       ;; publishing will be deferred until "theindex.inc" is
       ;; populated.
       ;; populated.
-      (let ((theindex
-	     (expand-file-name "theindex.org"
-			       (plist-get project-plist :base-directory))))
+      (let ((theindex (expand-file-name
+		       "theindex.org"
+		       (org-publish-property :base-directory project))))
 	(dolist (file (org-publish-get-base-files project))
 	(dolist (file (org-publish-get-base-files project))
 	  (unless (equal file theindex) (org-publish-file file project t)))
 	  (unless (equal file theindex) (org-publish-file file project t)))
 	;; Populate "theindex.inc", if needed, and publish
 	;; Populate "theindex.inc", if needed, and publish
 	;; "theindex.org".
 	;; "theindex.org".
-	(when (plist-get project-plist :makeindex)
+	(when (org-publish-property :makeindex project)
 	  (org-publish-index-generate-theindex
 	  (org-publish-index-generate-theindex
-	   project (plist-get project-plist :base-directory))
+	   project (org-publish-property :base-directory project))
 	  (org-publish-file theindex project t)))
 	  (org-publish-file theindex project t)))
-      (let ((fun (plist-get project-plist :completion-function)))
-	(cond ((consp fun) (dolist (f fun) (funcall f project-plist)))
-	      ((functionp fun) (funcall fun project-plist))))
-      (org-publish-write-cache-file))))
+      (let ((fun (org-publish-property :completion-function project)))
+	(cond
+	 ((consp fun) (dolist (f fun) (funcall f plist)))
+	 ((functionp fun) (funcall fun plist)))))
+    (org-publish-write-cache-file)))
 
 
-(defun org-publish--sitemap-files-to-lisp (files root style entry-format)
+
+;;; Site map generation
+
+(defun org-publish--sitemap-files-to-lisp (files project style format-entry)
   "Represent FILES as a parsed plain list.
   "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
+FILES is the list of files in the site map.  PROJECT is the
+current project.  STYLE determines is either `list' or `tree'.
+FORMAT-ENTRY is a function called on each file which should
 return a string.  Return value is a list as returned by
 return a string.  Return value is a list as returned by
 `org-list-to-lisp'."
 `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))
-	      (directories (cl-remove-if-not #'directory-name-p files))
-	      (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 site-map style: `%s'" style))))
+  (let ((root (expand-file-name
+	       (file-name-as-directory
+		(org-publish-property :base-directory project)))))
+    (pcase style
+      (`list
+       (cons 'unordered
+	     (mapcar
+	      (lambda (f)
+		(list (funcall format-entry
+			       (file-relative-name f root)
+			       style
+			       project)))
+	      files)))
+      (`tree
+       (letrec ((files-only (cl-remove-if #'directory-name-p files))
+		(directories (cl-remove-if-not #'directory-name-p files))
+		(subtree-to-list
+		 (lambda (dir)
+		   (cons 'unordered
+			 (nconc
+			  ;; Files in DIR.
+			  (mapcar
+			   (lambda (f)
+			     (list (funcall format-entry
+					    (file-relative-name f root)
+					    style
+					    project)))
+			   (cl-remove-if-not
+			    (lambda (f) (string= dir (file-name-directory f)))
+			    files-only))
+			  ;; Direct sub-directories.
+			  (mapcar
+			   (lambda (sub)
+			     (list (funcall format-entry
+					    (file-relative-name sub root)
+					    style
+					    project)
+				   (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 site-map style: `%s'" style)))))
 
 
 (defun org-publish-sitemap (project &optional sitemap-filename)
 (defun org-publish-sitemap (project &optional sitemap-filename)
   "Create a sitemap of pages in set defined by PROJECT.
   "Create a sitemap of pages in set defined by PROJECT.
 Optionally set the filename of the sitemap with SITEMAP-FILENAME.
 Optionally set the filename of the sitemap with SITEMAP-FILENAME.
 Default for SITEMAP-FILENAME is `sitemap.org'."
 Default for SITEMAP-FILENAME is `sitemap.org'."
-  (let* ((project-plist (cdr project))
-	 (root (expand-file-name
+  (let* ((root (expand-file-name
 		(file-name-as-directory
 		(file-name-as-directory
-		 (plist-get project-plist :base-directory))))
+		 (org-publish-property :base-directory project))))
 	 (sitemap-filename (concat root (or sitemap-filename "sitemap.org")))
 	 (sitemap-filename (concat root (or sitemap-filename "sitemap.org")))
-	 (title (or (plist-get project-plist :sitemap-title)
+	 (title (or (org-publish-property :sitemap-title project)
 		    (concat "Sitemap for project " (car project))))
 		    (concat "Sitemap for project " (car project))))
-	 (style (or (plist-get project-plist :sitemap-style) 'tree))
-	 (sitemap-builder (or (plist-get project-plist :sitemap-function)
+	 (style (or (org-publish-property :sitemap-style project)
+		    'tree))
+	 (sitemap-builder (or (org-publish-property :sitemap-function project)
 			      #'org-publish-sitemap-default))
 			      #'org-publish-sitemap-default))
-	 (format-entry (or (plist-get project-plist :sitemap-format-entry)
+	 (format-entry (or (org-publish-property :sitemap-format-entry project)
 			   #'org-publish-sitemap-default-entry))
 			   #'org-publish-sitemap-default-entry))
-	 (sort-folders (if (plist-member project-plist :sitemap-sort-folders)
-			   (plist-get project-plist :sitemap-sort-folders)
-			 org-publish-sitemap-sort-folders))
-	 (sort-files (if (plist-member project-plist :sitemap-sort-files)
-			 (plist-get project-plist :sitemap-sort-files)
-		       org-publish-sitemap-sort-files))
-	 (ignore-case (if (plist-member project-plist :sitemap-ignore-case)
-			  (plist-get project-plist :sitemap-ignore-case)
-			org-publish-sitemap-sort-ignore-case))
+	 (sort-folders
+	  (org-publish-property :sitemap-sort-folders project
+				org-publish-sitemap-sort-folders))
+	 (sort-files
+	  (org-publish-property :sitemap-sort-files project
+				org-publish-sitemap-sort-files))
+	 (ignore-case
+	  (org-publish-property :sitemap-ignore-case project
+				org-publish-sitemap-sort-ignore-case))
+	 (org-file-p (lambda (f) (equal "org" (file-name-extension f))))
 	 (sort-predicate
 	 (sort-predicate
 	  (lambda (a b)
 	  (lambda (a b)
 	    (let ((retval t))
 	    (let ((retval t))
 	      ;; First we sort files:
 	      ;; First we sort files:
 	      (pcase sort-files
 	      (pcase sort-files
 		(`alphabetically
 		(`alphabetically
-		 (let* ((org-file-p
-			 (lambda (f) (equal (file-name-extension f) "org")))
-			(A (if (funcall org-file-p a)
-			       (concat (file-name-directory a)
-				       (org-publish-find-title a))
-			     a))
-			(B (if (funcall org-file-p b)
-			       (concat (file-name-directory b)
-				       (org-publish-find-title b))
-			     b)))
+		 (let ((A (if (funcall org-file-p a)
+			      (concat (file-name-directory a)
+				      (org-publish-find-title a project))
+			    a))
+		       (B (if (funcall org-file-p b)
+			      (concat (file-name-directory b)
+				      (org-publish-find-title b project))
+			    b)))
 		   (setq retval
 		   (setq retval
 			 (if ignore-case
 			 (if ignore-case
 			     (not (string-lessp (upcase B) (upcase A)))
 			     (not (string-lessp (upcase B) (upcase A)))
 			   (not (string-lessp B A))))))
 			   (not (string-lessp B A))))))
 		((or `anti-chronologically `chronologically)
 		((or `anti-chronologically `chronologically)
-		 (let* ((adate (org-publish-find-date a))
-			(bdate (org-publish-find-date b))
+		 (let* ((adate (org-publish-find-date a project))
+			(bdate (org-publish-find-date b project))
 			(A (+ (lsh (car adate) 16) (cadr adate)))
 			(A (+ (lsh (car adate) 16) (cadr adate)))
 			(B (+ (lsh (car bdate) 16) (cadr bdate))))
 			(B (+ (lsh (car bdate) 16) (cadr bdate))))
 		   (setq retval
 		   (setq retval
@@ -745,9 +781,9 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
 	 (funcall sitemap-builder
 	 (funcall sitemap-builder
 		  title
 		  title
 		  (org-publish--sitemap-files-to-lisp
 		  (org-publish--sitemap-files-to-lisp
-		   files root style format-entry)))))))
+		   files project style format-entry)))))))
 
 
-(defun org-publish-find-property (file property &optional backend)
+(defun org-publish-find-property (file property project &optional backend)
   "Find the PROPERTY of FILE in project.
   "Find the PROPERTY of FILE in project.
 
 
 PROPERTY is a keyword referring to an export option, as defined
 PROPERTY is a keyword referring to an export option, as defined
@@ -759,69 +795,73 @@ back-end where the option is defined, e.g.,
 
 
 Return value may be a string or a list, depending on the type of
 Return value may be a string or a list, depending on the type of
 PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'."
 PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'."
-  (when (and (file-readable-p file) (not (directory-name-p file)))
-    (let* ((org-inhibit-startup t)
-	   (visiting (find-buffer-visiting file))
-	   (buffer (or visiting (find-file-noselect file))))
-      (unwind-protect
-	  (plist-get (with-current-buffer buffer
-		       (if (not visiting) (org-export-get-environment backend)
-			 ;; Protect local variables in open buffers.
-			 (org-export-with-buffer-copy
-			  (org-export-get-environment backend))))
-		     property)
-	(unless visiting (kill-buffer buffer))))))
-
-(defun org-publish-find-title (file)
-  "Find the title of FILE in project."
-  (or (org-publish-cache-get-file-property file :title nil t)
-      (let* ((parsed-title (org-publish-find-property file :title))
-	     (title
-	      (if parsed-title
-		  ;; Remove property so that the return value is
-		  ;; cache-able (i.e., it can be `read' back).
-		  (org-no-properties (org-element-interpret-data parsed-title))
-		(file-name-nondirectory (file-name-sans-extension file)))))
-	(org-publish-cache-set-file-property file :title title)
-	title)))
-
-(defun org-publish-find-date (file)
-  "Find the date of FILE in project.
+  (let ((file (org-publish--expand-file-name file project)))
+    (when (and (file-readable-p file) (not (directory-name-p file)))
+      (let* ((org-inhibit-startup t)
+	     (visiting (find-buffer-visiting file))
+	     (buffer (or visiting (find-file-noselect file))))
+	(unwind-protect
+	    (plist-get (with-current-buffer buffer
+			 (if (not visiting) (org-export-get-environment backend)
+			   ;; Protect local variables in open buffers.
+			   (org-export-with-buffer-copy
+			    (org-export-get-environment backend))))
+		       property)
+	  (unless visiting (kill-buffer buffer)))))))
+
+(defun org-publish-find-title (file project)
+  "Find the title of FILE in PROJECT."
+  (let ((file (org-publish--expand-file-name file project)))
+    (or (org-publish-cache-get-file-property file :title nil t)
+	(let* ((parsed-title (org-publish-find-property file :title project))
+	       (title
+		(if parsed-title
+		    ;; Remove property so that the return value is
+		    ;; cache-able (i.e., it can be `read' back).
+		    (org-no-properties
+		     (org-element-interpret-data parsed-title))
+		  (file-name-nondirectory (file-name-sans-extension file)))))
+	  (org-publish-cache-set-file-property file :title title)
+	  title))))
+
+(defun org-publish-find-date (file project)
+  "Find the date of FILE in PROJECT.
 This function assumes FILE is either a directory or an Org file.
 This function assumes FILE is either a directory or an Org file.
 If FILE is an Org file and provides a DATE keyword use it.  In
 If FILE is an Org file and provides a DATE keyword use it.  In
 any other case use the file system's modification time.  Return
 any other case use the file system's modification time.  Return
 time in `current-time' format."
 time in `current-time' format."
-  (if (file-directory-p file) (nth 5 (file-attributes file))
-    (let ((date (org-publish-find-property file :date)))
-      ;; DATE is a secondary string.  If it contains a time-stamp,
-      ;; convert it to internal format.  Otherwise, use FILE
-      ;; modification time.
-      (cond ((let ((ts (and (consp date) (assq 'timestamp date))))
-	       (and ts
-		    (let ((value (org-element-interpret-data ts)))
-		      (and (org-string-nw-p value)
-			   (org-time-string-to-time value))))))
-	    ((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)
+  (let ((file (org-publish--expand-file-name file project)))
+    (if (file-directory-p file) (nth 5 (file-attributes file))
+      (let ((date (org-publish-find-property file :date project)))
+	;; DATE is a secondary string.  If it contains a time-stamp,
+	;; convert it to internal format.  Otherwise, use FILE
+	;; modification time.
+	(cond ((let ((ts (and (consp date) (assq 'timestamp date))))
+		 (and ts
+		      (let ((value (org-element-interpret-data ts)))
+			(and (org-string-nw-p value)
+			     (org-time-string-to-time value))))))
+	      ((file-exists-p file) (nth 5 (file-attributes file)))
+	      (t (error "No such file: \"%s\"" file)))))))
+
+(defun org-publish-sitemap-default-entry (entry style project)
   "Default format for site map ENTRY, as a string.
   "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."
+ENTRY is a file name.  STYLE is the style of the sitemap.
+PROJECT is the current project."
   (cond ((not (directory-name-p entry))
   (cond ((not (directory-name-p entry))
 	 (format "[[file:%s][%s]]"
 	 (format "[[file:%s][%s]]"
-		 (file-relative-name entry root)
-		 (org-publish-find-title entry)))
+		 entry
+		 (org-publish-find-title entry project)))
 	((eq style 'tree)
 	((eq style 'tree)
 	 ;; Return only last subdir.
 	 ;; Return only last subdir.
 	 (file-name-nondirectory (directory-file-name entry)))
 	 (file-name-nondirectory (directory-file-name entry)))
-	(t (file-relative-name entry root))))
+	(t entry)))
 
 
 (defun org-publish-sitemap-default (title list)
 (defun org-publish-sitemap-default (title list)
   "Default site map, as a string.
   "Default site map, as a string.
 TITLE is the the title of the site map.  LIST is an internal
 TITLE is the the title of the site map.  LIST is an internal
 representation for the files to include, as returned by
 representation for the files to include, as returned by
-`org-list-to-lisp'."
+`org-list-to-lisp'.  PROJECT is the current project."
   (concat "#+TITLE: " title "\n\n"
   (concat "#+TITLE: " title "\n\n"
 	  (org-list-to-org list)))
 	  (org-list-to-org list)))
 
 

+ 2 - 4
testing/lisp/test-ox-publish.el

@@ -3,7 +3,6 @@
 ;; Copyright (C) 2016  Nicolas Goaziou
 ;; Copyright (C) 2016  Nicolas Goaziou
 
 
 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
-;; Keywords: local
 
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by
@@ -258,7 +257,7 @@ Unless set otherwise in PROPERTIES, `:base-directory' is set to
 			   :exclude "."
 			   :exclude "."
 			   :include ("a.org")
 			   :include ("a.org")
 			   :sitemap-format-entry
 			   :sitemap-format-entry
-			   (lambda (f d _s) (file-relative-name f d)))
+			   (lambda (f _s _p) f))
 	   (lambda (dir)
 	   (lambda (dir)
 	     (with-temp-buffer
 	     (with-temp-buffer
 	       (insert-file-contents (expand-file-name "sitemap.org" dir))
 	       (insert-file-contents (expand-file-name "sitemap.org" dir))
@@ -269,8 +268,7 @@ Unless set otherwise in PROPERTIES, `:base-directory' is set to
 	   '(:auto-sitemap t
 	   '(:auto-sitemap t
 			   :exclude "."
 			   :exclude "."
 			   :include ("a.org")
 			   :include ("a.org")
-			   :sitemap-function
-			   (lambda (title _files) "Custom!"))
+			   :sitemap-function (lambda (title _files) "Custom!"))
 	   (lambda (dir)
 	   (lambda (dir)
 	     (with-temp-buffer
 	     (with-temp-buffer
 	       (insert-file-contents (expand-file-name "sitemap.org" dir))
 	       (insert-file-contents (expand-file-name "sitemap.org" dir))