ox-publish.el (52239B)
1 ;;; ox-publish.el --- Publish Related Org Mode Files as a Website -*- lexical-binding: t; -*- 2 ;; Copyright (C) 2006-2023 Free Software Foundation, Inc. 3 4 ;; Author: David O'Toole <dto@gnu.org> 5 ;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr> 6 ;; Keywords: hypermedia, outlines, wp 7 8 ;; This file is part of GNU Emacs. 9 ;; 10 ;; GNU Emacs is free software: you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; GNU Emacs is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; This program allow configurable publishing of related sets of 26 ;; Org mode files as a complete website. 27 ;; 28 ;; ox-publish.el can do the following: 29 ;; 30 ;; + Publish all one's Org files to a given export back-end 31 ;; + Upload HTML, images, attachments and other files to a web server 32 ;; + Exclude selected private pages from publishing 33 ;; + Publish a clickable sitemap of pages 34 ;; + Manage local timestamps for publishing only changed files 35 ;; + Accept plugin functions to extend range of publishable content 36 ;; 37 ;; Documentation for publishing is in the manual. 38 39 ;;; Code: 40 41 (require 'org-macs) 42 (org-assert-version) 43 44 (require 'cl-lib) 45 (require 'format-spec) 46 (require 'ox) 47 48 (declare-function org-at-heading-p "org" (&optional _)) 49 (declare-function org-back-to-heading "org" (&optional invisible-ok)) 50 (declare-function org-next-visible-heading "org" (arg)) 51 52 53 ;;; Variables 54 55 ;; Here, so you find the variable right before it's used the first time: 56 (defvar org-publish-cache nil 57 "This will cache timestamps and titles for files in publishing projects. 58 Blocks could hash sha1 values here.") 59 60 (defvar org-publish-after-publishing-hook nil 61 "Hook run each time a file is published. 62 Every function in this hook will be called with two arguments: 63 the name of the original file and the name of the file 64 produced.") 65 66 (defgroup org-export-publish nil 67 "Options for publishing a set of files." 68 :tag "Org Publishing" 69 :group 'org-export) 70 71 (defcustom org-publish-project-alist nil 72 "Association list to control publishing behavior. 73 \\<org-mode-map> 74 Each element of the alist is a publishing project. The car of 75 each element is a string, uniquely identifying the project. The 76 cdr of each element is in one of the following forms: 77 78 1. A well-formed property list with an even number of elements, 79 alternating keys and values, specifying parameters for the 80 publishing process. 81 82 (:property value :property value ... ) 83 84 2. A meta-project definition, specifying of a list of 85 sub-projects: 86 87 (:components (\"project-1\" \"project-2\" ...)) 88 89 When the CDR of an element of org-publish-project-alist is in 90 this second form, the elements of the list after `:components' 91 are taken to be components of the project, which group together 92 files requiring different publishing options. When you publish 93 such a project with `\\[org-publish]', the components all publish. 94 95 When a property is given a value in `org-publish-project-alist', 96 its setting overrides the value of the corresponding user 97 variable (if any) during publishing. However, options set within 98 a file override everything. 99 100 Most properties are optional, but some should always be set: 101 102 `:base-directory' 103 104 Directory containing publishing source files. 105 106 `:base-extension' 107 108 Extension (without the dot!) of source files. This can be 109 a regular expression. If not given, \"org\" will be used as 110 default extension. If it is `any', include all the files, 111 even without extension. 112 113 `:publishing-directory' 114 115 Directory (possibly remote) where output files will be 116 published. 117 118 If `:recursive' is non-nil files in sub-directories of 119 `:base-directory' are considered. 120 121 The `:exclude' property may be used to prevent certain files from 122 being published. Its value may be a string or regexp matching 123 file names you don't want to be published. 124 125 The `:include' property may be used to include extra files. Its 126 value may be a list of filenames to include. The filenames are 127 considered relative to the base directory. 128 129 When both `:include' and `:exclude' properties are given values, 130 the exclusion step happens first. 131 132 One special property controls which back-end function to use for 133 publishing files in the project. This can be used to extend the 134 set of file types publishable by `org-publish', as well as the 135 set of output formats. 136 137 `:publishing-function' 138 139 Function to publish file. Each back-end may define its 140 own (i.e. `org-latex-publish-to-pdf', 141 `org-html-publish-to-html'). May be a list of functions, in 142 which case each function in the list is invoked in turn. 143 144 Another property allows you to insert code that prepares 145 a project for publishing. For example, you could call GNU Make 146 on a certain makefile, to ensure published files are built up to 147 date. 148 149 `:preparation-function' 150 151 Function to be called before publishing this project. This 152 may also be a list of functions. Preparation functions are 153 called with the project properties list as their sole 154 argument. 155 156 `:completion-function' 157 158 Function to be called after publishing this project. This 159 may also be a list of functions. Completion functions are 160 called with the project properties list as their sole 161 argument. 162 163 Some properties control details of the Org publishing process, 164 and are equivalent to the corresponding user variables listed in 165 the right column. Back-end specific properties may also be 166 included. See the back-end documentation for more information. 167 168 :author `user-full-name' 169 :creator `org-export-creator-string' 170 :email `user-mail-address' 171 :exclude-tags `org-export-exclude-tags' 172 :headline-levels `org-export-headline-levels' 173 :language `org-export-default-language' 174 :preserve-breaks `org-export-preserve-breaks' 175 :section-numbers `org-export-with-section-numbers' 176 :select-tags `org-export-select-tags' 177 :time-stamp-file `org-export-time-stamp-file' 178 :with-archived-trees `org-export-with-archived-trees' 179 :with-author `org-export-with-author' 180 :with-creator `org-export-with-creator' 181 :with-date `org-export-with-date' 182 :with-drawers `org-export-with-drawers' 183 :with-email `org-export-with-email' 184 :with-emphasize `org-export-with-emphasize' 185 :with-entities `org-export-with-entities' 186 :with-fixed-width `org-export-with-fixed-width' 187 :with-footnotes `org-export-with-footnotes' 188 :with-inlinetasks `org-export-with-inlinetasks' 189 :with-latex `org-export-with-latex' 190 :with-planning `org-export-with-planning' 191 :with-priority `org-export-with-priority' 192 :with-properties `org-export-with-properties' 193 :with-smart-quotes `org-export-with-smart-quotes' 194 :with-special-strings `org-export-with-special-strings' 195 :with-statistics-cookies' `org-export-with-statistics-cookies' 196 :with-sub-superscript `org-export-with-sub-superscripts' 197 :with-toc `org-export-with-toc' 198 :with-tables `org-export-with-tables' 199 :with-tags `org-export-with-tags' 200 :with-tasks `org-export-with-tasks' 201 :with-timestamps `org-export-with-timestamps' 202 :with-title `org-export-with-title' 203 :with-todo-keywords `org-export-with-todo-keywords' 204 205 The following properties may be used to control publishing of 206 a site-map of files or summary page for a given project. 207 208 `:auto-sitemap' 209 210 Whether to publish a site-map during 211 `org-publish-current-project' or `org-publish-all'. 212 213 `:sitemap-filename' 214 215 Filename for output of site-map. Defaults to \"sitemap.org\". 216 217 `:sitemap-title' 218 219 Title of site-map page. Defaults to name of file. 220 221 `:sitemap-style' 222 223 Can be `list' (site-map is just an itemized list of the 224 titles of the files involved) or `tree' (the directory 225 structure of the source files is reflected in the site-map). 226 Defaults to `tree'. 227 228 `:sitemap-format-entry' 229 230 Plugin function used to format entries in the site-map. It 231 is called with three arguments: the file or directory name 232 relative to base directory, the site map style and the 233 current project. It has to return a string. 234 235 Defaults to `org-publish-sitemap-default-entry', which turns 236 file names into links and use document titles as 237 descriptions. For specific formatting needs, one can use 238 `org-publish-find-date', `org-publish-find-title' and 239 `org-publish-find-property', to retrieve additional 240 information about published documents. 241 242 `:sitemap-function' 243 244 Plugin function to use for generation of site-map. It is 245 called with two arguments: the title of the site-map, as 246 a string, and a representation of the files involved in the 247 project, as returned by `org-list-to-lisp'. The latter can 248 further be transformed using `org-list-to-generic', 249 `org-list-to-subtree' and alike. It has to return a string. 250 251 Defaults to `org-publish-sitemap-default', which generates 252 a plain list of links to all files in the project. 253 254 If you create a site-map file, adjust the sorting like this: 255 256 `:sitemap-sort-folders' 257 258 Where folders should appear in the site-map. Set this to 259 `first' or `last' to display folders first or last, 260 respectively. When set to `ignore' (default), folders are 261 ignored altogether. Any other value will mix files and 262 folders. This variable has no effect when site-map style is 263 `tree'. 264 265 `:sitemap-sort-files' 266 267 The site map is normally sorted alphabetically. You can 268 change this behavior setting this to `anti-chronologically', 269 `chronologically', or nil. 270 271 `:sitemap-ignore-case' 272 273 Should sorting be case-sensitive? Default nil. 274 275 The following property control the creation of a concept index. 276 277 `:makeindex' 278 279 Create a concept index. The file containing the index has to 280 be called \"theindex.org\". If it doesn't exist in the 281 project, it will be generated. Contents of the index are 282 stored in the file \"theindex.inc\", which can be included in 283 \"theindex.org\". 284 285 Other properties affecting publication. 286 287 `:body-only' 288 289 Set this to t to publish only the body of the documents." 290 :group 'org-export-publish 291 :type 'alist) 292 293 (defcustom org-publish-use-timestamps-flag t 294 "Non-nil means use timestamp checking to publish only changed files. 295 When nil, do no timestamp checking and always publish all files." 296 :group 'org-export-publish 297 :type 'boolean) 298 299 (defcustom org-publish-timestamp-directory 300 (convert-standard-filename "~/.org-timestamps/") 301 "Name of directory in which to store publishing timestamps." 302 :group 'org-export-publish 303 :type 'directory) 304 305 (defcustom org-publish-list-skipped-files t 306 "Non-nil means show message about files *not* published." 307 :group 'org-export-publish 308 :type 'boolean) 309 310 (defcustom org-publish-sitemap-sort-files 'alphabetically 311 "Method to sort files in site-maps. 312 Possible values are `alphabetically', `chronologically', 313 `anti-chronologically' and nil. 314 315 If `alphabetically', files will be sorted alphabetically. If 316 `chronologically', files will be sorted with older modification 317 time first. If `anti-chronologically', files will be sorted with 318 newer modification time first. nil won't sort files. 319 320 You can overwrite this default per project in your 321 `org-publish-project-alist', using `:sitemap-sort-files'." 322 :group 'org-export-publish 323 :type 'symbol) 324 325 (defcustom org-publish-sitemap-sort-folders 'ignore 326 "A symbol, denoting if folders are sorted first in site-maps. 327 328 Possible values are `first', `last', `ignore' and nil. 329 If `first', folders will be sorted before files. 330 If `last', folders are sorted to the end after the files. 331 If `ignore', folders do not appear in the site-map. 332 Any other value will mix files and folders. 333 334 You can overwrite this default per project in your 335 `org-publish-project-alist', using `:sitemap-sort-folders'. 336 337 This variable is ignored when site-map style is `tree'." 338 :group 'org-export-publish 339 :type '(choice 340 (const :tag "Folders before files" first) 341 (const :tag "Folders after files" last) 342 (const :tag "No folder in site-map" ignore) 343 (const :tag "Mix folders and files" nil)) 344 :version "26.1" 345 :package-version '(Org . "9.1") 346 :safe #'symbolp) 347 348 (defcustom org-publish-sitemap-sort-ignore-case nil 349 "Non-nil when site-map sorting should ignore case. 350 351 You can overwrite this default per project in your 352 `org-publish-project-alist', using `:sitemap-ignore-case'." 353 :group 'org-export-publish 354 :type 'boolean) 355 356 357 358 ;;; Timestamp-related functions 359 360 (defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) 361 "Return path to timestamp file for filename FILENAME." 362 (setq filename (concat filename "::" (or pub-dir "") "::" 363 (format "%s" (or pub-func "")))) 364 (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) 365 366 (defun org-publish-needed-p 367 (filename &optional pub-dir pub-func _true-pub-dir base-dir) 368 "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC. 369 TRUE-PUB-DIR is where the file will truly end up. Currently we 370 are not using this - maybe it can eventually be used to check if 371 the file is present at the target location, and how old it is. 372 Right now we cannot do this, because we do not know under what 373 file name the file will be stored - the publishing function can 374 still decide about that independently." 375 (let ((rtn (if (not org-publish-use-timestamps-flag) t 376 (org-publish-cache-file-needs-publishing 377 filename pub-dir pub-func base-dir)))) 378 (if rtn (message "Publishing file %s using `%s'" filename pub-func) 379 (when org-publish-list-skipped-files 380 (message "Skipping unmodified file %s" filename))) 381 rtn)) 382 383 (defun org-publish-update-timestamp 384 (filename &optional pub-dir pub-func _base-dir) 385 "Update publishing timestamp for file FILENAME. 386 If there is no timestamp, create one." 387 (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) 388 (stamp (org-publish-cache-mtime-of-src filename))) 389 (org-publish-cache-set key stamp))) 390 391 (defun org-publish-remove-all-timestamps () 392 "Remove all files in the timestamp directory." 393 (let ((dir org-publish-timestamp-directory)) 394 (when (and (file-exists-p dir) (file-directory-p dir)) 395 (mapc #'delete-file (directory-files dir 'full "[^.]\\'")) 396 (org-publish-reset-cache)))) 397 398 399 400 ;;; Getting project information out of `org-publish-project-alist' 401 402 (defun org-publish-property (property project &optional default) 403 "Return value PROPERTY, as a symbol, in PROJECT. 404 DEFAULT is returned when PROPERTY is not actually set in PROJECT 405 definition." 406 (let ((properties (cdr project))) 407 (if (plist-member properties property) 408 (plist-get properties property) 409 default))) 410 411 (defun org-publish--expand-file-name (file project) 412 "Return full file name for FILE in PROJECT. 413 When FILE is a relative file name, it is expanded according to 414 project base directory." 415 (if (file-name-absolute-p file) file 416 (expand-file-name file (org-publish-property :base-directory project)))) 417 418 (defun org-publish-expand-projects (projects-alist) 419 "Expand projects in PROJECTS-ALIST. 420 This splices all the components into the list." 421 (let ((rest projects-alist) rtn p components) 422 (while (setq p (pop rest)) 423 (if (setq components (plist-get (cdr p) :components)) 424 (setq rest (append 425 (mapcar 426 (lambda (x) 427 (or (assoc x org-publish-project-alist) 428 (user-error "Unknown component %S in project %S" 429 x (car p)))) 430 components) 431 rest)) 432 (push p rtn))) 433 (nreverse (delete-dups (delq nil rtn))))) 434 435 (defun org-publish-get-base-files (project) 436 "Return a list of all files in PROJECT." 437 (let* ((base-dir (file-name-as-directory 438 (org-publish-property :base-directory project))) 439 (extension (or (org-publish-property :base-extension project) "org")) 440 (match (if (eq extension 'any) "" 441 (format "^[^\\.].*\\.\\(%s\\)$" extension))) 442 (base-files 443 (cond ((not (file-exists-p base-dir)) nil) 444 ((not (org-publish-property :recursive project)) 445 (cl-remove-if #'file-directory-p 446 (directory-files base-dir t match t))) 447 (t 448 ;; Find all files recursively. Unlike to 449 ;; `directory-files-recursively', we follow symlinks 450 ;; to other directories. 451 (letrec ((files nil) 452 (walk-tree 453 (lambda (dir depth) 454 (when (> depth 100) 455 (error "Apparent cycle of symbolic links for %S" 456 base-dir)) 457 (dolist (f (file-name-all-completions "" dir)) 458 (pcase f 459 ((or "./" "../") nil) 460 ((pred directory-name-p) 461 (funcall walk-tree 462 (expand-file-name f dir) 463 (1+ depth))) 464 ((pred (string-match match)) 465 (push (expand-file-name f dir) files)) 466 (_ nil))) 467 files))) 468 (funcall walk-tree base-dir 0)))))) 469 (org-uniquify 470 (append 471 ;; Files from BASE-DIR. Apply exclusion filter before adding 472 ;; included files. 473 (let ((exclude-regexp (org-publish-property :exclude project))) 474 (if exclude-regexp 475 (cl-remove-if 476 (lambda (f) 477 ;; Match against relative names, yet BASE-DIR file 478 ;; names are absolute. 479 (string-match exclude-regexp 480 (file-relative-name f base-dir))) 481 base-files) 482 base-files)) 483 ;; Sitemap file. 484 (and (org-publish-property :auto-sitemap project) 485 (list (expand-file-name 486 (or (org-publish-property :sitemap-filename project) 487 "sitemap.org") 488 base-dir))) 489 ;; Included files. 490 (mapcar (lambda (f) (expand-file-name f base-dir)) 491 (org-publish-property :include project)))))) 492 493 (defun org-publish-get-project-from-filename (filename &optional up) 494 "Return a project that FILENAME belongs to. 495 When UP is non-nil, return a meta-project (i.e., with a :components part) 496 publishing FILENAME." 497 (let* ((filename (expand-file-name filename)) 498 (project 499 (cl-some 500 (lambda (p) 501 ;; Ignore meta-projects. 502 (unless (org-publish-property :components p) 503 (let ((base (expand-file-name 504 (org-publish-property :base-directory p)))) 505 (cond 506 ;; Check if FILENAME is explicitly included in one 507 ;; project. 508 ((cl-some (lambda (f) (file-equal-p f filename)) 509 (mapcar (lambda (f) (expand-file-name f base)) 510 (org-publish-property :include p))) 511 p) 512 ;; Exclude file names matching :exclude property. 513 ((let ((exclude-re (org-publish-property :exclude p))) 514 (and exclude-re 515 (string-match-p exclude-re 516 (file-relative-name filename base)))) 517 nil) 518 ;; Check :extension. Handle special `any' 519 ;; extension. 520 ((let ((extension (org-publish-property :base-extension p))) 521 (not (or (eq extension 'any) 522 (string= (or extension "org") 523 (file-name-extension filename))))) 524 nil) 525 ;; Check if FILENAME belong to project's base 526 ;; directory, or some of its sub-directories 527 ;; if :recursive in non-nil. 528 ((member filename (org-publish-get-base-files p)) p) 529 (t nil))))) 530 org-publish-project-alist))) 531 (cond 532 ((not project) nil) 533 ((not up) project) 534 ;; When optional argument UP is non-nil, return the top-most 535 ;; meta-project effectively publishing FILENAME. 536 (t 537 (letrec ((find-parent-project 538 (lambda (project) 539 (or (cl-some 540 (lambda (p) 541 (and (member (car project) 542 (org-publish-property :components p)) 543 (funcall find-parent-project p))) 544 org-publish-project-alist) 545 project)))) 546 (funcall find-parent-project project)))))) 547 548 549 550 ;;; Tools for publishing functions in back-ends 551 552 (defun org-publish-org-to (backend filename extension plist &optional pub-dir) 553 "Publish an Org file to a specified back-end. 554 555 BACKEND is a symbol representing the back-end used for 556 transcoding. FILENAME is the filename of the Org file to be 557 published. EXTENSION is the extension used for the output 558 string, with the leading dot. PLIST is the property list for the 559 given project. 560 561 Optional argument PUB-DIR, when non-nil is the publishing 562 directory. 563 564 Return output file name." 565 (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t)) 566 ;; Check if a buffer visiting FILENAME is already open. 567 (let* ((org-inhibit-startup t) 568 (visiting (find-buffer-visiting filename)) 569 (work-buffer (or visiting (find-file-noselect filename)))) 570 (unwind-protect 571 (with-current-buffer work-buffer 572 (let ((output (org-export-output-file-name extension nil pub-dir))) 573 (org-export-to-file backend output 574 nil nil nil (plist-get plist :body-only) 575 ;; Add `org-publish--store-crossrefs' and 576 ;; `org-publish-collect-index' to final output filters. 577 ;; The latter isn't dependent on `:makeindex', since we 578 ;; want to keep it up-to-date in cache anyway. 579 (org-combine-plists 580 plist 581 `(:crossrefs 582 ,(org-publish-cache-get-file-property 583 ;; Normalize file names in cache. 584 (file-truename filename) :crossrefs nil t) 585 :filter-final-output 586 (org-publish--store-crossrefs 587 org-publish-collect-index 588 ,@(plist-get plist :filter-final-output))))))) 589 ;; Remove opened buffer in the process. 590 (unless visiting (kill-buffer work-buffer))))) 591 592 (defun org-publish-attachment (_plist filename pub-dir) 593 "Publish a file with no transformation of any kind. 594 595 FILENAME is the filename of the Org file to be published. PLIST 596 is the property list for the given project. PUB-DIR is the 597 publishing directory. 598 599 Return output file name." 600 (unless (file-directory-p pub-dir) 601 (make-directory pub-dir t)) 602 (let ((output (expand-file-name (file-name-nondirectory filename) pub-dir))) 603 (unless (file-equal-p (expand-file-name (file-name-directory filename)) 604 (file-name-as-directory (expand-file-name pub-dir))) 605 (copy-file filename output t)) 606 ;; Return file name. 607 output)) 608 609 610 611 ;;; Publishing files, sets of files 612 613 (defun org-publish-file (filename &optional project no-cache) 614 "Publish file FILENAME from PROJECT. 615 If NO-CACHE is not nil, do not initialize `org-publish-cache'. 616 This is needed, since this function is used to publish single 617 files, when entire projects are published (see 618 `org-publish-projects')." 619 (let* ((project 620 (or project 621 (org-publish-get-project-from-filename filename) 622 (user-error "File %S is not part of any known project" 623 (abbreviate-file-name filename)))) 624 (project-plist (cdr project)) 625 (publishing-function 626 (pcase (org-publish-property :publishing-function project 627 'org-html-publish-to-html) 628 (`nil (user-error "No publishing function chosen")) 629 ((and f (pred listp)) f) 630 (f (list f)))) 631 (base-dir 632 (file-name-as-directory 633 (or (org-publish-property :base-directory project) 634 (user-error "Project %S does not have :base-directory defined" 635 (car project))))) 636 (pub-base-dir 637 (file-name-as-directory 638 (or (org-publish-property :publishing-directory project) 639 (user-error 640 "Project %S does not have :publishing-directory defined" 641 (car project))))) 642 (pub-dir 643 (file-name-directory 644 (expand-file-name (file-relative-name filename base-dir) 645 pub-base-dir)))) 646 647 (unless no-cache (org-publish-initialize-cache (car project))) 648 649 ;; Allow chain of publishing functions. 650 (dolist (f publishing-function) 651 (when (org-publish-needed-p filename pub-base-dir f pub-dir base-dir) 652 (let ((output (funcall f project-plist filename pub-dir))) 653 (org-publish-update-timestamp filename pub-base-dir f base-dir) 654 (run-hook-with-args 'org-publish-after-publishing-hook 655 filename 656 output)))) 657 ;; Make sure to write cache to file after successfully publishing 658 ;; a file, so as to minimize impact of a publishing failure. 659 (org-publish-write-cache-file))) 660 661 (defun org-publish-projects (projects) 662 "Publish all files belonging to the PROJECTS alist. 663 If `:auto-sitemap' is set, publish the sitemap too. If 664 `:makeindex' is set, also produce a file \"theindex.org\"." 665 (dolist (project (org-publish-expand-projects projects)) 666 (let ((plist (cdr project))) 667 (let ((fun (org-publish-property :preparation-function project))) 668 (cond 669 ((functionp fun) (funcall fun plist)) 670 ((consp fun) (dolist (f fun) (funcall f plist))))) 671 ;; Each project uses its own cache file. 672 (org-publish-initialize-cache (car project)) 673 (when (org-publish-property :auto-sitemap project) 674 (let ((sitemap-filename 675 (or (org-publish-property :sitemap-filename project) 676 "sitemap.org"))) 677 (org-publish-sitemap project sitemap-filename))) 678 ;; Publish all files from PROJECT except "theindex.org". Its 679 ;; publishing will be deferred until "theindex.inc" is 680 ;; populated. 681 (let ((theindex 682 (expand-file-name "theindex.org" 683 (org-publish-property :base-directory project)))) 684 (dolist (file (org-publish-get-base-files project)) 685 (unless (file-equal-p file theindex) 686 (org-publish-file file project t))) 687 ;; Populate "theindex.inc", if needed, and publish 688 ;; "theindex.org". 689 (when (org-publish-property :makeindex project) 690 (org-publish-index-generate-theindex 691 project (org-publish-property :base-directory project)) 692 (org-publish-file theindex project t))) 693 (let ((fun (org-publish-property :completion-function project))) 694 (cond 695 ((functionp fun) (funcall fun plist)) 696 ((consp fun) (dolist (f fun) (funcall f plist)))))) 697 (org-publish-write-cache-file))) 698 699 700 ;;; Site map generation 701 702 (defun org-publish--sitemap-files-to-lisp (files project style format-entry) 703 "Represent FILES as a parsed plain list. 704 FILES is the list of files in the site map. PROJECT is the 705 current project. STYLE determines is either `list' or `tree'. 706 FORMAT-ENTRY is a function called on each file which should 707 return a string. Return value is a list as returned by 708 `org-list-to-lisp'." 709 (let ((root (expand-file-name 710 (file-name-as-directory 711 (org-publish-property :base-directory project))))) 712 (pcase style 713 (`list 714 (cons 'unordered 715 (mapcar 716 (lambda (f) 717 (list (funcall format-entry 718 (file-relative-name f root) 719 style 720 project))) 721 files))) 722 (`tree 723 (letrec ((files-only (cl-remove-if #'directory-name-p files)) 724 (directories (cl-remove-if-not #'directory-name-p files)) 725 (subtree-to-list 726 (lambda (dir) 727 (cons 'unordered 728 (nconc 729 ;; Files in DIR. 730 (mapcar 731 (lambda (f) 732 (list (funcall format-entry 733 (file-relative-name f root) 734 style 735 project))) 736 (cl-remove-if-not 737 (lambda (f) (string= dir (file-name-directory f))) 738 files-only)) 739 ;; Direct sub-directories. 740 (mapcar 741 (lambda (sub) 742 (list (funcall format-entry 743 (file-relative-name sub root) 744 style 745 project) 746 (funcall subtree-to-list sub))) 747 (cl-remove-if-not 748 (lambda (f) 749 (string= 750 dir 751 ;; Parent directory. 752 (file-name-directory (directory-file-name f)))) 753 directories))))))) 754 (funcall subtree-to-list root))) 755 (_ (user-error "Unknown site-map style: `%s'" style))))) 756 757 (defun org-publish-sitemap (project &optional sitemap-filename) 758 "Create a sitemap of pages in set defined by PROJECT. 759 Optionally set the filename of the sitemap with SITEMAP-FILENAME. 760 Default for SITEMAP-FILENAME is `sitemap.org'." 761 (let* ((root (expand-file-name 762 (file-name-as-directory 763 (org-publish-property :base-directory project)))) 764 (sitemap-filename (expand-file-name (or sitemap-filename "sitemap.org") 765 root)) 766 (title (or (org-publish-property :sitemap-title project) 767 (concat "Sitemap for project " (car project)))) 768 (style (or (org-publish-property :sitemap-style project) 769 'tree)) 770 (sitemap-builder (or (org-publish-property :sitemap-function project) 771 #'org-publish-sitemap-default)) 772 (format-entry (or (org-publish-property :sitemap-format-entry project) 773 #'org-publish-sitemap-default-entry)) 774 (sort-folders 775 (org-publish-property :sitemap-sort-folders project 776 org-publish-sitemap-sort-folders)) 777 (sort-files 778 (org-publish-property :sitemap-sort-files project 779 org-publish-sitemap-sort-files)) 780 (ignore-case 781 (org-publish-property :sitemap-ignore-case project 782 org-publish-sitemap-sort-ignore-case)) 783 (org-file-p (lambda (f) (equal "org" (file-name-extension f)))) 784 (sort-predicate 785 (lambda (a b) 786 (let ((retval t)) 787 ;; First we sort files: 788 (pcase sort-files 789 (`alphabetically 790 (let ((A (if (funcall org-file-p a) 791 (concat (file-name-directory a) 792 (org-publish-find-title a project)) 793 a)) 794 (B (if (funcall org-file-p b) 795 (concat (file-name-directory b) 796 (org-publish-find-title b project)) 797 b))) 798 (setq retval 799 (if ignore-case 800 (not (string-lessp (upcase B) (upcase A))) 801 (not (string-lessp B A)))))) 802 ((or `anti-chronologically `chronologically) 803 (let* ((adate (org-publish-find-date a project)) 804 (bdate (org-publish-find-date b project))) 805 (setq retval 806 (not (if (eq sort-files 'chronologically) 807 (time-less-p bdate adate) 808 (time-less-p adate bdate)))))) 809 (`nil nil) 810 (_ (user-error "Invalid sort value %s" sort-files))) 811 ;; Directory-wise wins: 812 (when (memq sort-folders '(first last)) 813 ;; a is directory, b not: 814 (cond 815 ((and (file-directory-p a) (not (file-directory-p b))) 816 (setq retval (eq sort-folders 'first))) 817 ;; a is not a directory, but b is: 818 ((and (not (file-directory-p a)) (file-directory-p b)) 819 (setq retval (eq sort-folders 'last))))) 820 retval)))) 821 (message "Generating sitemap for %s" title) 822 (with-temp-file sitemap-filename 823 (insert 824 (let ((files (remove sitemap-filename 825 (org-publish-get-base-files project)))) 826 ;; Add directories, if applicable. 827 (unless (and (eq style 'list) (eq sort-folders 'ignore)) 828 (setq files 829 (nconc (remove root (org-uniquify 830 (mapcar #'file-name-directory files))) 831 files))) 832 ;; Eventually sort all entries. 833 (when (or sort-files (not (memq sort-folders 'ignore))) 834 (setq files (sort files sort-predicate))) 835 (funcall sitemap-builder 836 title 837 (org-publish--sitemap-files-to-lisp 838 files project style format-entry))))))) 839 840 (defun org-publish-find-property (file property project &optional backend) 841 "Find the PROPERTY of FILE in project. 842 843 PROPERTY is a keyword referring to an export option, as defined 844 in `org-export-options-alist' or in export back-ends. In the 845 latter case, optional argument BACKEND has to be set to the 846 back-end where the option is defined, e.g., 847 848 (org-publish-find-property file :subtitle \\='latex) 849 850 Return value may be a string or a list, depending on the type of 851 PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'." 852 (let ((file (org-publish--expand-file-name file project))) 853 (when (and (file-readable-p file) (not (directory-name-p file))) 854 (let* ((org-inhibit-startup t) 855 (visiting (find-buffer-visiting file)) 856 (buffer (or visiting (find-file-noselect file)))) 857 (unwind-protect 858 (plist-get (with-current-buffer buffer 859 (if (not visiting) (org-export-get-environment backend) 860 ;; Protect local variables in open buffers. 861 (org-export-with-buffer-copy 862 (org-export-get-environment backend)))) 863 property) 864 (unless visiting (kill-buffer buffer))))))) 865 866 (defun org-publish-find-title (file project) 867 "Find the title of FILE in PROJECT." 868 (let ((file (org-publish--expand-file-name file project))) 869 (or (org-publish-cache-get-file-property file :title nil t) 870 (let* ((parsed-title (org-publish-find-property file :title project)) 871 (title 872 (if parsed-title 873 ;; Remove property so that the return value is 874 ;; cache-able (i.e., it can be `read' back). 875 (org-no-properties 876 (org-element-interpret-data parsed-title)) 877 (file-name-nondirectory (file-name-sans-extension file))))) 878 (org-publish-cache-set-file-property file :title title))))) 879 880 (defun org-publish-find-date (file project) 881 "Find the date of FILE in PROJECT. 882 This function assumes FILE is either a directory or an Org file. 883 If FILE is an Org file and provides a DATE keyword use it. In 884 any other case use the file system's modification time. Return 885 time in `current-time' format." 886 (let ((file (org-publish--expand-file-name file project))) 887 (or (org-publish-cache-get-file-property file :date nil t) 888 (org-publish-cache-set-file-property 889 file :date 890 (if (file-directory-p file) 891 (file-attribute-modification-time (file-attributes file)) 892 (let ((date (org-publish-find-property file :date project))) 893 ;; DATE is a secondary string. If it contains 894 ;; a time-stamp, convert it to internal format. 895 ;; Otherwise, use FILE modification time. 896 (cond ((let ((ts (and (consp date) (assq 'timestamp date)))) 897 (and ts 898 (let ((value (org-element-interpret-data ts))) 899 (and (org-string-nw-p value) 900 (org-time-string-to-time value)))))) 901 ((file-exists-p file) 902 (file-attribute-modification-time (file-attributes file))) 903 (t (error "No such file: \"%s\"" file))))))))) 904 905 (defun org-publish-sitemap-default-entry (entry style project) 906 "Default format for site map ENTRY, as a string. 907 ENTRY is a file name. STYLE is the style of the sitemap. 908 PROJECT is the current project." 909 (cond ((not (directory-name-p entry)) 910 (format "[[file:%s][%s]]" 911 entry 912 (org-publish-find-title entry project))) 913 ((eq style 'tree) 914 ;; Return only last subdir. 915 (file-name-nondirectory (directory-file-name entry))) 916 (t entry))) 917 918 (defun org-publish-sitemap-default (title list) 919 "Default site map, as a string. 920 TITLE is the title of the site map. LIST is an internal 921 representation for the files to include, as returned by 922 `org-list-to-lisp'. PROJECT is the current project." 923 (concat "#+TITLE: " title "\n\n" 924 (org-list-to-org list))) 925 926 927 ;;; Interactive publishing functions 928 929 ;;;###autoload 930 (defalias 'org-publish-project 'org-publish) 931 932 ;;;###autoload 933 (defun org-publish (project &optional force async) 934 "Publish PROJECT. 935 936 PROJECT is either a project name, as a string, or a project 937 alist (see `org-publish-project-alist' variable). 938 939 When optional argument FORCE is non-nil, force publishing all 940 files in PROJECT. With a non-nil optional argument ASYNC, 941 publishing will be done asynchronously, in another process." 942 (interactive 943 (list (assoc (completing-read "Publish project: " 944 org-publish-project-alist nil t) 945 org-publish-project-alist) 946 current-prefix-arg)) 947 (let ((project (if (not (stringp project)) project 948 ;; If this function is called in batch mode, 949 ;; PROJECT is still a string here. 950 (assoc project org-publish-project-alist)))) 951 (cond 952 ((not project)) 953 (async 954 (org-export-async-start (lambda (_) nil) 955 `(let ((org-publish-use-timestamps-flag 956 ,(and (not force) org-publish-use-timestamps-flag))) 957 ;; Expand components right now as external process may not 958 ;; be aware of complete `org-publish-project-alist'. 959 (org-publish-projects 960 ',(org-publish-expand-projects (list project)))))) 961 (t (save-window-excursion 962 (let ((org-publish-use-timestamps-flag 963 (and (not force) org-publish-use-timestamps-flag))) 964 (org-publish-projects (list project)))))))) 965 966 ;;;###autoload 967 (defun org-publish-all (&optional force async) 968 "Publish all projects. 969 With prefix argument FORCE, remove all files in the timestamp 970 directory and force publishing all projects. With a non-nil 971 optional argument ASYNC, publishing will be done asynchronously, 972 in another process." 973 (interactive "P") 974 (if async 975 (org-export-async-start (lambda (_) nil) 976 `(progn 977 (when ',force (org-publish-remove-all-timestamps)) 978 (let ((org-publish-use-timestamps-flag 979 (if ',force nil ,org-publish-use-timestamps-flag))) 980 (org-publish-projects ',org-publish-project-alist)))) 981 (when force (org-publish-remove-all-timestamps)) 982 (save-window-excursion 983 (let ((org-publish-use-timestamps-flag 984 (if force nil org-publish-use-timestamps-flag))) 985 (org-publish-projects org-publish-project-alist))))) 986 987 988 ;;;###autoload 989 (defun org-publish-current-file (&optional force async) 990 "Publish the current file. 991 With prefix argument FORCE, force publish the file. When 992 optional argument ASYNC is non-nil, publishing will be done 993 asynchronously, in another process." 994 (interactive "P") 995 (let ((file (buffer-file-name (buffer-base-buffer)))) 996 (if async 997 (org-export-async-start (lambda (_) nil) 998 `(let ((org-publish-use-timestamps-flag 999 (if ',force nil ,org-publish-use-timestamps-flag))) 1000 (org-publish-file ,file))) 1001 (save-window-excursion 1002 (let ((org-publish-use-timestamps-flag 1003 (if force nil org-publish-use-timestamps-flag))) 1004 (org-publish-file file)))))) 1005 1006 ;;;###autoload 1007 (defun org-publish-current-project (&optional force async) 1008 "Publish the project associated with the current file. 1009 With a prefix argument, force publishing of all files in 1010 the project." 1011 (interactive "P") 1012 (save-window-excursion 1013 (let ((project (org-publish-get-project-from-filename 1014 (buffer-file-name (buffer-base-buffer)) 'up))) 1015 (if project (org-publish project force async) 1016 (error "File %s is not part of any known project" 1017 (buffer-file-name (buffer-base-buffer))))))) 1018 1019 1020 1021 ;;; Index generation 1022 1023 (defun org-publish-collect-index (output _backend info) 1024 "Update index for a file in cache. 1025 1026 OUTPUT is the output from transcoding current file. BACKEND is 1027 the back-end that was used for transcoding. INFO is a plist 1028 containing publishing and export options. 1029 1030 The index relative to current file is stored as an alist. An 1031 association has the following shape: (TERM FILE-NAME PARENT), 1032 where TERM is the indexed term, as a string, FILE-NAME is the 1033 original full path of the file where the term in encountered, and 1034 PARENT is a reference to the headline, if any, containing the 1035 original index keyword. When non-nil, this reference is a cons 1036 cell. Its CAR is a symbol among `id', `custom-id' and `name' and 1037 its CDR is a string." 1038 (let ((file (file-truename (plist-get info :input-file)))) 1039 (org-publish-cache-set-file-property 1040 file :index 1041 (delete-dups 1042 (org-element-map (plist-get info :parse-tree) 'keyword 1043 (lambda (k) 1044 (when (equal (org-element-property :key k) "INDEX") 1045 (let ((parent (org-export-get-parent-headline k))) 1046 (list (org-element-property :value k) 1047 file 1048 (cond 1049 ((not parent) nil) 1050 ((let ((id (org-element-property :ID parent))) 1051 (and id (cons 'id id)))) 1052 ((let ((id (org-element-property :CUSTOM_ID parent))) 1053 (and id (cons 'custom-id id)))) 1054 (t (cons 'name 1055 ;; Remove statistics cookie. 1056 (replace-regexp-in-string 1057 "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" 1058 (org-element-property :raw-value parent))))))))) 1059 info)))) 1060 ;; Return output unchanged. 1061 output) 1062 1063 (defun org-publish-index-generate-theindex (project directory) 1064 "Retrieve full index from cache and build \"theindex.org\". 1065 PROJECT is the project the index relates to. DIRECTORY is the 1066 publishing directory." 1067 (let ((all-files (org-publish-get-base-files project)) 1068 full-index) 1069 ;; Compile full index and sort it alphabetically. 1070 (dolist (file all-files 1071 (setq full-index 1072 (sort (nreverse full-index) 1073 (lambda (a b) (string< (downcase (car a)) 1074 (downcase (car b))))))) 1075 (let ((index (org-publish-cache-get-file-property file :index))) 1076 (dolist (term index) 1077 (unless (member term full-index) (push term full-index))))) 1078 ;; Write "theindex.inc" in DIRECTORY. 1079 (with-temp-file (expand-file-name "theindex.inc" directory) 1080 (let ((current-letter nil) (last-entry nil)) 1081 (dolist (idx full-index) 1082 (let* ((entry (org-split-string (car idx) "!")) 1083 (letter (upcase (substring (car entry) 0 1))) 1084 ;; Transform file into a path relative to publishing 1085 ;; directory. 1086 (file (file-relative-name 1087 (nth 1 idx) 1088 (plist-get (cdr project) :base-directory)))) 1089 ;; Check if another letter has to be inserted. 1090 (unless (string= letter current-letter) 1091 (insert (format "* %s\n" letter))) 1092 ;; Compute the first difference between last entry and 1093 ;; current one: it tells the level at which new items 1094 ;; should be added. 1095 (let* ((rank 1096 (if (equal entry last-entry) (1- (length entry)) 1097 (cl-loop for n from 0 to (length entry) 1098 unless (equal (nth n entry) (nth n last-entry)) 1099 return n))) 1100 (len (length (nthcdr rank entry)))) 1101 ;; For each term after the first difference, create 1102 ;; a new sub-list with the term as body. Moreover, 1103 ;; linkify the last term. 1104 (dotimes (n len) 1105 (insert 1106 (concat 1107 (make-string (* (+ rank n) 2) ?\s) " - " 1108 (if (not (= (1- len) n)) (nth (+ rank n) entry) 1109 ;; Last term: Link it to TARGET, if possible. 1110 (let ((target (nth 2 idx))) 1111 (format 1112 "[[%s][%s]]" 1113 ;; Destination. 1114 (pcase (car target) 1115 (`nil (format "file:%s" file)) 1116 (`id (format "id:%s" (cdr target))) 1117 (`custom-id (format "file:%s::#%s" file (cdr target))) 1118 (_ (format "file:%s::*%s" file (cdr target)))) 1119 ;; Description. 1120 (car (last entry))))) 1121 "\n")))) 1122 (setq current-letter letter last-entry entry)))) 1123 ;; Create "theindex.org", if it doesn't exist yet, and provide 1124 ;; a default index file. 1125 (let ((index.org (expand-file-name "theindex.org" directory))) 1126 (unless (file-exists-p index.org) 1127 (with-temp-file index.org 1128 (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n"))))))) 1129 1130 1131 1132 ;;; External Fuzzy Links Resolution 1133 ;; 1134 ;; This part implements tools to resolve [[file.org::*Some headline]] 1135 ;; links, where "file.org" belongs to the current project. 1136 1137 (defun org-publish--store-crossrefs (output _backend info) 1138 "Store cross-references for current published file. 1139 1140 OUTPUT is the produced output, as a string. BACKEND is the export 1141 back-end used, as a symbol. INFO is the final export state, as 1142 a plist. 1143 1144 This function is meant to be used as a final output filter. See 1145 `org-publish-org-to'." 1146 (org-publish-cache-set-file-property 1147 (file-truename (plist-get info :input-file)) 1148 :crossrefs 1149 ;; Update `:crossrefs' so as to remove unused references and search 1150 ;; cells. Actually used references are extracted from 1151 ;; `:internal-references', with references as strings removed. See 1152 ;; `org-export-get-reference' for details. 1153 (cl-remove-if (lambda (pair) (stringp (car pair))) 1154 (plist-get info :internal-references))) 1155 ;; Return output unchanged. 1156 output) 1157 1158 (defun org-publish-resolve-external-link (search file &optional prefer-custom) 1159 "Return reference for element matching string SEARCH in FILE. 1160 1161 Return value is an internal reference, as a string. 1162 1163 This function allows resolving external links with a search 1164 option, e.g., 1165 1166 [[file:file.org::*heading][description]] 1167 [[file:file.org::#custom-id][description]] 1168 [[file:file.org::fuzzy][description]] 1169 1170 When PREFER-CUSTOM is non-nil, and SEARCH targets a headline in 1171 FILE, return its custom ID, if any. 1172 1173 It only makes sense to use this if export back-end builds 1174 references with `org-export-get-reference'." 1175 (cond 1176 ((and prefer-custom 1177 (if (string-prefix-p "#" search) 1178 (substring search 1) 1179 (with-current-buffer (find-file-noselect file) 1180 (org-with-point-at 1 1181 (let ((org-link-search-must-match-exact-headline t)) 1182 (condition-case err 1183 (org-link-search search nil t) 1184 (error 1185 (signal 'org-link-broken (cdr err))))) 1186 (and (org-at-heading-p) 1187 (org-string-nw-p (org-entry-get (point) "CUSTOM_ID")))))))) 1188 ((not org-publish-cache) 1189 (progn 1190 (message "Reference %S in file %S cannot be resolved without publishing" 1191 search 1192 file) 1193 "MissingReference")) 1194 (t 1195 (let* ((filename (file-truename file)) 1196 (crossrefs 1197 (org-publish-cache-get-file-property filename :crossrefs nil t)) 1198 (cells (org-export-string-to-search-cell search))) 1199 (or 1200 ;; Look for reference associated to search cells triggered by 1201 ;; LINK. It can match when targeted file has been published 1202 ;; already. 1203 (let ((known (cdr (cl-some (lambda (c) (assoc c crossrefs)) cells)))) 1204 (and known (org-export-format-reference known))) 1205 ;; Search cell is unknown so far. Generate a new internal 1206 ;; reference that will be used when the targeted file will be 1207 ;; published. 1208 (let ((new (org-export-new-reference crossrefs))) 1209 (dolist (cell cells) (push (cons cell new) crossrefs)) 1210 (org-publish-cache-set-file-property filename :crossrefs crossrefs) 1211 (org-export-format-reference new))))))) 1212 1213 (defun org-publish-file-relative-name (filename info) 1214 "Convert FILENAME to be relative to current project's base directory. 1215 INFO is the plist containing the current export state. The 1216 function does not change relative file names." 1217 (let ((base (plist-get info :base-directory))) 1218 (if (and base 1219 (file-name-absolute-p filename) 1220 (file-in-directory-p filename base)) 1221 (file-relative-name filename base) 1222 filename))) 1223 1224 1225 1226 ;;; Caching functions 1227 1228 (defun org-publish-write-cache-file (&optional free-cache) 1229 "Write `org-publish-cache' to file. 1230 If FREE-CACHE, empty the cache." 1231 (unless org-publish-cache 1232 (error "`org-publish-write-cache-file' called, but no cache present")) 1233 1234 (let ((cache-file (org-publish-cache-get ":cache-file:"))) 1235 (unless cache-file 1236 (error "Cannot find cache-file name in `org-publish-write-cache-file'")) 1237 (with-temp-file cache-file 1238 (let (print-level print-length) 1239 (insert "(setq org-publish-cache \ 1240 \(make-hash-table :test 'equal :weakness nil :size 100))\n") 1241 (maphash (lambda (k v) 1242 (insert 1243 (format "(puthash %S %s%S org-publish-cache)\n" 1244 k (if (or (listp v) (symbolp v)) "'" "") v))) 1245 org-publish-cache))) 1246 (when free-cache (org-publish-reset-cache)))) 1247 1248 (defun org-publish-initialize-cache (project-name) 1249 "Initialize the projects cache if not initialized yet and return it." 1250 1251 (unless project-name 1252 (error "Cannot initialize `org-publish-cache' without projects name in \ 1253 `org-publish-initialize-cache'")) 1254 1255 (unless (file-exists-p org-publish-timestamp-directory) 1256 (make-directory org-publish-timestamp-directory t)) 1257 (unless (file-directory-p org-publish-timestamp-directory) 1258 (error "Org publish timestamp: %s is not a directory" 1259 org-publish-timestamp-directory)) 1260 1261 (unless (and org-publish-cache 1262 (string= (org-publish-cache-get ":project:") project-name)) 1263 (let* ((cache-file 1264 (concat 1265 (expand-file-name org-publish-timestamp-directory) 1266 project-name ".cache")) 1267 (cexists (file-exists-p cache-file))) 1268 1269 (when org-publish-cache (org-publish-reset-cache)) 1270 1271 (if cexists (load-file cache-file) 1272 (setq org-publish-cache 1273 (make-hash-table :test 'equal :weakness nil :size 100)) 1274 (org-publish-cache-set ":project:" project-name) 1275 (org-publish-cache-set ":cache-file:" cache-file)) 1276 (unless cexists (org-publish-write-cache-file nil)))) 1277 org-publish-cache) 1278 1279 (defun org-publish-reset-cache () 1280 "Empty `org-publish-cache' and reset it nil." 1281 (message "%s" "Resetting org-publish-cache") 1282 (when (hash-table-p org-publish-cache) 1283 (clrhash org-publish-cache)) 1284 (setq org-publish-cache nil)) 1285 1286 (defun org-publish-cache-file-needs-publishing 1287 (filename &optional pub-dir pub-func _base-dir) 1288 "Check the timestamp of the last publishing of FILENAME. 1289 Return non-nil if the file needs publishing. Also check if 1290 any included files have been more recently published, so that 1291 the file including them will be republished as well." 1292 (unless org-publish-cache 1293 (error 1294 "`org-publish-cache-file-needs-publishing' called, but no cache present")) 1295 (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) 1296 (pstamp (org-publish-cache-get key)) 1297 (org-inhibit-startup t) 1298 included-files-mtime) 1299 (when (equal (file-name-extension filename) "org") 1300 (let ((case-fold-search t)) 1301 (with-temp-buffer 1302 (delay-mode-hooks 1303 (org-mode) 1304 (insert-file-contents filename) 1305 (goto-char (point-min)) 1306 (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t) 1307 (let ((element (org-element-at-point))) 1308 (when (eq 'keyword (org-element-type element)) 1309 (let* ((value (org-element-property :value element)) 1310 (include-filename 1311 (and (string-match "\\`\\(\".+?\"\\|\\S-+\\)" value) 1312 (let ((m (org-strip-quotes 1313 (match-string 1 value)))) 1314 ;; Ignore search suffix. 1315 (if (string-match "::.*?\\'" m) 1316 (substring m 0 (match-beginning 0)) 1317 m))))) 1318 (when include-filename 1319 (push (org-publish-cache-mtime-of-src 1320 (expand-file-name include-filename (file-name-directory filename))) 1321 included-files-mtime)))))))))) 1322 (or (null pstamp) 1323 (let ((mtime (org-publish-cache-mtime-of-src filename))) 1324 (or (time-less-p pstamp mtime) 1325 (cl-some (lambda (ct) (time-less-p mtime ct)) 1326 included-files-mtime)))))) 1327 1328 (defun org-publish-cache-set-file-property 1329 (filename property value &optional project-name) 1330 "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. 1331 Use cache file of PROJECT-NAME. If the entry does not exist, it 1332 will be created. Return VALUE." 1333 ;; Evtl. load the requested cache file: 1334 (when project-name (org-publish-initialize-cache project-name)) 1335 (let ((pl (org-publish-cache-get filename))) 1336 (if pl (progn (plist-put pl property value) value) 1337 (org-publish-cache-get-file-property 1338 filename property value nil project-name)))) 1339 1340 (defun org-publish-cache-get-file-property 1341 (filename property &optional default no-create project-name) 1342 "Return the value for a PROPERTY of file FILENAME in publishing cache. 1343 Use cache file of PROJECT-NAME. Return the value of that PROPERTY, 1344 or DEFAULT, if the value does not yet exist. Create the entry, 1345 if necessary, unless NO-CREATE is non-nil." 1346 (when project-name (org-publish-initialize-cache project-name)) 1347 (let ((properties (org-publish-cache-get filename))) 1348 (cond ((null properties) 1349 (unless no-create 1350 (org-publish-cache-set filename (list property default))) 1351 default) 1352 ((plist-member properties property) (plist-get properties property)) 1353 (t default)))) 1354 1355 (defun org-publish-cache-get (key) 1356 "Return the value stored in `org-publish-cache' for key KEY. 1357 Return nil, if no value or nil is found. Raise an error if the 1358 cache does not exist." 1359 (unless org-publish-cache 1360 (error "`org-publish-cache-get' called, but no cache present")) 1361 (gethash key org-publish-cache)) 1362 1363 (defun org-publish-cache-set (key value) 1364 "Store KEY VALUE pair in `org-publish-cache'. 1365 Returns value on success, else nil. Raise an error if the cache 1366 does not exist." 1367 (unless org-publish-cache 1368 (error "`org-publish-cache-set' called, but no cache present")) 1369 (puthash key value org-publish-cache)) 1370 1371 (defun org-publish-cache-mtime-of-src (file) 1372 "Get the mtime of FILE as an integer." 1373 (let ((attr (file-attributes 1374 (expand-file-name (or (file-symlink-p file) file) 1375 (file-name-directory file))))) 1376 (if attr (file-attribute-modification-time attr) 1377 (error "No such file: %S" file)))) 1378 1379 1380 (provide 'ox-publish) 1381 1382 ;; Local variables: 1383 ;; generated-autoload-file: "org-loaddefs.el" 1384 ;; End: 1385 1386 ;;; ox-publish.el ends here