From mboxrd@z Thu Jan 1 00:00:00 1970 From: Sebastian Rose Subject: Re: Org-publish-cache - speed up publishing Date: Wed, 05 May 2010 23:59:51 +0200 Message-ID: <87aase57s8.fsf@gmx.de> References: <87tyqnteqp.fsf@gmx.de> <87iq721gj3.fsf@gmx.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1O9mdY-0003Zf-Qk for emacs-orgmode@gnu.org; Wed, 05 May 2010 18:00:13 -0400 Received: from [140.186.70.92] (port=40375 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1O9mdT-0003Wa-PQ for emacs-orgmode@gnu.org; Wed, 05 May 2010 18:00:12 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1O9mdN-000324-By for emacs-orgmode@gnu.org; Wed, 05 May 2010 18:00:05 -0400 Received: from mail.gmx.net ([213.165.64.20]:49179) by eggs.gnu.org with smtp (Exim 4.69) (envelope-from ) id 1O9mdM-00031x-Ra for emacs-orgmode@gnu.org; Wed, 05 May 2010 18:00:01 -0400 In-Reply-To: <87iq721gj3.fsf@gmx.de> (Sebastian Rose's message of "Wed, 05 May 2010 18:04:32 +0200") List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Emacs-orgmode mailing list Cc: carsten.dominik@gmail.com --=-=-= Sebastian Rose 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: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=org-publish.el-the-cache.patch 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 --=-=-= Sebastian --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ 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 --=-=-=--