ox-publish: Include directories in site-map

* lisp/ox-publish.el (org-publish-temp-files): Remove variable.
(org-publish-get-base-files-1):
(org-publish-compare-directory-files): Remove functions.
(org-publish-get-base-files): Remove optional argument.  Rewrite
function.
(org-publish-projects):
(org-publish-sitemap):
(org-publish-index-generate-theindex): Apply signature change.
(org-publish-sitemap-sort-folders): Allow to include or ignore
directories in the site-map.

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

doc/org.texi

@@ -14551,8 +14551,10 @@ 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}
-(default) or @code{last} to display folders first or last,
-respectively.  Any other value will mix files and folders.
+(default) or @code{last} to display folders first or last, respectively.
+When set to @code{ignore}, folders are ignored altogether.  Any other value
+will mix files and folders.  This variable has no effect when site-map style
+is @code{tree}.
 
 @item @code{:sitemap-sort-files}
 @tab How the files are sorted in the site map.  Set this to

etc/ORG-NEWS

@@ -38,6 +38,11 @@ list as their first argument.
 **** New variable : ~org-agenda-show-future-repeats~
 **** New variable : ~org-agenda-prefer-last-repeat~
 
+*** New value for ~org-publish-sitemap-sort-folders~
+
+The new ~ignore~ value effectively allows toggling inclusion of
+directories in published site-maps.
+
 *** Babel
 
 **** Clojure: new setting ~org-babel-clojure-sync-nrepl-timeout~

lisp/org-compat.el

@@ -44,9 +44,8 @@
 (defvar org-table-tab-recognizes-table.el)
 (defvar org-table1-hline-regexp)
 
