Function: org-publish-sitemap

org-publish-sitemap is a byte-compiled function defined in ox-publish.el.gz.

Signature

(org-publish-sitemap PROJECT &optional SITEMAP-FILENAME)

Documentation

Create a sitemap of pages in set defined by PROJECT.

Optionally set the filename of the sitemap with SITEMAP-FILENAME. Default for SITEMAP-FILENAME is sitemap.org.

Source Code

;; Defined in /usr/src/emacs/lisp/org/ox-publish.el.gz
(defun org-publish-sitemap (project &optional sitemap-filename)
  "Create a sitemap of pages in set defined by PROJECT.
Optionally set the filename of the sitemap with SITEMAP-FILENAME.
Default for SITEMAP-FILENAME is `sitemap.org'."
  (let* ((root (expand-file-name
		(file-name-as-directory
		 (org-publish-property :base-directory project))))
	 (sitemap-filename (expand-file-name (or sitemap-filename "sitemap.org")
					     root))
	 (title (or (org-publish-property :sitemap-title project)
		    (concat "Sitemap for project " (car project))))
	 (style (or (org-publish-property :sitemap-style project)
		    'tree))
	 (sitemap-builder (or (org-publish-property :sitemap-function project)
			      #'org-publish-sitemap-default))
	 (format-entry (or (org-publish-property :sitemap-format-entry project)
			   #'org-publish-sitemap-default-entry))
	 (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
	  (lambda (a b)
	    (let ((retval t))
	      ;; First we sort files:
	      (pcase sort-files
		(`alphabetically
		 (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 (org-string<= A B nil ignore-case))))
		((or `anti-chronologically `chronologically)
		 (let* ((adate (org-publish-find-date a project))
			(bdate (org-publish-find-date b project)))
		   (setq retval
			 (not (if (eq sort-files 'chronologically)
				(time-less-p bdate adate)
			      (time-less-p adate bdate))))))
		(`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))))
	 ;; 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
		   files project style format-entry)))))))