tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

org-publish: delete .orgx and temporary buffers. 

Also add the org- prefix to some variable.

* org-publish.el (org-publish-find-title): bugfix: kill
buffers unless they were already visited.
(org-sitemap-sort-files, org-sitemap-sort-folders)
(org-sitemap-ignore-case, org-sitemap-requested)
(org-sitemap-date-format, org-sitemap-file-entry-format): use
a correct prefix.
(org-publish-projects): Make sure to delete .orgx files.
(org-publish-index-generate-theindex.inc): Small docstring
fix.
This commit is contained in:
Bastien Guerry 2011-07-27 14:36:54 +02:00
parent 066665e029
commit 2610bfd052
1 changed files with 90 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

171
lisp/org-publish.el
View File

@ -41,16 +41,6 @@
;;; Code: ;;; Code:
(defun org-publish-sanitize-plist (plist)
(mapcar (lambda (x)
(or (cdr (assq x '((:index-filename . :sitemap-filename)
(:index-title . :sitemap-title)
(:index-function . :sitemap-function)
(:index-style . :sitemap-style)
(:auto-index . :auto-sitemap))))
x))
plist))
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
(require 'org) (require 'org)
@ -61,6 +51,17 @@
(unless (fboundp 'declare-function) (unless (fboundp 'declare-function)
(defmacro declare-function (fn file &optional arglist fileonly)))) (defmacro declare-function (fn file &optional arglist fileonly))))
(defvar org-publish-initial-buffer nil
"The buffer `org-publish' has been called from.")
(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.
Blocks could hash sha1 values here.")
(defgroup org-publish nil (defgroup org-publish nil
"Options for publishing a set of Org-mode and related files." "Options for publishing a set of Org-mode and related files."
:tag "Org Publishing" :tag "Org Publishing"
@ -287,6 +288,21 @@ You could use brackets to delimit on what part the link will be.
:group 'org-publish :group 'org-publish
:type 'string) :type 'string)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sanitize-plist (FIXME why?)
(defun org-publish-sanitize-plist (plist)
;; FIXME document
(mapcar (lambda (x)
(or (cdr (assq x '((:index-filename . :sitemap-filename)
(:index-title . :sitemap-title)
(:index-function . :sitemap-function)
(:index-style . :sitemap-style)
(:auto-index . :auto-sitemap))))
x))
plist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Timestamp-related functions ;;; Timestamp-related functions
@ -332,20 +348,6 @@ If there is no timestamp, create one."
(org-publish-reset-cache)))) (org-publish-reset-cache))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
(defvar org-publish-initial-buffer nil
"The buffer `org-publish' has been called from.")
(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.
Blocks could hash sha1 values here.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compatibility aliases ;;; Compatibility aliases
@ -387,20 +389,19 @@ This splices all the components into the list."
(push p rtn))) (push p rtn)))
(nreverse (org-publish-delete-dups (delq nil rtn))))) (nreverse (org-publish-delete-dups (delq nil rtn)))))
(defvar org-sitemap-sort-files)
(defvar sitemap-sort-files) (defvar org-sitemap-sort-folders)
(defvar sitemap-sort-folders) (defvar org-sitemap-ignore-case)
(defvar sitemap-ignore-case) (defvar org-sitemap-requested)
(defvar sitemap-requested) (defvar org-sitemap-date-format)
(defvar sitemap-date-format) (defvar org-sitemap-file-entry-format)
(defvar sitemap-file-entry-format)
(defun org-publish-compare-directory-files (a b) (defun org-publish-compare-directory-files (a b)
"Predicate for `sort', that sorts folders and files for sitemap." "Predicate for `sort', that sorts folders and files for sitemap."
(let ((retval t)) (let ((retval t))
(when (or sitemap-sort-files sitemap-sort-folders) (when (or org-sitemap-sort-files org-sitemap-sort-folders)
;; First we sort files: ;; First we sort files:
(when sitemap-sort-files (when org-sitemap-sort-files
(cond ((equal sitemap-sort-files 'alphabetically) (cond ((equal org-sitemap-sort-files 'alphabetically)
(let* ((adir (file-directory-p a)) (let* ((adir (file-directory-p a))
(aorg (and (string-match "\\.org$" a) (not adir))) (aorg (and (string-match "\\.org$" a) (not adir)))
(bdir (file-directory-p b)) (bdir (file-directory-p b))
@ -411,27 +412,27 @@ This splices all the components into the list."
(B (if borg (B (if borg
(concat (file-name-directory b) (concat (file-name-directory b)
(org-publish-find-title b)) b))) (org-publish-find-title b)) b)))
(setq retval (if sitemap-ignore-case (setq retval (if org-sitemap-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 (equal sitemap-sort-files 'chronologically) ((or (equal org-sitemap-sort-files 'chronologically)
(equal sitemap-sort-files 'anti-chronologically)) (equal org-sitemap-sort-files 'anti-chronologically))
(let* ((adate (org-publish-find-date a)) (let* ((adate (org-publish-find-date a))
(bdate (org-publish-find-date b)) (bdate (org-publish-find-date b))
(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 (if (equal sitemap-sort-files 'chronologically) (setq retval (if (equal org-sitemap-sort-files 'chronologically)
(<= A B) (<= A B)
(>= A B))))))) (>= A B)))))))
;; Directory-wise wins: ;; Directory-wise wins:
(when sitemap-sort-folders (when org-sitemap-sort-folders
;; a is directory, b not: ;; a is directory, b not:
(cond (cond
((and (file-directory-p a) (not (file-directory-p b))) ((and (file-directory-p a) (not (file-directory-p b)))
(setq retval (equal sitemap-sort-folders 'first))) (setq retval (equal org-sitemap-sort-folders 'first)))
;; a is not a directory, but b is: ;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b)) ((and (not (file-directory-p a)) (file-directory-p b))
(setq retval (equal sitemap-sort-folders 'last)))))) (setq retval (equal org-sitemap-sort-folders 'last))))))
retval)) retval))
(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir) (defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir)
@ -454,7 +455,7 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR."
(not (string-match match fnd))) (not (string-match match fnd)))
(pushnew f org-publish-temp-files))))) (pushnew f org-publish-temp-files)))))
(if sitemap-requested (if org-sitemap-requested
(sort (directory-files base-dir t (unless recurse match)) (sort (directory-files base-dir t (unless recurse match))
'org-publish-compare-directory-files) 'org-publish-compare-directory-files)
(directory-files base-dir t (unless recurse match))))) (directory-files base-dir t (unless recurse match)))))
@ -471,16 +472,16 @@ matching filenames."
(extension (or (plist-get project-plist :base-extension) "org")) (extension (or (plist-get project-plist :base-extension) "org"))
;; sitemap-... variables are dynamically scoped for ;; sitemap-... variables are dynamically scoped for
;; org-publish-compare-directory-files: ;; org-publish-compare-directory-files:
(sitemap-requested (org-sitemap-requested
(plist-get project-plist :auto-sitemap)) (plist-get project-plist :auto-sitemap))
(sitemap-filename (sitemap-filename
(or (plist-get project-plist :sitemap-filename) (or (plist-get project-plist :sitemap-filename)
"sitemap.org")) "sitemap.org"))
(sitemap-sort-folders (org-sitemap-sort-folders
(if (plist-member project-plist :sitemap-sort-folders) (if (plist-member project-plist :sitemap-sort-folders)
(plist-get project-plist :sitemap-sort-folders) (plist-get project-plist :sitemap-sort-folders)
org-publish-sitemap-sort-folders)) org-publish-sitemap-sort-folders))
(sitemap-sort-files (org-sitemap-sort-files
(cond ((plist-member project-plist :sitemap-sort-files) (cond ((plist-member project-plist :sitemap-sort-files)
(plist-get project-plist :sitemap-sort-files)) (plist-get project-plist :sitemap-sort-files))
;; For backward compatibility: ;; For backward compatibility:
@ -488,19 +489,19 @@ matching filenames."
(if (plist-get project-plist :sitemap-alphabetically) (if (plist-get project-plist :sitemap-alphabetically)
'alphabetically nil)) 'alphabetically nil))
(t org-publish-sitemap-sort-files))) (t org-publish-sitemap-sort-files)))
(sitemap-ignore-case (org-sitemap-ignore-case
(if (plist-member project-plist :sitemap-ignore-case) (if (plist-member project-plist :sitemap-ignore-case)
(plist-get project-plist :sitemap-ignore-case) (plist-get project-plist :sitemap-ignore-case)
org-publish-sitemap-sort-ignore-case)) org-publish-sitemap-sort-ignore-case))
(match (if (eq extension 'any) (match (if (eq extension 'any)
"^[^\\.]" "^[^\\.]"
(concat "^[^\\.].*\\.\\(" extension "\\)$")))) (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
;; Make sure sitemap-sort-folders' has an accepted value ;; Make sure `org-sitemap-sort-folders' has an accepted value
(unless (memq sitemap-sort-folders '(first last)) (unless (memq org-sitemap-sort-folders '(first last))
(setq sitemap-sort-folders nil)) (setq org-sitemap-sort-folders nil))
(setq org-publish-temp-files nil) (setq org-publish-temp-files nil)
(if sitemap-requested (if org-sitemap-requested
(pushnew (expand-file-name (concat base-dir sitemap-filename)) (pushnew (expand-file-name (concat base-dir sitemap-filename))
org-publish-temp-files)) org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match (org-publish-get-base-files-1 base-dir recurse match
@ -648,10 +649,10 @@ See `org-publish-org-to' to the list of arguments."
"Publish a file with no transformation of any kind. "Publish a file with no transformation of any kind.
See `org-publish-org-to' to the list of arguments." See `org-publish-org-to' to the list of arguments."
;; make sure eshell/cp code is loaded ;; make sure eshell/cp code is loaded
(unless (file-directory-p pub-dir) (unless (file-directory-p pub-dir)
(make-directory pub-dir t)) (make-directory pub-dir t))
(or (equal (expand-file-name (file-name-directory filename)) (or (equal (expand-file-name (file-name-directory filename))
(file-name-as-directory (expand-file-name pub-dir))) (file-name-as-directory (expand-file-name pub-dir)))
(copy-file filename (copy-file filename
(expand-file-name (file-name-nondirectory filename) pub-dir) (expand-file-name (file-name-nondirectory filename) pub-dir)
t))) t)))
@ -727,9 +728,9 @@ If :makeindex is set, also produce a file theindex.org."
"sitemap.org")) "sitemap.org"))
(sitemap-function (or (plist-get project-plist :sitemap-function) (sitemap-function (or (plist-get project-plist :sitemap-function)
'org-publish-org-sitemap)) 'org-publish-org-sitemap))
(sitemap-date-format (or (plist-get project-plist :sitemap-date-format) (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
org-publish-sitemap-date-format)) org-publish-sitemap-date-format))
(sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
org-publish-sitemap-file-entry-format)) org-publish-sitemap-file-entry-format))
(preparation-function (plist-get project-plist :preparation-function)) (preparation-function (plist-get project-plist :preparation-function))
(completion-function (plist-get project-plist :completion-function)) (completion-function (plist-get project-plist :completion-function))
@ -740,11 +741,13 @@ If :makeindex is set, also produce a file theindex.org."
(org-publish-file file project t)) (org-publish-file file project t))
(when (plist-get project-plist :makeindex) (when (plist-get project-plist :makeindex)
(org-publish-index-generate-theindex.inc (org-publish-index-generate-theindex.inc
(plist-get project-plist :base-directory)) ;; (or org-publish-orgx-directory
(plist-get project-plist :base-directory)); )
(org-publish-file (expand-file-name (org-publish-file (expand-file-name
"theindex.org" "theindex.org"
(plist-get project-plist :base-directory)) (plist-get project-plist :base-directory))
project t)) project t)
(delete-file (expand-file-name "theindex.orgx")))
(when completion-function (run-hooks 'completion-function)) (when completion-function (run-hooks 'completion-function))
(org-publish-write-cache-file))) (org-publish-write-cache-file)))
(org-publish-expand-projects projects))) (org-publish-expand-projects projects)))
@ -810,7 +813,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(+ (length indent-str) 2) ?\ ))))))) (+ (length indent-str) 2) ?\ )))))))
;; This is common to 'flat and 'tree ;; This is common to 'flat and 'tree
(let ((entry (let ((entry
(org-publish-format-file-entry sitemap-file-entry-format (org-publish-format-file-entry org-sitemap-file-entry-format
file project-plist)) file project-plist))
(regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
(cond ((string-match-p regexp entry) (cond ((string-match-p regexp entry)
@ -829,7 +832,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(defun org-publish-format-file-entry (fmt file project-plist) (defun org-publish-format-file-entry (fmt file project-plist)
(format-spec fmt (format-spec fmt
`((?t . ,(org-publish-find-title file t)) `((?t . ,(org-publish-find-title file t))
(?d . ,(format-time-string sitemap-date-format (?d . ,(format-time-string org-sitemap-date-format
(org-publish-find-date file))) (org-publish-find-date file)))
(?a . ,(or (plist-get project-plist :author) user-full-name))))) (?a . ,(or (plist-get project-plist :author) user-full-name)))))
@ -838,21 +841,21 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(or (or
(and (not reset) (org-publish-cache-get-file-property file :title nil t)) (and (not reset) (org-publish-cache-get-file-property file :title nil t))
(let* ((visiting (find-buffer-visiting file)) (let* ((visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file))) (buffer (or visiting (find-file-noselect file)))
title) title)
(with-current-buffer buffer (with-current-buffer buffer
(let* ((opt-plist (org-combine-plists (org-default-export-plist) (let* ((opt-plist (org-combine-plists (org-default-export-plist)
(org-infile-export-plist)))) (org-infile-export-plist))))
(setq title (setq title
(or (plist-get opt-plist :title) (or (plist-get opt-plist :title)
(and (not (and (not
(plist-get opt-plist :skip-before-1st-heading)) (plist-get opt-plist :skip-before-1st-heading))
(org-export-grab-title-from-buffer)) (org-export-grab-title-from-buffer))
(file-name-nondirectory (file-name-sans-extension file)))))) (file-name-nondirectory (file-name-sans-extension file))))))
(unless visiting (unless visiting
(kill-buffer buffer)) (kill-buffer buffer))
(org-publish-cache-set-file-property file :title title) (org-publish-cache-set-file-property file :title title)
title))) title)))
(defun org-publish-find-date (file) (defun org-publish-find-date (file)
"Find the date of FILE in project. "Find the date of FILE in project.
@ -966,7 +969,7 @@ the project."
(insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry))))))) (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry)))))))
(defun org-publish-index-generate-theindex.inc (directory) (defun org-publish-index-generate-theindex.inc (directory)
"Generate the index from all .orgx files in the current directory and below." "Generate the index from all .orgx files in DIRECTORY."
(require 'find-lisp) (require 'find-lisp)
(let* ((fulldir (file-name-as-directory (let* ((fulldir (file-name-as-directory
(expand-file-name directory))) (expand-file-name directory)))
@ -990,6 +993,8 @@ the project."
entry (match-string 2)) entry (match-string 2))
(push (list entry origfile target) index))) (push (list entry origfile target) index)))
(kill-buffer buf)) (kill-buffer buf))
;; delete .orgx files from current directory:
(mapc 'delete-file full-files)
(setq index (sort index (lambda (a b) (string< (downcase (car a)) (setq index (sort index (lambda (a b) (string< (downcase (car a))
(downcase (car b)))))) (downcase (car b))))))
(setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory))) (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory)))
@ -1105,15 +1110,19 @@ so that the file including them will be republished as well."
(error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present")) (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present"))
(let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
(pstamp (org-publish-cache-get key)) (pstamp (org-publish-cache-get key))
included-files-ctime) (visiting (find-buffer-visiting filename))
(with-temp-buffer included-files-ctime buf)
(when (equal (file-name-extension filename) "org")
(find-file (expand-file-name filename)) (when (equal (file-name-extension filename) "org")
(setq buf (find-file (expand-file-name filename)))
(with-current-buffer buf
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^#\\+INCLUDE:[ \t]+\"?\\([^ \t\"]*\\)\"?[ \t]*.*$" nil t) (while (re-search-forward "^#\\+INCLUDE:[ \t]+\"?\\([^ \t\"]*\\)\"?[ \t]*.*$" nil t)
(let* ((included-file (expand-file-name (match-string 1)))) (let* ((included-file (expand-file-name (match-string 1))))
(add-to-list 'included-files-ctime (add-to-list 'included-files-ctime
(org-publish-cache-ctime-of-src included-file) t))))) (org-publish-cache-ctime-of-src included-file) t))))
;; FIXME don't kill current buffer
(unless visiting (kill-buffer buf)))
(if (null pstamp) (if (null pstamp)
t t
(let ((ctime (org-publish-cache-ctime-of-src filename))) (let ((ctime (org-publish-cache-ctime-of-src filename)))