-;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-'
-;; prefix, `find-tag' is replaced with `xref-find-definition' and
-;; `x-get-selection' with `gui-get-selection'.
+;;; Emacs < 25.1 compatibility
+
 (when (< emacs-major-version 25)
   (defalias 'outline-hide-entry 'hide-entry)
   (defalias 'outline-hide-sublevels 'hide-sublevels)
@@ -58,7 +57,38 @@
   (defalias 'outline-show-subtree 'show-subtree)
   (defalias 'xref-find-definitions 'find-tag)
   (defalias 'format-message 'format)
-  (defalias 'gui-get-selection 'x-get-selection))
+  (defalias 'gui-get-selection 'x-get-selection)
+
+  ;; From "files.el"
+  (defun directory-files-recursively (dir regexp &optional include-directories)
+    "Return list of all files under DIR that have file names matching REGEXP.
+This function works recursively.  Files are returned in \"depth first\"
+order, and files from each directory are sorted in alphabetical order.
+Each file name appears in the returned list in its absolute form.
+Optional argument INCLUDE-DIRECTORIES non-nil means also include in the
+output directories whose names match REGEXP."
+    (let ((result nil)
+	  (files nil)
+	  ;; When DIR is "/", remote file names like "/method:" could
+	  ;; also be offered.  We shall suppress them.
+	  (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
+      (dolist (file (sort (file-name-all-completions "" dir)
+			  'string<))
+	(unless (member file '("./" "../"))
+	  (if (directory-name-p file)
+	      (let* ((leaf (substring file 0 (1- (length file))))
+		     (full-file (expand-file-name leaf dir)))
+		;; Don't follow symlinks to other directories.
+		(unless (file-symlink-p full-file)
+		  (setq result
+			(nconc result (directory-files-recursively
+				       full-file regexp include-directories))))
+		(when (and include-directories
+			   (string-match regexp leaf))
+		  (setq result (nconc result (list full-file)))))
+	    (when (string-match regexp file)
+	      (push (expand-file-name file dir) files)))))
+      (nconc result (nreverse files)))))
 
   ;; From "files.el"
   (defsubst directory-name-p (name)

lisp/ox-publish.el

@@ -46,9 +46,6 @@
 
 ;;; Variables
 
-(defvar org-publish-temp-files nil
-  "Temporary list of files to be published.")
-
 ;; Here, so you find the variable right before it's used the first time:
 (defvar org-publish-cache nil
   "This will cache timestamps and titles for files in publishing projects.
@@ -255,8 +252,11 @@ If you create a site-map file, adjust the sorting like this:
   `:sitemap-sort-folders'
 
     Where folders should appear in the site-map.  Set this to
-    `first' (default) or `last' to display folders first or last,
-    respectively.  Any other value will mix files and folders.
+    `first' or `last' to display folders first or last,
+    respectively.  When set to `ignore' (default), folders are
+    ignored altogether.  Any other value will mix files and
+    folders.  This variable has no effect when site-map style is
+    `tree'.
 
   `:sitemap-sort-files'
 
@@ -318,17 +318,28 @@ You can overwrite this default per project in your
   :group 'org-export-publish
   :type 'symbol)
 
-(defcustom org-publish-sitemap-sort-folders 'first
-  "A symbol, denoting if folders are sorted first in sitemaps.
-Possible values are `first', `last', and nil.
+(defcustom org-publish-sitemap-sort-folders 'ignore
+  "A symbol, denoting if folders are sorted first in site-maps.
+
+Possible values are `first', `last', `ignore' and nil.
 If `first', folders will be sorted before files.
 If `last', folders are sorted to the end after the files.
-Any other value will not mix files and folders.
+If `ignore', folders do not appear in the site-map.
+Any other value will mix files and folders.
 
 You can overwrite this default per project in your
-`org-publish-project-alist', using `:sitemap-sort-folders'."
+`org-publish-project-alist', using `:sitemap-sort-folders'.
+
+This variable is ignored when site-map style is `tree'."
   :group 'org-export-publish
-  :type 'symbol)
+  :type '(choice
+	  (const :tag "Folders before files" first)
+	  (const :tag "Folders after files" last)
+	  (const :tag "No folder in site-map" ignore)
+	  (const :tag "Mix folders and files" nil))
+  :version "25.2"
+  :package-version '(Org . "9.1")
+  :safe #'symbolp)
 
 (defcustom org-publish-sitemap-sort-ignore-case nil
   "Non-nil when site-map sorting should ignore case.
@@ -405,131 +416,41 @@ This splices all the components into the list."
 	(push p rtn)))
     (nreverse (delete-dups (delq nil rtn)))))
 
-(defvar org-publish-sitemap-sort-files)
-(defvar org-publish-sitemap-sort-folders)
-(defvar org-publish-sitemap-ignore-case)
-(defvar org-publish-sitemap-requested)
-(defvar org-publish-sitemap-date-format)
-(defun org-publish-compare-directory-files (a b)
-  "Predicate for `sort', that sorts folders and files for sitemap."
-  (let ((retval t))
-    (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
-      ;; First we sort files:
-      (when org-publish-sitemap-sort-files
-	(pcase org-publish-sitemap-sort-files
-	  (`alphabetically
-	   (let* ((adir (file-directory-p a))
-		  (aorg (and (string-suffix-p ".org" a) (not adir)))
-		  (bdir (file-directory-p b))
-		  (borg (and (string-suffix-p ".org" b) (not bdir)))
-		  (A (if aorg (concat (file-name-directory a)
-				      (org-publish-find-title a)) a))
-		  (B (if borg (concat (file-name-directory b)
-				      (org-publish-find-title b)) b)))
-	     (setq retval (if org-publish-sitemap-ignore-case
-			      (not (string-lessp (upcase B) (upcase A)))
-			    (not (string-lessp B A))))))
-	  ((or `anti-chronologically `chronologically)
-	   (let* ((adate (org-publish-find-date a))
-		  (bdate (org-publish-find-date b))
-		  (A (+ (lsh (car adate) 16) (cadr adate)))
-		  (B (+ (lsh (car bdate) 16) (cadr bdate))))
-	     (setq retval
-		   (if (eq org-publish-sitemap-sort-files 'chronologically)
-		       (<= A B)
-		     (>= A B)))))))
-      ;; Directory-wise wins:
-      (when org-publish-sitemap-sort-folders
-        ;; a is directory, b not:
-        (cond
-         ((and (file-directory-p a) (not (file-directory-p b)))
-          (setq retval (eq org-publish-sitemap-sort-folders 'first)))
-	 ;; a is not a directory, but b is:
-         ((and (not (file-directory-p a)) (file-directory-p b))
-          (setq retval (eq org-publish-sitemap-sort-folders 'last))))))
-    retval))
-
-(defun org-publish-get-base-files-1
-    (base-dir &optional recurse match skip-file skip-dir)
-  "Set `org-publish-temp-files' with files from BASE-DIR directory.
-If RECURSE is non-nil, check BASE-DIR recursively.  If MATCH is
-non-nil, restrict this list to the files matching the regexp
-MATCH.  If SKIP-FILE is non-nil, skip file matching the regexp
-SKIP-FILE.  If SKIP-DIR is non-nil, don't check directories
-matching the regexp SKIP-DIR when recursing through BASE-DIR."
-  (let ((all-files (if (not recurse) (directory-files base-dir t match)
-		     ;; If RECURSE is non-nil, we want all files
-		     ;; matching MATCH and sub-directories.
-		     (cl-remove-if-not
-		      (lambda (file)
-			(or (file-directory-p file)
-			    (and match (string-match match file))))
-		      (directory-files base-dir t)))))
-    (dolist (f (if (not org-publish-sitemap-requested) all-files
-		 (sort all-files #'org-publish-compare-directory-files)))
-      (let ((fd-p (file-directory-p f))
-	    (fnd (file-name-nondirectory f)))
-	(if (and fd-p recurse
-		 (not (string-match "^\\.+$" fnd))
-		 (if skip-dir (not (string-match skip-dir fnd)) t))
-	    (org-publish-get-base-files-1
-	     f recurse match skip-file skip-dir)
-	  (unless (or fd-p		; This is a directory.
-		      (and skip-file (string-match skip-file fnd))
-		      (not (file-exists-p (file-truename f)))
-		      (not (string-match match fnd)))
-	    (cl-pushnew f org-publish-temp-files)))))))
-
-(defun org-publish-get-base-files (project &optional exclude-regexp)
-  "Return a list of all files in PROJECT.
-If EXCLUDE-REGEXP is set, this will be used to filter out
-matching filenames."
+(defun org-publish-get-base-files (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)))
-	 (include-list (plist-get project-plist :include))
-	 (recurse (plist-get project-plist :recursive))
 	 (extension (or (plist-get project-plist :base-extension) "org"))
-	 ;; sitemap-... variables are dynamically scoped for
-	 ;; org-publish-compare-directory-files:
-	 (org-publish-sitemap-requested
-	  (plist-get project-plist :auto-sitemap))
-	 (sitemap-filename
-	  (or (plist-get project-plist :sitemap-filename) "sitemap.org"))
-	 (org-publish-sitemap-sort-folders
-	  (if (plist-member project-plist :sitemap-sort-folders)
-	      (plist-get project-plist :sitemap-sort-folders)
-	    org-publish-sitemap-sort-folders))
-	 (org-publish-sitemap-sort-files
-	  (cond ((plist-member project-plist :sitemap-sort-files)
-		 (plist-get project-plist :sitemap-sort-files))
-		;; For backward compatibility:
-		((plist-member project-plist :sitemap-alphabetically)
-		 (if (plist-get project-plist :sitemap-alphabetically)
-		     'alphabetically nil))
-		(t org-publish-sitemap-sort-files)))
-	 (org-publish-sitemap-ignore-case
-	  (if (plist-member project-plist :sitemap-ignore-case)
-	      (plist-get project-plist :sitemap-ignore-case)
-	    org-publish-sitemap-sort-ignore-case))
 	 (match (if (eq extension 'any) "^[^\\.]"
-		  (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
-    ;; Make sure `org-publish-sitemap-sort-folders' has an accepted
-    ;; value.
-    (unless (memq org-publish-sitemap-sort-folders '(first last))
-      (setq org-publish-sitemap-sort-folders nil))
-
-    (setq org-publish-temp-files nil)
-    (when org-publish-sitemap-requested
-      (cl-pushnew (expand-file-name (concat base-dir sitemap-filename))
-		  org-publish-temp-files))
-    (org-publish-get-base-files-1 base-dir recurse match
-				  ;; FIXME distinguish exclude regexp
-				  ;; for skip-file and skip-dir?
-				  exclude-regexp exclude-regexp)
-    (dolist (f include-list org-publish-temp-files)
-      (cl-pushnew (expand-file-name (concat base-dir f))
-		  org-publish-temp-files))))
+		  (concat "^[^\\.].*\\.\\(" extension "\\)$")))
+	 (base-files
+	  (if (not (plist-get project-plist :recursive))
+	      (directory-files base-dir t match t)
+	    (directory-files-recursively base-dir match))))
+    (org-uniquify
+     (append
+      ;; Files from BASE-DIR.  Apply exclusion filter before adding
+      ;; included files.
+      (let ((exclude-regexp (plist-get project-plist :exclude)))
+	(if exclude-regexp
+	    (cl-remove-if
+	     (lambda (f)
+	       ;; Match against relative names, yet BASE-DIR file
+	       ;; names are absolute.
+	       (string-match exclude-regexp
+			     (file-relative-name f base-dir)))
+	     base-files)
+	  base-files))
+      ;; Sitemap file.
+      (and (plist-get project-plist :auto-sitemap)
+	   (list (expand-file-name
+		  (or (plist-get project-plist :sitemap-filename)
+		      "sitemap.org")
+		  base-dir)))
+      ;; Included files.
+      (mapcar (lambda (f) (expand-file-name f base-dir))
+	      (plist-get project-plist :include))))))
 
 (defun org-publish-get-project-from-filename (filename &optional up)
   "Return the project that FILENAME belongs to."
@@ -702,9 +623,8 @@ If `:auto-sitemap' is set, publish the sitemap too.  If
       ;; populated.
       (let ((theindex
 	     (expand-file-name "theindex.org"
-			       (plist-get project-plist :base-directory)))
-	    (exclude-regexp (plist-get project-plist :exclude)))
-	(dolist (file (org-publish-get-base-files project exclude-regexp))
+			       (plist-get project-plist :base-directory))))
+	(dolist (file (org-publish-get-base-files project))
 	  (unless (equal file theindex) (org-publish-file file project t)))
 	;; Populate "theindex.inc", if needed, and publish
 	;; "theindex.org".
@@ -731,11 +651,7 @@ return a string.  Return value is a list as returned by
 		   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)))
+	      (directories (cl-remove-if-not #'directory-name-p files))
 	      (subtree-to-list
 	       (lambda (dir)
 		 (cons 'unordered
@@ -759,7 +675,7 @@ return a string.  Return value is a list as returned by
 			     (file-name-directory (directory-file-name f))))
 			  directories)))))))
        (funcall subtree-to-list root)))
-    (_ (user-error "Unknown sitemap style: `%s'" style))))
+    (_ (user-error "Unknown site-map style: `%s'" style))))
 
 (defun org-publish-sitemap (project &optional sitemap-filename)
   "Create a sitemap of pages in set defined by PROJECT.
@@ -776,15 +692,74 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
 	 (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)))
+			   #'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-predicate
+	  (lambda (a b)
+	    (let ((retval t))
+	      ;; First we sort files:
+	      (pcase sort-files
+		(`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)))
+		   (setq retval
+			 (if ignore-case
+			     (not (string-lessp (upcase B) (upcase A)))
+			   (not (string-lessp B A))))))
+		((or `anti-chronologically `chronologically)
+		 (let* ((adate (org-publish-find-date a))
+			(bdate (org-publish-find-date b))
+			(A (+ (lsh (car adate) 16) (cadr adate)))
+			(B (+ (lsh (car bdate) 16) (cadr bdate))))
+		   (setq retval
+			 (if (eq sort-files 'chronologically)
+			     (<= A B)
+			   (>= A B)))))
+		(`nil nil)
+		(_ (user-error "Invalid sort value %s" sort-files)))
+	      ;; Directory-wise wins:
+	      (when (memq sort-folders '(first last))
+		;; a is directory, b not:
+		(cond
+		 ((and (file-directory-p a) (not (file-directory-p b)))
+		  (setq retval (eq sort-folders 'first)))
+		 ;; a is not a directory, but b is:
+		 ((and (not (file-directory-p a)) (file-directory-p b))
+		  (setq retval (eq sort-folders 'last)))))
+	      retval))))
     (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)))))
+			    (org-publish-get-base-files project))))
+	 ;; Remove extensions, if requested.
 	 (when (plist-get project-plist :sitemap-sans-extension)
 	   (setq files (mapcar #'file-name-sans-extension files)))
+	 ;; Add directories, if applicable.
+	 (unless (and (eq style 'list) (eq sort-folders 'ignore))
+	   (setq files
+		 (nconc (remove root (org-uniquify
+				      (mapcar #'file-name-directory files)))
+			files)))
+	 ;; Eventually sort all entries.
+	 (when (or sort-files (not (memq sort-folders 'ignore)))
+	   (setq files (sort files sort-predicate)))
 	 (funcall sitemap-builder
 		  title
 		  (org-publish--sitemap-files-to-lisp
@@ -1010,8 +985,7 @@ its CDR is a string."
   "Retrieve full index from cache and build \"theindex.org\".
 PROJECT is the project the index relates to.  DIRECTORY is the
 publishing directory."
-  (let ((all-files (org-publish-get-base-files
-		    project (plist-get (cdr project) :exclude)))
+  (let ((all-files (org-publish-get-base-files project))
 	full-index)
     ;; Compile full index and sort it alphabetically.
     (dolist (file all-files