* Org-publish-cache - speed up publishing
@ 2010-05-04 23:43 Sebastian Rose
2010-05-05 16:04 ` Sebastian Rose
0 siblings, 1 reply; 3+ messages in thread
From: Sebastian Rose @ 2010-05-04 23:43 UTC (permalink / raw)
To: Emacs-orgmode mailing list; +Cc: carsten.dominik
[-- Attachment #1: Type: text/plain, Size: 3891 bytes --]
Hi Carsten and Friends of Org-mode,
appended is the ongoing caching stuff as patch against the current
master.
Please everyone: test this patch and report not _if_ it breaks
something, but _what_ it actually breaks :-P
It is meant to make life as a "publisher" easier (or at least faster
... or longer even?).
* What it does
It writes the information gathered during publishing to disk and
re-loads it from there the next time you publish the same project.
All those informations, currently titles and publishing-timestamps,
will survive a restart of emacs.
One cache file per publishing project is used. The contents of that file
is the elisp that fills the new variable `org-publish-cache'. The cache
is loaded using `load-file', once a project is to be published.
The cache file is named like the project with `.cache' appended and
lives in `org-timestamp-directory' [1]
`org-publish-cache' stores key value pairs:
- "timestamp-filename" => time of last publishing as integer
"timestamp-filename" is that sha1 hash of the filename,
publishing-directory and publishing-function.
- Absolute filename => plist
Currently this plist holds just one property: `:title'
to speed up sitemap generation.
The publishing is meant to keep working the exact way it did before.
Some minor quirks remain:
- The cache file is written, even if
`org-publish-use-timestamps-flag' is nil.
- `org-publish-cache-file-needs-publishing' could replace
`org-publish-needed-p' or it's body could go there.
- In case of an error, the cache is not always written and
cleared. This causes no trouble though.
- We should add functions to clear the cache from old stuff. Now it's
growing each time a file is added or renamed, but it won't shrink
once a file is removed.
The only way to clear the cache is to remove all cache files using
`org-publish-remove-all-timestamps'
* Changes/Fixes:
- Function `initialize-files-alist' and the variable
`org-publish-files-alist' are not used anymore in favour of the
reloadable cache and the functions for handling it. Removed
therefor.
- `org-publish-validate-link' was not used. Removed.
- `org-publish-get-base-files'
Added the variable `sitemap-requested' to avoid sorting where
possible (see end of `org-publish-get-base-files-1').
- `org-publish-get-project-from-filename'
does not depend on a list of files anymore. Before, all files of
all projects had to be loaded which took too much time here (my
org-publish-project-alist is constantly growing).
Instead of that, we walk `org-publish-project-alist' until we find
a project, where the properties :base-directory, :recursive,
:base-extension, :include and :exclude match.
This must especially be tested in different setups, since a failure
might expose private files to the public.
- `org-publish-file'
takes an additional parameter to avoid superfloues loading and
writing of the cache file when used to publish a part of a project.
- Everting below.
* Internal usage of the cache:
- org-publish-reset-cache ()
Ensure the cache is nil.
- org-publish-initialize-cache (project-name)
Initialize the cache for a certain project.
- org-publish-write-cache-file ()
Write the cache to file.
To get and set values, four functions are provided:
- org-publish-cache-set (key value)
Simple key => value association.
- org-publish-cache-get (key)
Dito.
- org-publish-cache-set-file-property (file prop value)
Set a property to value in plist associated with file.
- org-publish-cache-get-file-property (file prop value)
Get a property's value out of plist associated with file.
Helpers:
- org-publish-cache-ctime-of-src (filename)
Return the ctime of file filename as integer.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-publish.el-the-cache.patch --]
[-- Type: text/x-diff, Size: 19532 bytes --]
diff --git a/lisp/org-publish.el b/lisp/org-publish.el
index 328d961..43a36db 100644
--- a/lisp/org-publish.el
+++ b/lisp/org-publish.el
@@ -257,29 +257,19 @@ You can overwrite this default per project in your
"Return path to timestamp file for filename FILENAME."
(setq filename (concat filename "::" (or pub-dir "") "::"
(format "%s" (or pub-func ""))))
- (concat (file-name-as-directory org-publish-timestamp-directory)
- "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
+ (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir)
"Return `t' if FILENAME should be published in PUB-DIR using PUB-FUNC.
-TRUE-PUB-DIR is there the file will truely end up. Currently we are not using
+TRUE-PUB-DIR is where the file will truely end up. Currently we are not using
this - maybe it can eventually be used to check if the file is present at
the target location, and how old it is. Right ow we cannot do this, because
we do not know under what file name the file will be stored - the publishing
function can still decide about that independently."
(let ((rtn
(if org-publish-use-timestamps-flag
- (if (file-exists-p org-publish-timestamp-directory)
- ;; first handle possible wrong timestamp directory
- (if (not (file-directory-p org-publish-timestamp-directory))
- (error "Org publish timestamp: %s is not a directory"
- org-publish-timestamp-directory)
- ;; there is a timestamp, check if FILENAME is newer
- (file-newer-than-file-p
- filename (org-publish-timestamp-filename
- filename pub-dir pub-func)))
- (make-directory org-publish-timestamp-directory)
- t)
+ (org-publish-cache-file-needs-publishing
+ filename pub-dir pub-func)
;; don't use timestamps, always return t
t)))
(if rtn
@@ -291,20 +281,9 @@ function can still decide about that independently."
(defun org-publish-update-timestamp (filename &optional pub-dir pub-func)
"Update publishing timestamp for file FILENAME.
If there is no timestamp, create one."
- (let ((timestamp-file (org-publish-timestamp-filename
- filename pub-dir pub-func))
- newly-created-timestamp)
- (if (not (file-exists-p timestamp-file))
- ;; create timestamp file if needed
- (with-temp-buffer
- (make-directory (file-name-directory timestamp-file) t)
- (write-file timestamp-file)
- (setq newly-created-timestamp t)))
- ;; Emacs 21 doesn't have `set-file-times'
- (if (and (fboundp 'set-file-times)
- (not newly-created-timestamp))
- (set-file-times timestamp-file)
- (call-process "touch" nil 0 nil (expand-file-name timestamp-file)))))
+ (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (stamp (org-publish-cache-ctime-of-src filename)))
+ (org-publish-cache-set key stamp)))
(defun org-publish-remove-all-timestamps ()
"Remove all files in the timstamp directory."
@@ -312,17 +291,12 @@ If there is no timestamp, create one."
files)
(when (and (file-exists-p dir)
(file-directory-p dir))
- (mapc 'delete-file (directory-files dir 'full "[^.]\\'")))))
+ (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
+ (org-publish-reset-cache))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Mapping files to project names
-
-(defvar org-publish-files-alist nil
- "Alist of files and their parent projects.
-Each element of this alist is of the form:
-
- (file-name . project-name)")
+;;;
(defvar org-publish-initial-buffer nil
"The buffer `org-publish' has been called from.")
@@ -330,21 +304,10 @@ Each element of this alist is of the form:
"Temporary list of files to be published.")
;; Here, so you find the variable right before it's used the first time:
-(defvar org-publish-file-title-cache nil
- "List of absolute filenames and titles.")
+(defvar org-publish-cache nil
+ "This will cache all the timestamps and titles for
+files in publishing projects. Blocks could hash sha1 values here.")
-(defun org-publish-initialize-files-alist (&optional refresh)
- "Set `org-publish-files-alist' if it is not set.
-Also set it if the optional argument REFRESH is non-nil."
- (interactive "P")
- (when (or refresh (not org-publish-files-alist))
- (setq org-publish-file-title-cache nil)
- (setq org-publish-files-alist
- (org-publish-get-files org-publish-project-alist))))
-
-(defun org-publish-validate-link (link &optional directory)
- "Check if LINK points to a file in the current project."
- (assoc (expand-file-name link directory) org-publish-files-alist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compatibility aliases
@@ -452,9 +415,12 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR."
(and skip-file (string-match skip-file fnd))
(not (file-exists-p (file-truename f)))
(not (string-match match fnd)))
+
(pushnew f org-publish-temp-files)))))
- (sort (directory-files base-dir t (unless recurse match))
- 'org-publish-compare-directory-files)))
+ (if sitemap-requested
+ (sort (directory-files base-dir t (unless recurse match))
+ 'org-publish-compare-directory-files)
+ (directory-files base-dir t (unless recurse match)))))
(defun org-publish-get-base-files (project &optional exclude-regexp)
"Return a list of all files in PROJECT.
@@ -466,20 +432,22 @@ matching filenames."
(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:
- (sitemap-sort-folders
- (if (plist-member project-plist :sitemap-sort-folders)
- (plist-get project-plist :sitemap-sort-folders)
- org-publish-sitemap-sort-folders))
- (sitemap-alphabetically
- (if (plist-member project-plist :sitemap-alphabetically)
- (plist-get project-plist :sitemap-alphabetically)
- org-publish-sitemap-sort-alphabetically))
- (sitemap-ignore-case
- (if (plist-member project-plist :sitemap-ignore-case)
- (plist-get project-plist :sitemap-ignore-case)
- org-publish-sitemap-sort-ignore-case))
+ ;; sitemap-... variables are dynamically scoped for
+ ;; org-publish-compare-directory-files:
+ (sitemap-requested
+ (plist-get project-plist :auto-sitemap))
+ (sitemap-sort-folders
+ (if (plist-member project-plist :sitemap-sort-folders)
+ (plist-get project-plist :sitemap-sort-folders)
+ org-publish-sitemap-sort-folders))
+ (sitemap-alphabetically
+ (if (plist-member project-plist :sitemap-alphabetically)
+ (plist-get project-plist :sitemap-alphabetically)
+ org-publish-sitemap-sort-alphabetically))
+ (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 "\\)$"))))
@@ -501,8 +469,26 @@ matching filenames."
(defun org-publish-get-project-from-filename (filename &optional up)
"Return the project FILENAME belongs."
- (let* ((project-name (cdr (assoc (expand-file-name filename)
- org-publish-files-alist))))
+ (let* ((filename (expand-file-name filename))
+ project-name)
+
+ (catch 'p-found
+ (dolist (prj org-publish-project-alist)
+ (unless (plist-get (cdr prj) :components)
+ ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
+ (let* ((r (plist-get (cdr prj) :recursive))
+ (b (expand-file-name (plist-get (cdr prj) :base-directory)))
+ (x (plist-get (cdr prj) :base-extension))
+ (e (plist-get (cdr prj) :exclude))
+ (i (plist-get (cdr prj) :include))
+ (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
+ (when (or
+ (and i (string-match i filename))
+ (and
+ (not (and e (string-match e filename)))
+ (string-match xm filename)))
+ (setq project-name (car prj))
+ (throw 'p-found project-name))))))
(when up
(dolist (prj org-publish-project-alist)
(if (member project-name (plist-get (cdr prj) :components))
@@ -600,20 +586,17 @@ See `org-publish-org-to' to the list of arguments."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Publishing files, sets of files, and indices
-(defun org-publish-file (filename &optional project)
- "Publish file FILENAME from PROJECT."
+(defun org-publish-file (filename &optional project no-cache)
+ "Publish file FILENAME from PROJECT.
+If NO-CACHE is not nil, do not initialize org-publish-cache and
+write it to disk. This is needed, since this function is used to
+publish single files, when entire projects are published.
+See `org-publish-projects'."
(let* ((project
(or project
(or (org-publish-get-project-from-filename filename)
- (if (y-or-n-p
- (format "%s is not in a project. Re-read the list of projects files? "
- (abbreviate-file-name filename)))
- ;; If requested, re-initialize the list of projects files
- (progn (org-publish-initialize-files-alist t)
- (or (org-publish-get-project-from-filename filename)
- (error "File %s not part of any known project"
- (abbreviate-file-name filename))))
- (error "Can't publish file outside of a project")))))
+ (error "File %s not part of any known project"
+ (abbreviate-file-name filename)))))
(project-plist (cdr project))
(ftname (file-truename filename))
(publishing-function
@@ -624,6 +607,10 @@ See `org-publish-org-to' to the list of arguments."
(pub-dir (file-name-as-directory
(file-truename (plist-get project-plist :publishing-directory))))
tmp-pub-dir)
+
+ (unless no-cache
+ (org-publish-initialize-cache (car project)))
+
(setq tmp-pub-dir
(file-name-directory
(concat pub-dir
@@ -640,7 +627,8 @@ See `org-publish-org-to' to the list of arguments."
tmp-pub-dir)
(funcall publishing-function project-plist filename tmp-pub-dir)
(org-publish-update-timestamp
- filename pub-dir publishing-function)))))
+ filename pub-dir publishing-function)))
+ (unless no-cache (org-publish-write-cache-file))))
(defun org-publish-projects (projects)
"Publish all files belonging to the PROJECTS alist.
@@ -648,6 +636,8 @@ If :auto-sitemap is set, publish the sitemap too.
If :makeindex is set, also produce a file theindex.org."
(mapc
(lambda (project)
+ ;; Each project uses it's own cache file:
+ (org-publish-initialize-cache (car project))
(let*
((project-plist (cdr project))
(exclude-regexp (plist-get project-plist :exclude))
@@ -662,19 +652,20 @@ If :makeindex is set, also produce a file theindex.org."
(when preparation-function (run-hooks 'preparation-function))
(if sitemap-p (funcall sitemap-function project sitemap-filename))
(while (setq file (pop files))
- (org-publish-file file project))
+ (org-publish-file file project t))
(when (plist-get project-plist :makeindex)
(org-publish-index-generate-theindex.inc
(plist-get project-plist :base-directory))
(org-publish-file (expand-file-name
"theindex.org"
(plist-get project-plist :base-directory))
- project))
- (when completion-function (run-hooks 'completion-function))))
+ project t))
+ (when completion-function (run-hooks 'completion-function))
+ (org-publish-write-cache-file)))
(org-publish-expand-projects projects)))
(defun org-publish-org-sitemap (project &optional sitemap-filename)
- "Create an 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.
Default for SITEMAP-FILENAME is 'sitemap.org'."
(let* ((project-plist (cdr project))
@@ -738,9 +729,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(defun org-publish-find-title (file)
"Find the title of file in project."
- (if (member file org-publish-file-title-cache)
- (cadr (member file org-publish-file-title-cache))
- (let* ((visiting (find-buffer-visiting file))
+ (or
+ (org-publish-cache-get-file-property file :title nil t)
+ (let* ((visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file)))
title)
(with-current-buffer buffer
@@ -754,8 +745,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(file-name-nondirectory (file-name-sans-extension file))))))
(unless visiting
(kill-buffer buffer))
- (setq org-publish-file-title-cache
- (append org-publish-file-title-cache (list file title)))
+ (org-publish-cache-set-file-property file :title title)
title)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -788,7 +778,7 @@ directory and force publishing all files."
(interactive "P")
(when force
(org-publish-remove-all-timestamps))
- (org-publish-initialize-files-alist force)
+ ;; (org-publish-initialize-files-alist force)
(save-window-excursion
(let ((org-publish-use-timestamps-flag
(if force nil org-publish-use-timestamps-flag)))
@@ -800,7 +790,6 @@ directory and force publishing all files."
"Publish the current file.
With prefix argument, force publish the file."
(interactive "P")
- (org-publish-initialize-files-alist force)
(save-window-excursion
(let ((org-publish-use-timestamps-flag
(if force nil org-publish-use-timestamps-flag)))
@@ -812,13 +801,13 @@ With prefix argument, force publish the file."
With a prefix argument, force publishing of all files in
the project."
(interactive "P")
- (org-publish-initialize-files-alist force)
(save-window-excursion
(let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up))
(org-publish-use-timestamps-flag
(if force nil org-publish-use-timestamps-flag)))
(if (not project)
(error "File %s is not part of any known project" (buffer-file-name)))
+ ;; FIXME: force is not used here?
(org-publish project))))
@@ -914,8 +903,138 @@ the project."
(save-buffer))
(kill-buffer ibuffer)))))
-(provide 'org-publish)
+;; Caching functions:
+
+(defun org-publish-write-cache-file (&optional free-cache)
+ "Write `org-publish-cache' to file.
+If FREE-CACHE, empty the cache."
+ (unless org-publish-cache
+ (error "%s" "`org-publish-write-cache-file' called, but no cache present"))
+
+ (let ((cache-file (org-publish-cache-get ":cache-file:")))
+ (unless cache-file
+ (error "%s" "Cannot find cache-file name in `org-publish-write-cache-file'"))
+ (with-temp-file cache-file
+ (let ((print-level nil)
+ (print-length nil))
+ (insert
+ "(setq org-publish-cache\n "
+ (replace-regexp-in-string "\\([^\\ \t]\"\\) \\([^ \t]\\)" "\\1\n\\2"
+ (format "%S" org-publish-cache))
+ ")\n")))
+ (when free-cache (org-publish-reset-cache))))
+
+(defun org-publish-initialize-cache (project-name)
+ "Initialize the projects cache if not intialized yet
+and return it."
+
+ (unless project-name
+ (error "%s%s" "Cannot initialize `org-publish-cache' without projects name"
+ " in `org-publish-initialize-cache'"))
+
+ (unless (file-exists-p org-publish-timestamp-directory)
+ (make-directory org-publish-timestamp-directory))
+ (if (not (file-directory-p org-publish-timestamp-directory))
+ (error "Org publish timestamp: %s is not a directory"
+ org-publish-timestamp-directory))
+
+ (unless (and org-publish-cache
+ (string= (org-publish-cache-get ":project:") project-name))
+ (when org-publish-cache (org-publish-reset-cache))
+ (let* ((cache-file (concat
+ (expand-file-name org-publish-timestamp-directory)
+ project-name
+ ".cache"))
+ (cexists (file-exists-p cache-file)))
+ (if cexists (load-file cache-file))
+ (unless org-publish-cache
+ (setq org-publish-cache
+ #s(hash-table test equal weakness nil size 100 data ()))
+ (org-publish-cache-set ":project:" project-name)
+ (org-publish-cache-set ":cache-file:" cache-file org-publish-cache))
+ (unless cexists (org-publish-write-cache-file nil))))
+ org-publish-cache)
+
+(defun org-publish-reset-cache ()
+ "Empty org-publish-cache and reset it nil."
+ (message "%s" "Resetting org-publish-cache")
+ (if (hash-table-p org-publish-cache)
+ (clrhash org-publish-cache))
+ (setq org-publish-cache nil))
+
+(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func)
+ "Check the timestamp of the last publishing of FILENAME.
+Return `t', if the file needs publishing"
+ (unless org-publish-cache
+ (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present"))
+ (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (pstamp (org-publish-cache-get key)))
+ (if (null pstamp)
+ t
+ (let ((ctime (org-publish-cache-ctime-of-src filename)))
+ (< pstamp ctime)))))
+
+(defun org-publish-cache-set-file-property (filename property value &optional project-name)
+ "Set the VALUE for a PORPERTY of file FILENAME in publishing cache
+to VALUE. Use cache file of PROJECT-NAME.
+If the entry does not exist, it will be created.
+Return VALUE."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-publish-initialize-cache project-name))
+ (let ((pl (org-publish-cache-get filename)))
+ (if pl
+ (progn
+ (plist-put pl property value)
+ value)
+ (org-publish-cache-get-file-property
+ filename property value nil project-name))))
+
+(defun org-publish-cache-get-file-property
+ (filename property &optional default no-create project-name)
+ "Return the value for a PORPERTY of file FILENAME in publishing cache.
+Use cache file of PROJECT-NAME. Return the value of that PROPERTY or
+DEFAULT, if the value does not yet exist.
+If the entry will be created, unless NO-CREATE is not nil."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-publish-initialize-cache project-name))
+ (let ((pl (org-publish-cache-get filename))
+ (retval nil))
+ (if pl
+ (if (plist-member pl property)
+ (setq retval (plist-get pl property))
+ (setq retval default))
+ ;; no pl yet:
+ (unless no-create
+ (org-publish-cache-put filename (list property default)))
+ (setq retval default))
+ retval))
+
+(defun org-publish-cache-get (key)
+ "Return the value stored in `org-publish-cache' for key KEY.
+Returns nil, if no value or nil is found, or the cache does not
+exist."
+ (unless org-publish-cache
+ (error "%s" "`org-publish-cache-get' called, but no cache present"))
+ (gethash key org-publish-cache))
+
+(defun org-publish-cache-set (key value)
+ "Store KEY VLAUE pair in `org-publish-cache'.
+Returns value on success, else nil."
+ (unless org-publish-cache
+ (error "%s" "`org-publish-cache-set' called, but no cache present"))
+ (puthash key value org-publish-cache))
+
+(defun org-publish-cache-ctime-of-src (filename)
+ "Get the files ctime as integer."
+ (let ((src-attr (file-attributes filename)))
+ (+
+ (lsh (car (nth 5 src-attr)) 16)
+ (cadr (nth 5 src-attr)))))
+
+
+
+(provide 'org-publish)
;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb
[-- Attachment #3: Type: text/plain, Size: 239 bytes --]
Best wishes
Sebastian
== Footnotes:
[1] I would love to drop `org-timestamp-directory' in favour of a `.org'
in the `:base-directory' of a project. We now have that index
feature, tag-files and certainly more to come...
[-- Attachment #4: Type: text/plain, Size: 201 bytes --]
_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
^ permalink raw reply related [flat|nested] 3+ messages in thread
* Re: Org-publish-cache - speed up publishing
2010-05-04 23:43 Org-publish-cache - speed up publishing Sebastian Rose
@ 2010-05-05 16:04 ` Sebastian Rose
2010-05-05 21:59 ` Sebastian Rose
0 siblings, 1 reply; 3+ messages in thread
From: Sebastian Rose @ 2010-05-05 16:04 UTC (permalink / raw)
To: Emacs-orgmode mailing list; +Cc: carsten.dominik
[-- Attachment #1: Type: text/plain, Size: 301 bytes --]
Sorry for replying to my own mail again,
but there's a stupid typo in here. The function is called
`org-publish-get-set'.
Instead of
> + (org-publish-cache-put filename (list property default)))
it should be
> + (org-publish-cache-get filename (list property default)))
Corrected patch:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-publish.el-the-cache.patch --]
[-- Type: text/x-diff, Size: 0 bytes --]
[-- Attachment #3: Type: text/plain, Size: 14 bytes --]
Sebastian
[-- Attachment #4: Type: text/plain, Size: 201 bytes --]
_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Org-publish-cache - speed up publishing
2010-05-05 16:04 ` Sebastian Rose
@ 2010-05-05 21:59 ` Sebastian Rose
0 siblings, 0 replies; 3+ messages in thread
From: Sebastian Rose @ 2010-05-05 21:59 UTC (permalink / raw)
To: Emacs-orgmode mailing list; +Cc: carsten.dominik
[-- Attachment #1: Type: text/plain, Size: 529 bytes --]
Sebastian Rose <sebastian_rose@gmx.de> writes:
> --=-=-=
>
> Sorry for replying to my own mail again,
>
> but there's a stupid typo in here. The function is called
> `org-publish-get-set'.
>
> Instead of
>
> > + (org-publish-cache-put filename (list property default)))
>
> it should be
>
> > + (org-publish-cache-get filename (list property default)))
>
>
> Corrected patch:
Could someone write those emails for me, please?
Here it comes (also removes the now unused function
`org-publish-get-files') - now for real:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-publish.el-the-cache.patch --]
[-- Type: text/x-diff, Size: 20505 bytes --]
diff --git a/lisp/org-publish.el b/lisp/org-publish.el
index 328d961..e59d5d6 100644
--- a/lisp/org-publish.el
+++ b/lisp/org-publish.el
@@ -257,29 +257,19 @@ You can overwrite this default per project in your
"Return path to timestamp file for filename FILENAME."
(setq filename (concat filename "::" (or pub-dir "") "::"
(format "%s" (or pub-func ""))))
- (concat (file-name-as-directory org-publish-timestamp-directory)
- "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
+ (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir)
"Return `t' if FILENAME should be published in PUB-DIR using PUB-FUNC.
-TRUE-PUB-DIR is there the file will truely end up. Currently we are not using
+TRUE-PUB-DIR is where the file will truely end up. Currently we are not using
this - maybe it can eventually be used to check if the file is present at
the target location, and how old it is. Right ow we cannot do this, because
we do not know under what file name the file will be stored - the publishing
function can still decide about that independently."
(let ((rtn
(if org-publish-use-timestamps-flag
- (if (file-exists-p org-publish-timestamp-directory)
- ;; first handle possible wrong timestamp directory
- (if (not (file-directory-p org-publish-timestamp-directory))
- (error "Org publish timestamp: %s is not a directory"
- org-publish-timestamp-directory)
- ;; there is a timestamp, check if FILENAME is newer
- (file-newer-than-file-p
- filename (org-publish-timestamp-filename
- filename pub-dir pub-func)))
- (make-directory org-publish-timestamp-directory)
- t)
+ (org-publish-cache-file-needs-publishing
+ filename pub-dir pub-func)
;; don't use timestamps, always return t
t)))
(if rtn
@@ -291,20 +281,9 @@ function can still decide about that independently."
(defun org-publish-update-timestamp (filename &optional pub-dir pub-func)
"Update publishing timestamp for file FILENAME.
If there is no timestamp, create one."
- (let ((timestamp-file (org-publish-timestamp-filename
- filename pub-dir pub-func))
- newly-created-timestamp)
- (if (not (file-exists-p timestamp-file))
- ;; create timestamp file if needed
- (with-temp-buffer
- (make-directory (file-name-directory timestamp-file) t)
- (write-file timestamp-file)
- (setq newly-created-timestamp t)))
- ;; Emacs 21 doesn't have `set-file-times'
- (if (and (fboundp 'set-file-times)
- (not newly-created-timestamp))
- (set-file-times timestamp-file)
- (call-process "touch" nil 0 nil (expand-file-name timestamp-file)))))
+ (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (stamp (org-publish-cache-ctime-of-src filename)))
+ (org-publish-cache-set key stamp)))
(defun org-publish-remove-all-timestamps ()
"Remove all files in the timstamp directory."
@@ -312,17 +291,12 @@ If there is no timestamp, create one."
files)
(when (and (file-exists-p dir)
(file-directory-p dir))
- (mapc 'delete-file (directory-files dir 'full "[^.]\\'")))))
+ (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
+ (org-publish-reset-cache))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Mapping files to project names
-
-(defvar org-publish-files-alist nil
- "Alist of files and their parent projects.
-Each element of this alist is of the form:
-
- (file-name . project-name)")
+;;;
(defvar org-publish-initial-buffer nil
"The buffer `org-publish' has been called from.")
@@ -330,21 +304,10 @@ Each element of this alist is of the form:
"Temporary list of files to be published.")
;; Here, so you find the variable right before it's used the first time:
-(defvar org-publish-file-title-cache nil
- "List of absolute filenames and titles.")
+(defvar org-publish-cache nil
+ "This will cache all the timestamps and titles for
+files in publishing projects. Blocks could hash sha1 values here.")
-(defun org-publish-initialize-files-alist (&optional refresh)
- "Set `org-publish-files-alist' if it is not set.
-Also set it if the optional argument REFRESH is non-nil."
- (interactive "P")
- (when (or refresh (not org-publish-files-alist))
- (setq org-publish-file-title-cache nil)
- (setq org-publish-files-alist
- (org-publish-get-files org-publish-project-alist))))
-
-(defun org-publish-validate-link (link &optional directory)
- "Check if LINK points to a file in the current project."
- (assoc (expand-file-name link directory) org-publish-files-alist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compatibility aliases
@@ -372,23 +335,6 @@ This is a compatibility function for Emacsen without `delete-dups'."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Getting project information out of org-publish-project-alist
-(defun org-publish-get-files (projects-alist &optional no-exclusion)
- "Return the list of all publishable files for PROJECTS-ALIST.
-If NO-EXCLUSION is non-nil, don't exclude files."
- (let (all-files)
- ;; add all projects
- (mapc
- (lambda(p)
- (let* ((exclude (plist-get (cdr p) :exclude))
- (files (and p (org-publish-get-base-files p exclude))))
- ;; add all files from this project
- (mapc (lambda(f)
- (add-to-list 'all-files
- (cons (expand-file-name f) (car p))))
- files)))
- (org-publish-expand-projects projects-alist))
- all-files))
-
(defun org-publish-expand-projects (projects-alist)
"Expand projects in PROJECTS-ALIST.
This splices all the components into the list."
@@ -452,9 +398,12 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR."
(and skip-file (string-match skip-file fnd))
(not (file-exists-p (file-truename f)))
(not (string-match match fnd)))
+
(pushnew f org-publish-temp-files)))))
- (sort (directory-files base-dir t (unless recurse match))
- 'org-publish-compare-directory-files)))
+ (if sitemap-requested
+ (sort (directory-files base-dir t (unless recurse match))
+ 'org-publish-compare-directory-files)
+ (directory-files base-dir t (unless recurse match)))))
(defun org-publish-get-base-files (project &optional exclude-regexp)
"Return a list of all files in PROJECT.
@@ -466,20 +415,22 @@ matching filenames."
(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:
- (sitemap-sort-folders
- (if (plist-member project-plist :sitemap-sort-folders)
- (plist-get project-plist :sitemap-sort-folders)
- org-publish-sitemap-sort-folders))
- (sitemap-alphabetically
- (if (plist-member project-plist :sitemap-alphabetically)
- (plist-get project-plist :sitemap-alphabetically)
- org-publish-sitemap-sort-alphabetically))
- (sitemap-ignore-case
- (if (plist-member project-plist :sitemap-ignore-case)
- (plist-get project-plist :sitemap-ignore-case)
- org-publish-sitemap-sort-ignore-case))
+ ;; sitemap-... variables are dynamically scoped for
+ ;; org-publish-compare-directory-files:
+ (sitemap-requested
+ (plist-get project-plist :auto-sitemap))
+ (sitemap-sort-folders
+ (if (plist-member project-plist :sitemap-sort-folders)
+ (plist-get project-plist :sitemap-sort-folders)
+ org-publish-sitemap-sort-folders))
+ (sitemap-alphabetically
+ (if (plist-member project-plist :sitemap-alphabetically)
+ (plist-get project-plist :sitemap-alphabetically)
+ org-publish-sitemap-sort-alphabetically))
+ (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 "\\)$"))))
@@ -501,8 +452,26 @@ matching filenames."
(defun org-publish-get-project-from-filename (filename &optional up)
"Return the project FILENAME belongs."
- (let* ((project-name (cdr (assoc (expand-file-name filename)
- org-publish-files-alist))))
+ (let* ((filename (expand-file-name filename))
+ project-name)
+
+ (catch 'p-found
+ (dolist (prj org-publish-project-alist)
+ (unless (plist-get (cdr prj) :components)
+ ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
+ (let* ((r (plist-get (cdr prj) :recursive))
+ (b (expand-file-name (plist-get (cdr prj) :base-directory)))
+ (x (plist-get (cdr prj) :base-extension))
+ (e (plist-get (cdr prj) :exclude))
+ (i (plist-get (cdr prj) :include))
+ (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
+ (when (or
+ (and i (string-match i filename))
+ (and
+ (not (and e (string-match e filename)))
+ (string-match xm filename)))
+ (setq project-name (car prj))
+ (throw 'p-found project-name))))))
(when up
(dolist (prj org-publish-project-alist)
(if (member project-name (plist-get (cdr prj) :components))
@@ -600,20 +569,17 @@ See `org-publish-org-to' to the list of arguments."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Publishing files, sets of files, and indices
-(defun org-publish-file (filename &optional project)
- "Publish file FILENAME from PROJECT."
+(defun org-publish-file (filename &optional project no-cache)
+ "Publish file FILENAME from PROJECT.
+If NO-CACHE is not nil, do not initialize org-publish-cache and
+write it to disk. This is needed, since this function is used to
+publish single files, when entire projects are published.
+See `org-publish-projects'."
(let* ((project
(or project
(or (org-publish-get-project-from-filename filename)
- (if (y-or-n-p
- (format "%s is not in a project. Re-read the list of projects files? "
- (abbreviate-file-name filename)))
- ;; If requested, re-initialize the list of projects files
- (progn (org-publish-initialize-files-alist t)
- (or (org-publish-get-project-from-filename filename)
- (error "File %s not part of any known project"
- (abbreviate-file-name filename))))
- (error "Can't publish file outside of a project")))))
+ (error "File %s not part of any known project"
+ (abbreviate-file-name filename)))))
(project-plist (cdr project))
(ftname (file-truename filename))
(publishing-function
@@ -624,6 +590,10 @@ See `org-publish-org-to' to the list of arguments."
(pub-dir (file-name-as-directory
(file-truename (plist-get project-plist :publishing-directory))))
tmp-pub-dir)
+
+ (unless no-cache
+ (org-publish-initialize-cache (car project)))
+
(setq tmp-pub-dir
(file-name-directory
(concat pub-dir
@@ -640,7 +610,8 @@ See `org-publish-org-to' to the list of arguments."
tmp-pub-dir)
(funcall publishing-function project-plist filename tmp-pub-dir)
(org-publish-update-timestamp
- filename pub-dir publishing-function)))))
+ filename pub-dir publishing-function)))
+ (unless no-cache (org-publish-write-cache-file))))
(defun org-publish-projects (projects)
"Publish all files belonging to the PROJECTS alist.
@@ -648,6 +619,8 @@ If :auto-sitemap is set, publish the sitemap too.
If :makeindex is set, also produce a file theindex.org."
(mapc
(lambda (project)
+ ;; Each project uses it's own cache file:
+ (org-publish-initialize-cache (car project))
(let*
((project-plist (cdr project))
(exclude-regexp (plist-get project-plist :exclude))
@@ -662,19 +635,20 @@ If :makeindex is set, also produce a file theindex.org."
(when preparation-function (run-hooks 'preparation-function))
(if sitemap-p (funcall sitemap-function project sitemap-filename))
(while (setq file (pop files))
- (org-publish-file file project))
+ (org-publish-file file project t))
(when (plist-get project-plist :makeindex)
(org-publish-index-generate-theindex.inc
(plist-get project-plist :base-directory))
(org-publish-file (expand-file-name
"theindex.org"
(plist-get project-plist :base-directory))
- project))
- (when completion-function (run-hooks 'completion-function))))
+ project t))
+ (when completion-function (run-hooks 'completion-function))
+ (org-publish-write-cache-file)))
(org-publish-expand-projects projects)))
(defun org-publish-org-sitemap (project &optional sitemap-filename)
- "Create an 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.
Default for SITEMAP-FILENAME is 'sitemap.org'."
(let* ((project-plist (cdr project))
@@ -738,9 +712,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(defun org-publish-find-title (file)
"Find the title of file in project."
- (if (member file org-publish-file-title-cache)
- (cadr (member file org-publish-file-title-cache))
- (let* ((visiting (find-buffer-visiting file))
+ (or
+ (org-publish-cache-get-file-property file :title nil t)
+ (let* ((visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file)))
title)
(with-current-buffer buffer
@@ -754,8 +728,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(file-name-nondirectory (file-name-sans-extension file))))))
(unless visiting
(kill-buffer buffer))
- (setq org-publish-file-title-cache
- (append org-publish-file-title-cache (list file title)))
+ (org-publish-cache-set-file-property file :title title)
title)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -788,7 +761,7 @@ directory and force publishing all files."
(interactive "P")
(when force
(org-publish-remove-all-timestamps))
- (org-publish-initialize-files-alist force)
+ ;; (org-publish-initialize-files-alist force)
(save-window-excursion
(let ((org-publish-use-timestamps-flag
(if force nil org-publish-use-timestamps-flag)))
@@ -800,7 +773,6 @@ directory and force publishing all files."
"Publish the current file.
With prefix argument, force publish the file."
(interactive "P")
- (org-publish-initialize-files-alist force)
(save-window-excursion
(let ((org-publish-use-timestamps-flag
(if force nil org-publish-use-timestamps-flag)))
@@ -812,13 +784,13 @@ With prefix argument, force publish the file."
With a prefix argument, force publishing of all files in
the project."
(interactive "P")
- (org-publish-initialize-files-alist force)
(save-window-excursion
(let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up))
(org-publish-use-timestamps-flag
(if force nil org-publish-use-timestamps-flag)))
(if (not project)
(error "File %s is not part of any known project" (buffer-file-name)))
+ ;; FIXME: force is not used here?
(org-publish project))))
@@ -914,8 +886,138 @@ the project."
(save-buffer))
(kill-buffer ibuffer)))))
-(provide 'org-publish)
+;; Caching functions:
+
+(defun org-publish-write-cache-file (&optional free-cache)
+ "Write `org-publish-cache' to file.
+If FREE-CACHE, empty the cache."
+ (unless org-publish-cache
+ (error "%s" "`org-publish-write-cache-file' called, but no cache present"))
+
+ (let ((cache-file (org-publish-cache-get ":cache-file:")))
+ (unless cache-file
+ (error "%s" "Cannot find cache-file name in `org-publish-write-cache-file'"))
+ (with-temp-file cache-file
+ (let ((print-level nil)
+ (print-length nil))
+ (insert
+ "(setq org-publish-cache\n "
+ (replace-regexp-in-string "\\([^\\ \t]\"\\) \\([^ \t]\\)" "\\1\n\\2"
+ (format "%S" org-publish-cache))
+ ")\n")))
+ (when free-cache (org-publish-reset-cache))))
+
+(defun org-publish-initialize-cache (project-name)
+ "Initialize the projects cache if not intialized yet
+and return it."
+
+ (unless project-name
+ (error "%s%s" "Cannot initialize `org-publish-cache' without projects name"
+ " in `org-publish-initialize-cache'"))
+
+ (unless (file-exists-p org-publish-timestamp-directory)
+ (make-directory org-publish-timestamp-directory))
+ (if (not (file-directory-p org-publish-timestamp-directory))
+ (error "Org publish timestamp: %s is not a directory"
+ org-publish-timestamp-directory))
+
+ (unless (and org-publish-cache
+ (string= (org-publish-cache-get ":project:") project-name))
+ (when org-publish-cache (org-publish-reset-cache))
+ (let* ((cache-file (concat
+ (expand-file-name org-publish-timestamp-directory)
+ project-name
+ ".cache"))
+ (cexists (file-exists-p cache-file)))
+ (if cexists (load-file cache-file))
+ (unless org-publish-cache
+ (setq org-publish-cache
+ #s(hash-table test equal weakness nil size 100 data ()))
+ (org-publish-cache-set ":project:" project-name)
+ (org-publish-cache-set ":cache-file:" cache-file org-publish-cache))
+ (unless cexists (org-publish-write-cache-file nil))))
+ org-publish-cache)
+
+(defun org-publish-reset-cache ()
+ "Empty org-publish-cache and reset it nil."
+ (message "%s" "Resetting org-publish-cache")
+ (if (hash-table-p org-publish-cache)
+ (clrhash org-publish-cache))
+ (setq org-publish-cache nil))
+
+(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func)
+ "Check the timestamp of the last publishing of FILENAME.
+Return `t', if the file needs publishing"
+ (unless org-publish-cache
+ (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present"))
+ (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (pstamp (org-publish-cache-get key)))
+ (if (null pstamp)
+ t
+ (let ((ctime (org-publish-cache-ctime-of-src filename)))
+ (< pstamp ctime)))))
+
+(defun org-publish-cache-set-file-property (filename property value &optional project-name)
+ "Set the VALUE for a PORPERTY of file FILENAME in publishing cache
+to VALUE. Use cache file of PROJECT-NAME.
+If the entry does not exist, it will be created.
+Return VALUE."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-publish-initialize-cache project-name))
+ (let ((pl (org-publish-cache-get filename)))
+ (if pl
+ (progn
+ (plist-put pl property value)
+ value)
+ (org-publish-cache-get-file-property
+ filename property value nil project-name))))
+
+(defun org-publish-cache-get-file-property
+ (filename property &optional default no-create project-name)
+ "Return the value for a PORPERTY of file FILENAME in publishing cache.
+Use cache file of PROJECT-NAME. Return the value of that PROPERTY or
+DEFAULT, if the value does not yet exist.
+If the entry will be created, unless NO-CREATE is not nil."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-publish-initialize-cache project-name))
+ (let ((pl (org-publish-cache-get filename))
+ (retval nil))
+ (if pl
+ (if (plist-member pl property)
+ (setq retval (plist-get pl property))
+ (setq retval default))
+ ;; no pl yet:
+ (unless no-create
+ (org-publish-cache-set filename (list property default)))
+ (setq retval default))
+ retval))
+
+(defun org-publish-cache-get (key)
+ "Return the value stored in `org-publish-cache' for key KEY.
+Returns nil, if no value or nil is found, or the cache does not
+exist."
+ (unless org-publish-cache
+ (error "%s" "`org-publish-cache-get' called, but no cache present"))
+ (gethash key org-publish-cache))
+
+(defun org-publish-cache-set (key value)
+ "Store KEY VLAUE pair in `org-publish-cache'.
+Returns value on success, else nil."
+ (unless org-publish-cache
+ (error "%s" "`org-publish-cache-set' called, but no cache present"))
+ (puthash key value org-publish-cache))
+
+(defun org-publish-cache-ctime-of-src (filename)
+ "Get the files ctime as integer."
+ (let ((src-attr (file-attributes filename)))
+ (+
+ (lsh (car (nth 5 src-attr)) 16)
+ (cadr (nth 5 src-attr)))))
+
+
+
+(provide 'org-publish)
;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb
[-- Attachment #3: Type: text/plain, Size: 14 bytes --]
Sebastian
[-- Attachment #4: Type: text/plain, Size: 201 bytes --]
_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
^ permalink raw reply related [flat|nested] 3+ messages in thread
end of thread, other threads:[~2010-05-05 22:00 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-05-04 23:43 Org-publish-cache - speed up publishing Sebastian Rose
2010-05-05 16:04 ` Sebastian Rose
2010-05-05 21:59 ` Sebastian Rose
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).