From: Sebastian Rose <sebastian_rose@gmx.de>
To: Emacs-orgmode mailing list <emacs-orgmode@gnu.org>
Cc: carsten.dominik@gmail.com
Subject: Re: Org-publish-cache - speed up publishing
Date: Wed, 05 May 2010 23:59:51 +0200 [thread overview]
Message-ID: <87aase57s8.fsf@gmx.de> (raw)
In-Reply-To: <87iq721gj3.fsf@gmx.de> (Sebastian Rose's message of "Wed, 05 May 2010 18:04:32 +0200")
[-- 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
prev parent reply other threads:[~2010-05-05 22:00 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87aase57s8.fsf@gmx.de \
--to=sebastian_rose@gmx.de \
--cc=carsten.dominik@gmail.com \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).