lisp/muse-publish.el

   1 ;;; muse-publish.el --- base publishing implementation
   2
   3 ;; Copyright (C) 2004, 2005  Free Software Foundation, Inc.
   4
   5 ;; This file is not part of GNU Emacs.
   6
   7 ;; This is free software; you can redistribute it and/or modify it under
   8 ;; the terms of the GNU General Public License as published by the Free
   9 ;; Software Foundation; either version 2, or (at your option) any later
  10 ;; version.
  11 ;;
  12 ;; This is distributed in the hope that it will be useful, but WITHOUT
  13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 ;; for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 ;; Boston, MA 02110-1301, USA.
  21
  22 ;;; Commentary:
  23
  24 ;;; Contributors:
  25
  26 ;; Yann Hodique (yann DOT hodique AT gmail DOT com) fixed an
  27 ;; unnecessary URL description transform in `muse-publish-url'.
  28 ;;
  29 ;; Peter K. Lee (saint AT corenova DOT com) provided the
  30 ;; `muse-style-elements-list' function.
  31
  32 ;;; Code:
  33
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35 ;;
  36 ;; Muse Publishing
  37 ;;
  38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39
  40 (require 'muse)
  41 (require 'muse-regexps)
  42
  43 (defgroup muse-publish nil
  44   "Options controlling the general behavior of Muse publishing."
  45   :group 'muse)
  46
  47 (defcustom muse-before-publish-hook nil
  48   "A hook run in the buffer to be published, before it is done."
  49   :type 'hook
  50   :group 'muse-publish)
  51
  52 (defcustom muse-after-publish-hook nil
  53   "A hook run in the buffer to be published, after it is done."
  54   :type 'hook
  55   :group 'muse-publish)
  56
  57 (defcustom muse-publish-url-transforms
  58   '(muse-publish-escape-specials-in-string
  59     muse-publish-prepare-url
  60     muse-resolve-url)
  61   "A list of functions used to prepare URLs for publication.
  62 Each is passed the URL.  The transformed URL should be returned."
  63   :type 'hook
  64   :options '(muse-publish-escape-specials-in-string
  65              muse-publish-prepare-url
  66              muse-resolve-url)
  67   :group 'muse-publish)
  68
  69 (defcustom muse-publish-desc-transforms
  70   '(muse-publish-escape-specials-in-string)
  71   "A list of functions used to prepare URL desciptions for publication.
  72 Each is passed the description.  The modified description should
  73 be returned."
  74   :type 'hook
  75   :options '(muse-publish-escape-specials-in-string)
  76   :group 'muse-publish)
  77
  78 (defcustom muse-publish-report-threshhold 100000
  79   "If a file is this size or larger, report publishing progress."
  80   :type 'integer
  81   :group 'muse-publish)
  82
  83 (defcustom muse-publish-markup-regexps
  84   `(;; Remove leading and trailing whitespace from the file
  85     (1000 "\\(\\`\n+\\|\n+\\'\\)" 0 "")
  86
  87     ;; Remove trailing whitespace from all lines
  88     (1100 ,(concat "[" muse-regexp-blank "]+$") 0 "")
  89
  90     ;; Handle any leading #directives
  91     (1200 "\\`#\\([a-zA-Z]+\\)\\s-+\\(.+\\)\n+" 0 directive)
  92
  93     ;; markup tags
  94     (1300 muse-tag-regexp 0 tag)
  95
  96     ;; commented lines
  97     (1350 "^;\\s-+\\(.+\\)" 0 comment)
  98
  99     ;; define anchor points
 100     (1400 "^\\(\\W*\\)#\\(\\S-+\\)\\s-*" 0 anchor)
 101
 102     ;; prevent emphasis characters in explicit links from being marked
 103     (1500 muse-explicit-link-regexp 0 muse-publish-mark-noemphasis)
 104
 105     ;; emphasized or literal text
 106     (1600 ,(concat
 107             "\\(^\\|[-["
 108             muse-regexp-space
 109             "<('`\"]\\)\\(=[^="
 110             muse-regexp-space
 111             "]\\|_[^_"
 112             muse-regexp-space
 113             "]\\|\\*+[^*"
 114             muse-regexp-space
 115             "]\\)")
 116           2 word)
 117
 118     ;; headings, outline-mode style
 119     (1700 "^\\(\\*+\\)\\s-+" 0 heading)
 120
 121     ;; ellipses
 122     (1800 "\\.\\.\\.\\." 0 enddots)
 123     (1850 "\\.\\.\\." 0 dots)
 124
 125     ;; horizontal rule, or section separator
 126     (1900 "^----+" 0 rule)
 127
 128     ;; beginning of footnotes section
 129     (2000 "^Footnotes:?\\s-*" 0 fn-sep)
 130     ;; footnote definition/reference (def if at beginning of line)
 131     (2100 "\\[\\([1-9][0-9]*\\)\\]" 0 footnote)
 132
 133     ;; unnumbered List items begin with a -.  numbered list items
 134     ;; begin with number and a period.  definition lists have a
 135     ;; leading term separated from the body with ::.  centered
 136     ;; paragraphs begin with at least six columns of whitespace; any
 137     ;; other whitespace at the beginning indicates a blockquote.  The
 138     ;; reason all of these rules are handled here, is so that
 139     ;; blockquote detection doesn't interfere with indented list
 140     ;; members.
 141     (2200 ,(concat "^["
 142                    muse-regexp-blank
 143                    "]+\\(-["
 144                    muse-regexp-blank
 145                    "]*\\|[0-9]+\\.["
 146                    muse-regexp-blank
 147                    "]*\\|\\(?:.+?\\)["
 148                    muse-regexp-blank
 149                    "]+::\n?\\)")
 150           1 list)
 151
 152     (2300 ,(concat "^\\(\\(?:.+?\\)["
 153                    muse-regexp-blank
 154                    "]+::\n?\\)")
 155           0 list)
 156
 157     (2400 ,(concat "^\\(["
 158                    muse-regexp-blank
 159                    "]+\\)")
 160           0 quote)
 161
 162     (2500 ,(concat "\\(^\\|["
 163                    muse-regexp-blank
 164                    "]+\\)--\\($\\|["
 165                    muse-regexp-blank
 166                    "]+\\)")
 167           0 emdash)
 168
 169     ;; "verse" text is indicated the same way as a quoted e-mail
 170     ;; response: "> text", where text may contain initial whitespace
 171     ;; (see below).
 172     (2600 ,(concat "^["
 173                    muse-regexp-blank
 174                    "]*> ")
 175           0 verse)
 176
 177     ;; simple table markup is supported, nothing fancy.  use | to
 178     ;; separate cells, || to separate header cells, and ||| for footer
 179     ;; cells
 180     (2700 ,(concat "^["
 181                    muse-regexp-blank
 182                    "]*\\(.+?\\(["
 183                    muse-regexp-blank
 184                    "]+|+["
 185                    muse-regexp-blank
 186                    "]+.+?\\)\\)$")
 187           0 table)
 188
 189     ;; replace links in the buffer (links to other pages)
 190     (2900 muse-explicit-link-regexp 0 link)
 191
 192     ;; bare URLs
 193     (3000 muse-url-regexp  0 url)
 194
 195     ;; bare email addresses
 196     (3500
 197      "\\([^[]\\)[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" 0 email)
 198     )
 199   "List of markup rules for publishing a page with Muse.
 200 The rules given in this variable are invoked first, followed by
 201 whatever rules are specified by the current style.
 202
 203 Each member of the list is either a function, or a list of the form:
 204
 205   (REGEXP/SYMBOL TEXT-BEGIN-GROUP REPLACEMENT-TEXT/FUNCTION/SYMBOL)
 206
 207 REGEXP is a regular expression, or symbol whose value is a regular
 208 expression, which is searched for using `re-search-forward'.
 209 TEXT-BEGIN-GROUP is the matching group within that regexp which
 210 denotes the beginning of the actual text to be marked up.
 211 REPLACEMENT-TEXT is a string that will be passed to `replace-match'.
 212 If it is not a string, but a function, it will be called to determine
 213 what the replacement text should be (it must return a string).  If it
 214 is a symbol, the value of that symbol should be a string.
 215
 216 The replacements are done in order, one rule at a time.  Writing
 217 the regular expressions can be a tricky business.  Note that case
 218 is never ignored.  `case-fold-search' is always bound to nil
 219 while processing the markup rules."
 220   :type '(repeat (choice
 221                   (list :tag "Markup rule"
 222                         integer
 223                         (choice regexp symbol)
 224                         integer
 225                         (choice string function symbol))
 226                   function))
 227   :group 'muse-publish)
 228
 229 (defcustom muse-publish-markup-functions
 230   '((directive . muse-publish-markup-directive)
 231     (comment   . muse-publish-markup-comment)
 232     (anchor    . muse-publish-markup-anchor)
 233     (tag       . muse-publish-markup-tag)
 234     (word      . muse-publish-markup-word)
 235     (emdash    . muse-publish-markup-emdash)
 236     (enddots   . muse-publish-markup-enddots)
 237     (dots      . muse-publish-markup-dots)
 238     (rule      . muse-publish-markup-rule)
 239     (heading   . muse-publish-markup-heading)
 240     (footnote  . muse-publish-markup-footnote)
 241     (fn-sep    . muse-publish-markup-fn-sep)
 242     (list      . muse-publish-markup-list)
 243     (quote     . muse-publish-markup-quote)
 244     (verse     . muse-publish-markup-verse)
 245     (table     . muse-publish-markup-table)
 246     (email     . muse-publish-markup-email)
 247     (link      . muse-publish-markup-link)
 248     (url       . muse-publish-markup-url))
 249   "An alist of style types to custom functions for that kind of text.
 250
 251 Each member of the list is of the form:
 252
 253   (SYMBOL FUNCTION)
 254
 255 SYMBOL describes the type of text to associate with this rule.
 256 `muse-publish-markup-regexps' maps regexps to these symbols.
 257
 258 FUNCTION is the function to use to mark up this kind of rule if
 259 no suitable function is found through the :functions tag of the
 260 current style."
 261   :type '(alist :key-type symbol :value-type function)
 262   :group 'muse-publish)
 263
 264 (defcustom muse-publish-markup-tags
 265   '(("contents" nil t   muse-publish-contents-tag)
 266     ("verse"    t   nil muse-publish-verse-tag)
 267     ("example"  t   nil muse-publish-example-tag)
 268     ("code"     t   nil muse-publish-code-tag)
 269     ("literal"  t   nil muse-publish-mark-read-only)
 270     ("verbatim" t   nil muse-publish-verbatim-tag)
 271     ("lisp"     t   nil muse-publish-lisp-tag)
 272     ("class"    t   t   muse-publish-class-tag)
 273     ("command"  t   t   muse-publish-command-tag)
 274     ("comment"  t   nil muse-publish-comment-tag))
 275   "A list of tag specifications, for specially marking up text.
 276 XML-style tags are the best way to add custom markup to Muse.
 277 This is easily accomplished by customizing this list of markup tags.
 278
 279 For each entry, the name of the tag is given, whether it expects
 280 a closing tag and/or an optional set of attributes, and a
 281 function that performs whatever action is desired within the
 282 delimited region.
 283
 284 The tags themselves are deleted during publishing, before the
 285 function is called.  The function is called with three arguments,
 286 the beginning and end of the region surrounded by the tags.  If
 287 properties are allowed, they are passed as a third argument in
 288 the form of an alist.  The `end' argument to the function is
 289 always a marker.
 290
 291 Point is always at the beginning of the region within the tags, when
 292 the function is called.  Wherever point is when the function finishes
 293 is where tag markup will resume.
 294
 295 These tag rules are processed once at the beginning of markup, and
 296 once at the end, to catch any tags which may have been inserted
 297 in-between."
 298   :type '(repeat (list (string :tag "Markup tag")
 299                        (boolean :tag "Expect closing tag" :value t)
 300                        (boolean :tag "Parse attributes" :value nil)
 301                        function))
 302   :group 'muse-publish)
 303
 304 (defcustom muse-publish-markup-specials nil
 305   "A table of characters which must be represented specially."
 306   :type '(alist :key-type character :value-type string)
 307   :group 'muse-publish)
 308
 309 (defvar muse-publishing-p nil
 310   "Set to t while a page is being published.")
 311 (defvar muse-batch-publishing-p nil
 312   "Set to t while a page is being batch published.")
 313 (defvar muse-publishing-styles nil
 314   "The publishing styles that Muse recognizes.
 315 This is automatically generated when loading publishing styles.")
 316 (defvar muse-publishing-current-file nil
 317   "The file that is currently being published.")
 318 (defvar muse-publishing-current-style nil
 319   "The style of the file that is currently being published.")
 320 (defvar muse-publishing-directives nil
 321   "An alist of publishing directives from the top of a file.")
 322 (defvar muse-publish-generate-contents nil
 323   "Non-nil if a table of contents should be generated.
 324 If non-nil, it is a cons cell specifying (MARKER . DEPTH), to
 325 tell where the <contents> was seen, and to what depth the
 326 contents were requested.")
 327 (defvar muse-publishing-last-position nil
 328   "Last position of the point when publishing.
 329 This is used to make sure that publishing doesn't get stalled.")
 330
 331 ;; Functions for handling style information
 332
 333 (defsubst muse-style (&optional style)
 334   "Resolve the given STYLE into a Muse style, if it is a string."
 335   (if (null style)
 336       muse-publishing-current-style
 337     (if (stringp style)
 338         (assoc style muse-publishing-styles)
 339       (muse-assert (consp style))
 340       style)))
 341
 342 (defun muse-define-style (name &rest elements)
 343   (let ((entry (assoc name muse-publishing-styles)))
 344     (if entry
 345         (error "There is already a style named %s." name)
 346       (setq muse-publishing-styles
 347             (cons (append (list name) elements)
 348                   muse-publishing-styles)))))
 349
 350 (defun muse-derive-style (new-name base-name &rest elements)
 351   (let ((entry (assoc new-name muse-publishing-styles)))
 352     (if entry
 353         (error "There is already a style named %s." new-name)
 354       (apply 'muse-define-style new-name
 355              (append elements (list :base base-name))))))
 356
 357 (defsubst muse-get-keyword (keyword list &optional direct)
 358   (let ((value (cadr (memq keyword list))))
 359     (if (and (not direct) (symbolp value))
 360         (symbol-value value)
 361       value)))
 362
 363 (defun muse-style-elements-list (elem &optional style)
 364   "Return a list all references to ELEM in STYLE, including base styles.
 365 If STYLE is not specified, use current style."
 366   (let (base elements)
 367     (while style
 368       (setq style (muse-style style))
 369       (setq elements (append elements
 370                              (muse-get-keyword elem style)))
 371       (setq style (muse-get-keyword :base style)))
 372     elements))
 373
 374 (defsubst muse-style-element (elem &optional style direct)
 375   "Search for ELEM in STYLE, including base styles.
 376 If STYLE is not specified, use current style."
 377   (setq style (muse-style style))
 378   (let ((value (muse-get-keyword elem style direct)))
 379     (if value
 380         value
 381       (let ((base (muse-get-keyword :base style)))
 382         (if base
 383             (muse-style-element elem base direct))))))
 384
 385 (defun muse-find-markup-element (keyword ident style)
 386   (let ((def (assq ident (muse-style-element keyword style))))
 387     (if def
 388         (cdr def)
 389       (let ((base (muse-style-element :base style)))
 390         (if base
 391             (muse-find-markup-element keyword ident base))))))
 392
 393 (defsubst muse-markup-text (ident &rest args)
 394   (let ((text (muse-find-markup-element :strings ident (muse-style))))
 395     (if (and text args)
 396         (apply 'format text args)
 397       (or text ""))))
 398
 399 (defun muse-find-markup-tag (keyword tagname style)
 400   (let ((def (assoc tagname (muse-style-element keyword style))))
 401     (or def
 402         (let ((base (muse-style-element :base style)))
 403           (if base
 404               (muse-find-markup-tag keyword tagname base))))))
 405
 406 (defsubst muse-markup-tag-info (tagname &rest args)
 407   (let ((tag-info (muse-find-markup-tag :tags tagname (muse-style))))
 408     (or tag-info
 409         (assoc (match-string 1) muse-publish-markup-tags))))
 410
 411 (defsubst muse-markup-function (category)
 412   (let ((func (muse-find-markup-element :functions category (muse-style))))
 413     (or func
 414         (cdr (assq category muse-publish-markup-functions)))))
 415
 416 ;; Publishing routines
 417
 418 (defun muse-publish-markup (name rules)
 419   (let* ((case-fold-search nil)
 420          (inhibit-read-only t)
 421          (limit (* (length rules) (point-max)))
 422          (verbose (and muse-publish-report-threshhold
 423                        (> (point-max) muse-publish-report-threshhold)))
 424          (base 0))
 425     (while rules
 426       (goto-char (point-min))
 427       (let ((regexp (nth 1 (car rules)))
 428             (group (nth 2 (car rules)))
 429             (repl (nth 3 (car rules)))
 430             pos)
 431         (setq muse-publishing-last-position nil)
 432         (if (symbolp regexp)
 433             (setq regexp (symbol-value regexp)))
 434         (if (and verbose (not muse-batch-publishing-p))
 435             (message "Publishing %s...%d%%" name
 436                      (* (/ (float (+ (point) base)) limit) 100)))
 437         (while (and regexp (setq pos (re-search-forward regexp nil t)))
 438           (if (and verbose (not muse-batch-publishing-p))
 439               (message "Publishing %s...%d%%" name
 440                        (* (/ (float (+ (point) base)) limit) 100)))
 441           (unless (and (> (- (match-end 0) (match-beginning 0)) 0)
 442                        (get-text-property (match-beginning group) 'read-only))
 443             (let* (func
 444                    (text (cond
 445                           ((and (symbolp repl)
 446                                 (setq func (muse-markup-function repl)))
 447                            (funcall func))
 448                           ((functionp repl)
 449                            (funcall repl))
 450                           ((symbolp repl)
 451                            (symbol-value repl))
 452                           (t repl))))
 453               (if text
 454                   (replace-match text t))))
 455           (if (and muse-publishing-last-position
 456                    (= pos muse-publishing-last-position))
 457               (if (eobp)
 458                   (setq regexp nil)
 459                 (forward-char 1)))
 460           (setq muse-publishing-last-position pos)))
 461       (setq rules (cdr rules)
 462             base (+ base (point-max))))
 463     (if (and verbose (not muse-batch-publishing-p))
 464         (message "Publishing %s...done" name))))
 465
 466 (defun muse-insert-file-or-string (file-or-string &optional title)
 467   (let ((beg (point)) end)
 468     (if (and (not (string-equal file-or-string ""))
 469              (file-readable-p file-or-string))
 470         (setq end (+ beg (cadr (insert-file-contents file-or-string))))
 471       (insert file-or-string)
 472       (setq end (point)))
 473     (save-restriction
 474       (narrow-to-region beg end)
 475       (muse-publish-markup (or title "")
 476                            '((100 "<\\(lisp\\)>" 0
 477                               muse-publish-markup-tag))))))
 478
 479 (defun muse-style-run-hooks (keyword style &rest args)
 480   (let (handled)
 481     (while (and style (not handled))
 482       (setq style (muse-style style))
 483       (let ((func (muse-get-keyword keyword style t)))
 484         (if func
 485             (if (apply func args)
 486                 (setq handled t))))
 487       (unless handled
 488         (setq style (muse-style-element :base style))))
 489     handled))
 490
 491 (defun muse-publish-markup-region (beg end title style)
 492   "Apply the given STYLE's markup rules to the given region."
 493   (save-restriction
 494     (narrow-to-region beg end)
 495     (muse-style-run-hooks :before style)
 496     (muse-publish-markup
 497      title
 498      (sort (copy-alist (append muse-publish-markup-regexps
 499                                (muse-style-elements-list :regexps style)))
 500            (function
 501             (lambda (l r)
 502               (< (car l) (car r))))))
 503     (muse-style-run-hooks :before-end style)))
 504
 505 (defun muse-publish-markup-buffer (title style)
 506   "Apply the given STYLE's markup rules to the current buffer."
 507   (setq style (muse-style style))
 508   (let ((style-header (muse-style-element :header style))
 509         (style-footer (muse-style-element :footer style))
 510         (muse-publishing-current-style style)
 511         (muse-publishing-directives
 512          (list (cons "title" title)
 513                (cons "author" (user-full-name))
 514                (cons "date" (format-time-string
 515                              "%B %e, %Y"
 516                              (nth 5 (file-attributes
 517                                      muse-publishing-current-file))))))
 518         (muse-publishing-p t))
 519     (run-hooks 'muse-before-publish-hook)
 520     (muse-publish-markup-region (point-min) (point-max) title style)
 521     (goto-char (point-min))
 522     (if style-header (muse-insert-file-or-string style-header title))
 523     (goto-char (point-max))
 524     (if style-footer (muse-insert-file-or-string style-footer title))
 525     (muse-style-run-hooks :after style)
 526     (run-hooks 'muse-after-publish-hook)))
 527
 528 (defun muse-publish-markup-string (string &optional style)
 529   "Markup STRING using the given STYLE's markup rules."
 530   (setq style (muse-style style))
 531   (muse-with-temp-buffer
 532     (insert string)
 533     (let ((muse-publishing-current-style style)
 534           (muse-publishing-p t))
 535       (muse-publish-markup "*string*" (muse-style-element :rules style)))
 536     (buffer-string)))
 537
 538 ;; Commands for publishing files
 539
 540 (defsubst muse-publish-get-style ()
 541   (if (= 1 (length muse-publishing-styles))
 542       (car muse-publishing-styles)
 543     (assoc (completing-read "Publish with style: "
 544                             muse-publishing-styles nil t)
 545            muse-publishing-styles)))
 546
 547 (defsubst muse-publish-get-output-dir (style)
 548   (let ((default-directory (or (muse-style-element :path style)
 549                                default-directory)))
 550     (muse-read-directory-name "Publish to directory: " nil default-directory)))
 551
 552 (defsubst muse-publish-get-info ()
 553   (let ((style (muse-publish-get-style)))
 554     (list style (muse-publish-get-output-dir style)
 555           current-prefix-arg)))
 556
 557 (defsubst muse-publish-output-name (&optional file style)
 558   (setq style (muse-style style))
 559   (concat (muse-style-element :prefix style)
 560           (muse-page-name file)
 561           (muse-style-element :suffix style)))
 562
 563 (defsubst muse-publish-output-file (file &optional output-dir style)
 564   (setq style (muse-style style))
 565   (if output-dir
 566       (expand-file-name (muse-publish-output-name file style) output-dir)
 567     (concat (file-name-directory file)
 568             (muse-publish-output-name file style))))
 569
 570 (defsubst muse-publish-link-name (&optional file style)
 571   (setq style (muse-style style))
 572   (concat (muse-style-element :prefix style)
 573           (muse-page-name file)
 574           (or (muse-style-element :link-suffix style)
 575               (muse-style-element :suffix style))))
 576
 577 (defsubst muse-publish-link-file (file &optional output-dir style)
 578   (setq style (muse-style style))
 579   (if output-dir
 580       (expand-file-name (muse-publish-link-name file style) output-dir)
 581     (concat (file-name-directory file)
 582             (muse-publish-link-name file style))))
 583
 584 (defun muse-publish-file (file style &optional output-dir force)
 585   "Publish the given file in list FILES.
 586 If the argument FORCE is nil, each file is only published if it is
 587 newer than the published version.  If the argument FORCE is non-nil,
 588 the file is published no matter what."
 589   (interactive (cons (read-file-name "Publish file: ")
 590                      (muse-publish-get-info)))
 591   (setq style (muse-style style))
 592   (let* ((output-path (muse-publish-output-file file output-dir style))
 593          (output-suffix (muse-style-element :osuffix style))
 594          (muse-publishing-current-file file)
 595          (target (if output-suffix
 596                      (concat (file-name-sans-extension output-path)
 597                              output-suffix)
 598                    output-path)))
 599     (when (or force (file-newer-than-file-p file target))
 600       (if (and muse-publish-report-threshhold
 601                (> (nth 7 (file-attributes file))
 602                   muse-publish-report-threshhold))
 603           (message "Publishing %s ..." file))
 604       (muse-with-temp-buffer
 605         (insert-file-contents file)
 606         (muse-publish-markup-buffer (muse-page-name file) style)
 607         (let ((backup-inhibited t))
 608           (write-file output-path))
 609         (muse-style-run-hooks :final style file output-path target))
 610       t)))
 611
 612 (defun muse-publish-this-file (style output-dir &optional force)
 613   "Publish the page in the current file."
 614   (interactive (muse-publish-get-info))
 615   (unless (muse-publish-file buffer-file-name style output-dir force)
 616     (message (concat "The published version is up-to-date; use"
 617                      " C-u C-c C-t to force an update."))))
 618
 619 (defun muse-batch-publish-files ()
 620   "Publish Muse files in batch mode."
 621   (let ((muse-batch-publishing-p t)
 622         style-name style output-dir)
 623     (setq style-name (car command-line-args-left)
 624           style (muse-style style-name)
 625           command-line-args-left (cdr command-line-args-left)
 626           output-dir (car command-line-args-left)
 627           output-dir
 628           (if (string-match "\\`--output-dir=" output-dir)
 629               (prog1
 630                   (substring output-dir (match-end 0))
 631                 (setq command-line-args-left (cdr command-line-args-left)))))
 632     (unless style
 633       (error "There is no style '%s' defined." style-name))
 634     (dolist (file command-line-args-left)
 635       (muse-publish-file file style output-dir t))))
 636
 637 ;; Default publishing rules
 638
 639 (defun muse-publish-section-close (depth)
 640   "Seach forward for the closing tag of given DEPTH."
 641   (let (not-end)
 642     (save-excursion
 643       (while (and (setq not-end (re-search-forward
 644                                  (concat "^\\*\\{1," (number-to-string depth)
 645                                          "\\}\\s-+")
 646                                  nil t))
 647                   (get-text-property (match-beginning 0) 'read-only)))
 648       (if not-end
 649           (forward-line 0)
 650         (goto-char (point-max)))
 651       (cond ((not (eq (char-before) ?\n))
 652              (insert "\n\n"))
 653             ((not (eq (char-before (1- (point))) ?\n))
 654              (insert "\n")))
 655       (insert (muse-markup-text 'section-close depth) "\n"))))
 656
 657 (defun muse-publish-markup-directive (&optional name value)
 658   (unless name (setq name (match-string 1)))
 659   (unless value (setq value (match-string 2)))
 660   (let ((elem (assoc name muse-publishing-directives)))
 661     (if elem
 662         (setcdr elem value)
 663       (setq muse-publishing-directives
 664             (cons (cons name value)
 665                   muse-publishing-directives))))
 666   ;; Make sure we don't ever try to move the point forward (past the
 667   ;; beginning of buffer) while we're still searching for directives.
 668   (setq muse-publishing-last-position nil)
 669   (delete-region (match-beginning 0) (match-end 0)))
 670
 671 (defun muse-publish-markup-anchor () "")
 672 (defun muse-publish-markup-comment () "")
 673
 674 (defun muse-publish-markup-tag ()
 675   (let ((tag-info (muse-markup-tag-info (match-string 1))))
 676     (when (and tag-info
 677                (not (get-text-property (match-beginning 0) 'read-only)))
 678       (let ((closed-tag (match-string 3))
 679             (start (match-beginning 0))
 680             (beg (point)) end attrs)
 681         (when (nth 2 tag-info)
 682           (let ((attrstr (match-string 2)))
 683             (while (and attrstr
 684                         (string-match (concat "\\([^"
 685                                               muse-regexp-space
 686                                               "=]+\\)\\(=\"\\"
 687                                               "([^\"]+\\)\"\\)?")
 688                                       attrstr))
 689               (let ((attr (cons (downcase
 690                                  (muse-match-string-no-properties 1 attrstr))
 691                                 (muse-match-string-no-properties 3 attrstr))))
 692                 (setq attrstr (replace-match "" t t attrstr))
 693                 (if attrs
 694                     (nconc attrs (list attr))
 695                   (setq attrs (list attr)))))))
 696         (if (and (cadr tag-info) (not closed-tag))
 697             (if (search-forward (concat "</" (car tag-info) ">") nil t)
 698                 (delete-region (match-beginning 0) (point))
 699               (setq tag-info nil)))
 700         (when tag-info
 701           (setq end (point-marker))
 702           (delete-region start beg)
 703           (goto-char start)
 704           (let ((args (list start end)))
 705             (if (nth 2 tag-info)
 706                 (nconc args (list attrs)))
 707             (apply (nth 3 tag-info) args))))))
 708   nil)
 709
 710 (defun muse-publish-escape-specials (beg end &optional ignore-read-only)
 711   "Escape specials from BEG to END using style-specific :specials.
 712 If IGNORE-READ-ONLY is non-nil, ignore the read-only property."
 713   (save-excursion
 714     (goto-char beg)
 715     (while (< (point) end)
 716       (if (and (not ignore-read-only) (get-text-property (point) 'read-only))
 717           (forward-char 1)
 718         (let ((repl
 719                (or (assoc (char-after) (muse-style-element :specials))
 720                    (assoc (char-after) muse-publish-markup-specials))))
 721           (if (null repl)
 722               (forward-char 1)
 723             (delete-char 1)
 724             (insert-before-markers (cdr repl))))))))
 725
 726 (defun muse-publish-markup-word ()
 727   (let* ((beg (match-beginning 2))
 728          (end (1- (match-end 2)))
 729          (leader (buffer-substring-no-properties beg end))
 730          open-tag close-tag mark-read-only loc)
 731     (cond
 732      ((string= leader "_")
 733       (setq open-tag (muse-markup-text 'begin-underline)
 734             close-tag (muse-markup-text 'end-underline)))
 735      ((string= leader "=")
 736       (setq open-tag (muse-markup-text 'begin-literal)
 737             close-tag (muse-markup-text 'end-literal))
 738       (setq mark-read-only t))
 739      (t
 740       (let ((l (length leader)))
 741         (cond
 742          ((= l 1) (setq open-tag (muse-markup-text 'begin-emph)
 743                         close-tag (muse-markup-text 'end-emph)))
 744          ((= l 2) (setq open-tag (muse-markup-text 'begin-more-emph)
 745                         close-tag (muse-markup-text 'end-more-emph)))
 746          ((= l 3) (setq open-tag (muse-markup-text 'begin-most-emph)
 747                         close-tag (muse-markup-text 'end-most-emph)))))))
 748     (if (and (not (get-text-property beg 'noemphasis))
 749              (setq loc (search-forward leader nil t))
 750              (or (eobp) (not (eq (char-syntax (char-after loc)) ?w)))
 751              (not (eq (char-syntax (char-before (point))) ?\ ))
 752              (not (get-text-property (point) 'noemphasis)))
 753         (progn
 754           (replace-match "")
 755           (delete-region beg end)
 756           (setq end (point-marker))
 757           (insert close-tag)
 758           (save-excursion
 759             (goto-char beg)
 760             (insert open-tag)
 761             (setq beg (point)))
 762           (when mark-read-only
 763             (muse-publish-escape-specials beg end t)
 764             (muse-publish-mark-read-only (1- beg) (1+ end))))
 765       (backward-char))
 766     nil))
 767
 768 (defun muse-publish-markup-emdash ()
 769   (delete-region (match-beginning 0) (match-end 0))
 770   (insert (muse-markup-text 'emdash))
 771   (if (eq (char-after) ?\<)
 772       (insert ?\n)))
 773
 774 (defun muse-publish-markup-enddots ()
 775   (delete-region (match-beginning 0) (match-end 0))
 776   (insert (muse-markup-text 'enddots)))
 777
 778 (defun muse-publish-markup-dots ()
 779   (delete-region (match-beginning 0) (match-end 0))
 780   (insert (muse-markup-text 'dots)))
 781
 782 (defun muse-publish-markup-rule ()
 783   (delete-region (match-beginning 0) (match-end 0))
 784   (insert (muse-markup-text 'rule)))
 785
 786 (defun muse-publish-markup-heading ()
 787   (let* ((len (length (match-string 1)))
 788          (start (muse-markup-text
 789                  (cond ((= len 1) 'section)
 790                        ((= len 2) 'subsection)
 791                        ((= len 3) 'subsubsection)
 792                        (t 'section-other))
 793                  len))
 794          (end   (muse-markup-text
 795                  (cond ((= len 1) 'section-end)
 796                        ((= len 2) 'subsection-end)
 797                        ((= len 3) 'subsubsection-end)
 798                        (t 'section-other-end))
 799                  len)))
 800     (delete-region (match-beginning 0) (match-end 0))
 801     (insert start)
 802     (end-of-line)
 803     (if end (insert end))
 804     (muse-publish-section-close len)))
 805
 806 (defvar muse-publish-footnotes nil)
 807
 808 (defun muse-publish-markup-footnote ()
 809   "Scan ahead and snarf up the footnote body"
 810   (if (= (muse-line-beginning-position) (match-beginning 0))
 811       ""
 812     (let ((footnote (save-match-data
 813                       (string-to-number (match-string 1))))
 814           footnotemark)
 815       (delete-region (match-beginning 0) (match-end 0))
 816       (save-excursion
 817         (when (re-search-forward (format "^\\[%d\\]\\s-+" footnote) nil t)
 818           (let* ((start (match-beginning 0))
 819                  (beg (goto-char (match-end 0)))
 820                  (end (save-excursion
 821                         (if (search-forward "\n\n" nil t)
 822                             (copy-marker (match-beginning 0))
 823                           (goto-char (point-max))
 824                           (skip-chars-backward "\n")
 825                           (point-marker)))))
 826             (while (re-search-forward (concat "^["
 827                                               muse-regexp-blank
 828                                               "]+\\([^\n]\\)")
 829                                       end t)
 830               (replace-match "\\1" t))
 831             (let ((footnotemark-cmd (muse-markup-text 'footnotemark))
 832                   (footnotemark-end-cmd (muse-markup-text 'footnotemark-end)))
 833               (if (string= "" footnotemark-cmd)
 834                   (setq footnotemark
 835                         (concat (muse-markup-text 'footnote)
 836                                 (buffer-substring-no-properties beg end)
 837                                 (muse-markup-text 'footnote-end)))
 838                 (setq footnotemark (format footnotemark-cmd footnote
 839                                            footnotemark-end-cmd))
 840                 (unless muse-publish-footnotes
 841                   (set (make-local-variable 'muse-publish-footnotes)
 842                        (make-vector 256 nil)))
 843                 (unless (aref muse-publish-footnotes footnote)
 844                   (setq footnotemark
 845                         (concat
 846                          footnotemark
 847                          (concat (format (muse-markup-text 'footnotetext)
 848                                          footnote)
 849                                  (buffer-substring-no-properties beg end)
 850                                  (muse-markup-text 'footnotetext-end))))
 851                   (aset muse-publish-footnotes footnote footnotemark))))
 852             (goto-char end)
 853             (skip-chars-forward "\n")
 854             (delete-region start (point)))))
 855       (insert (or footnotemark footnote)))))
 856
 857 (defun muse-publish-markup-fn-sep ()
 858   (delete-region (match-beginning 0) (match-end 0))
 859   (insert (muse-markup-text 'fn-sep)))
 860
 861 (defun muse-publish-surround-text (beg-tag end-tag move-func)
 862   (let ((beg (point)) end)
 863     (skip-chars-backward muse-regexp-space)
 864     (delete-region (point) beg)
 865     (insert "\n\n" beg-tag)
 866     (funcall move-func)
 867     (setq end (point-marker))
 868     (goto-char beg)
 869     (while (< (point) end)
 870       (if (looking-at "^\\s-+")
 871           (replace-match ""))
 872       (forward-line 1))
 873     (goto-char end)
 874     (setq beg (point))
 875     (skip-chars-backward muse-regexp-space)
 876     (delete-region (point) beg))
 877   (insert end-tag "\n"))
 878
 879 (defsubst muse-forward-paragraph (&optional pattern)
 880   (if (re-search-forward (if pattern
 881                              (concat "^\\(" pattern "["
 882                                      muse-regexp-blank
 883                                      "]+\\|$\\|\\'\\)")
 884                            "^\\s-*\\($\\|\\'\\)") nil t)
 885       (goto-char (match-beginning 0))
 886     (goto-char (point-max))))
 887
 888 (defun muse-publish-markup-list ()
 889   "Markup a list entry or quoted paragraph.
 890 The reason this function is so funky, is to prevent text properties
 891 like read-only from being inadvertently deleted."
 892   (let ((str (match-string 1)))
 893     (cond
 894      ((and (eq (aref str 0) ?-))
 895       (delete-region (match-beginning 0) (match-end 0))
 896       (muse-publish-surround-text
 897        (muse-markup-text 'begin-uli)
 898        (muse-markup-text 'end-uli)
 899        (function
 900         (lambda ()
 901           (muse-forward-paragraph (concat "["
 902                                           muse-regexp-blank
 903                                           "]+-"))))))
 904      ((and (>= (aref str 0) ?0)
 905            (<= (aref str 0) ?9))
 906       (delete-region (match-beginning 0) (match-end 0))
 907       (muse-publish-surround-text
 908        (muse-markup-text 'begin-oli)
 909        (muse-markup-text 'end-oli)
 910        (function
 911         (lambda ()
 912           (muse-forward-paragraph (concat "["
 913                                           muse-regexp-blank
 914                                           "]+[0-9]+\\."))))))
 915      (t
 916       (goto-char (match-beginning 1))
 917       (insert (muse-markup-text 'begin-ddt))
 918       (save-match-data
 919         (save-excursion
 920           (forward-line 1)
 921           (while (looking-at (concat "^\\(["
 922                                      muse-regexp-blank
 923                                      "]*\\)[^"
 924                                      muse-regexp-space
 925                                      "]"))
 926             (delete-region (match-beginning 1) (match-end 1))
 927             (forward-line 1))))
 928       (save-match-data
 929         (when (re-search-forward (concat "["
 930                                          muse-regexp-space
 931                                          "]+::["
 932                                          muse-regexp-space
 933                                          "]+")
 934                                  nil t)
 935           (replace-match (muse-markup-text 'start-dde))))
 936       (muse-forward-paragraph)
 937       (insert (muse-markup-text 'end-ddt) ?\n)))))
 938
 939 (defun muse-publish-markup-quote ()
 940   "Markup a list entry or quoted paragraph.
 941 The reason this function is so funky, is to prevent text properties
 942 like read-only from being inadvertently deleted."
 943   (let* ((ws (match-string 0))
 944          (centered (>= (string-width ws) 6))
 945          (begin-elem (if centered 'begin-center 'begin-quote))
 946          (end-elem (if centered 'end-center 'end-quote)))
 947     (muse-publish-surround-text (muse-markup-text begin-elem)
 948                                 (muse-markup-text end-elem)
 949                                 'muse-forward-paragraph)))
 950
 951 (defun muse-publish-markup-leading-space ()
 952   (let ((markup-space (muse-markup-text 'verse-space))
 953         count)
 954     (when (and markup-space
 955                (>= (setq count (skip-chars-forward " ")) 0))
 956       (delete-region (muse-line-beginning-position) (point))
 957       (while (> count 0)
 958         (insert markup-space)
 959         (setq count (- count 2))))))
 960
 961 (defun muse-publish-markup-verse ()
 962   (let ((leader (match-string 0)))
 963     (goto-char (match-beginning 0))
 964     (insert (muse-markup-text 'begin-verse))
 965     (while (looking-at leader)
 966       (replace-match "")
 967       (muse-publish-markup-leading-space)
 968       (let ((beg (point)))
 969         (end-of-line)
 970         (cond
 971          ((bolp)
 972           (let ((text (muse-markup-text 'empty-verse-line)))
 973             (if text (insert text))))
 974          ((save-excursion
 975             (save-match-data
 976               (forward-line 1)
 977               (or (looking-at (concat leader "["
 978                                       muse-regexp-blank
 979                                       "]*$"))
 980                   (not (looking-at leader)))))
 981           (let ((begin-text (muse-markup-text 'begin-last-stanza-line))
 982                 (end-text (muse-markup-text 'end-last-stanza-line)))
 983             (when end-text (insert end-text))
 984             (goto-char beg)
 985             (when begin-text (insert begin-text))
 986             (end-of-line)))
 987          (t
 988           (let ((begin-text (muse-markup-text 'begin-verse-line))
 989                 (end-text (muse-markup-text 'end-verse-line)))
 990             (when end-text (insert end-text))
 991             (goto-char beg)
 992             (when begin-text (insert begin-text))
 993             (end-of-line))))
 994         (forward-line 1))))
 995   (insert (muse-markup-text 'end-verse) ?\n))
 996
 997 (defun muse-publish-markup-table ()
 998   "Style does not support tables.")
 999
1000 (defun muse-publish-escape-specials-in-string (string &rest ignored)
1001   "Escape specials in STRING using style-specific :specials."
1002   (save-excursion
1003     (apply (function concat)
1004            (mapcar
1005             (lambda (ch)
1006               (let ((repl
1007                      (or (assoc ch (muse-style-element :specials))
1008                          (assoc ch muse-publish-markup-specials))))
1009                 (if (null repl)
1010                     (char-to-string ch)
1011                   (cdr repl))))
1012             (append string nil)))))
1013
1014 (defun muse-publish-markup-email ()
1015   (let* ((beg (match-end 1))
1016          (addr (buffer-substring-no-properties beg (match-end 0))))
1017     (setq addr (muse-publish-escape-specials-in-string addr))
1018     (goto-char beg)
1019     (delete-region beg (match-end 0))
1020     (if (or (eq (char-before (match-beginning 0)) ?\")
1021             (eq (char-after (match-end 0)) ?\"))
1022         (insert addr)
1023       (insert (format (muse-markup-text 'email-addr) addr addr)))
1024     (muse-publish-mark-read-only beg (point))))
1025
1026 (defun muse-publish-url (url &optional desc explicit)
1027   "Resolve a URL into its final <a href> form."
1028   (let ((orig-url url))
1029     (dolist (transform muse-publish-url-transforms)
1030       (setq url (save-match-data (when url (funcall transform url explicit)))))
1031     (dolist (transform muse-publish-desc-transforms)
1032       (setq desc (save-match-data
1033                    (when desc (funcall transform desc explicit)))))
1034     (if url
1035         (cond ((string-match muse-image-regexp url)
1036                (if desc
1037                    (muse-markup-text 'image-with-desc url desc)
1038                  (muse-markup-text 'image-link url)))
1039               ((and desc (string-match muse-image-regexp desc))
1040                (muse-markup-text 'url-with-image url desc))
1041               ((eq (aref url 0) ?\#)
1042                (muse-markup-text 'internal-link (substring url 1)
1043                                  (or desc orig-url)))
1044               (t
1045                (muse-markup-text 'url-link url (or desc orig-url))))
1046       desc)))
1047
1048 (defun muse-publish-insert-url (url &optional desc explicit)
1049   "Resolve a URL into its final <a href> form."
1050   (delete-region (match-beginning 0) (match-end 0))
1051   (let ((beg (point))
1052         (text (muse-publish-url url desc explicit)))
1053     (when text
1054       (insert text)
1055       (muse-publish-mark-read-only beg (point)))))
1056
1057 (defun muse-publish-markup-link ()
1058   (let (desc explicit link)
1059     (setq explicit (save-match-data
1060                      (if (string-match muse-explicit-link-regexp
1061                                        (match-string 0))
1062                          t nil)))
1063     (setq desc (if explicit (match-string 2) (match-string 0)))
1064     (setq link (if explicit
1065                    (muse-handle-explicit-link (match-string 1))
1066                  (muse-handle-implicit-link (match-string 0))))
1067     (when (and link
1068                (or explicit
1069                    (not (or (eq (char-before (match-beginning 0)) ?\")
1070                             (eq (char-after (match-end 0)) ?\")))))
1071       (muse-publish-insert-url link desc explicit))))
1072
1073 (defun muse-publish-markup-url ()
1074   (if (not (or (eq (char-before (match-beginning 0)) ?\")
1075                (eq (char-after (match-end 0)) ?\")))
1076       (muse-publish-insert-url (match-string 0))
1077     (let ((beg (match-beginning 0))
1078           (url (match-string 0)))
1079       (delete-region (match-beginning 0) (match-end 0))
1080       (insert (muse-publish-escape-specials-in-string url))
1081       (muse-publish-mark-read-only beg (point)))))
1082
1083 ;; Default publishing tags
1084
1085 (defun muse-publish-contents-tag (beg end attrs)
1086   (set (make-local-variable 'muse-publish-generate-contents)
1087        (cons (copy-marker (point) t)
1088              (let ((depth (cdr (assoc "depth" attrs))))
1089                (or (and depth (string-to-number depth)) 2)))))
1090
1091 (defun muse-publish-verse-tag (beg end)
1092   (save-excursion
1093     (goto-char beg)
1094     (while (eq ?\  (char-syntax (char-after)))
1095       (delete-char 1))
1096     (while (< (point) end)
1097       (insert "> ")
1098       (forward-line))
1099     (if (eq ?\  (char-syntax (char-before)))
1100       (delete-char -1))))
1101
1102 (defun muse-publish-mark-read-only (beg end)
1103   (add-text-properties beg end '(rear-nonsticky (read-only) read-only t))
1104   nil)
1105
1106 (defun muse-publish-mark-noemphasis (&optional beg end)
1107   (unless beg (setq beg (match-beginning 0)))
1108   (unless end (setq end (match-end 0)))
1109   (add-text-properties beg end '(noemphasis t))
1110   nil)
1111
1112 (defun muse-publish-code-tag (beg end)
1113   (muse-publish-escape-specials beg end)
1114   (goto-char beg)
1115   (insert (muse-markup-text 'begin-literal))
1116   (goto-char end)
1117   (insert (muse-markup-text 'end-literal))
1118   (muse-publish-mark-read-only beg (point)))
1119
1120 (defun muse-publish-example-tag (beg end)
1121   (muse-publish-escape-specials beg end)
1122   (goto-char beg)
1123   (insert (muse-markup-text 'begin-example))
1124   (goto-char end)
1125   (insert (muse-markup-text 'end-example))
1126   (muse-publish-mark-read-only beg (point)))
1127
1128 (defun muse-publish-verbatim-tag (beg end)
1129   (muse-publish-escape-specials beg end)
1130   (muse-publish-mark-read-only beg end))
1131
1132 (defalias 'muse-publish-class-tag 'ignore)
1133
1134 (defun muse-publish-lisp-tag (beg end)
1135   (save-excursion
1136     (let ((str (muse-eval-lisp
1137                 (prog1
1138                     (buffer-substring-no-properties beg end)
1139                   (delete-region beg end)))))
1140       (set-text-properties 0 (length str) nil str)
1141       (insert str))))
1142
1143 (defun muse-publish-command-tag (beg end attrs)
1144   (while (looking-at "\\s-*$")
1145     (forward-line))
1146   (let ((interp (cdr (assoc "interp" attrs))))
1147     (if (null interp)
1148         (shell-command
1149          (prog1
1150              (buffer-substring-no-properties (point) end)
1151            (delete-region beg end)) t)
1152       (shell-command-on-region beg end interp t t))
1153     (muse-publish-mark-read-only beg (point))))
1154
1155 (defun muse-publish-comment-tag (beg end)
1156   (delete-region beg end))
1157
1158 ;; Miscellaneous helper functions
1159
1160 (defsubst muse-publishing-directive (name)
1161   (cdr (assoc name muse-publishing-directives)))
1162
1163 (defun muse-publish-strip-tags (string)
1164   "Remove all tags from the string."
1165   (while (string-match "<.*?>" string)
1166     (setq string (replace-match "" nil t string)))
1167   string)
1168
1169 (defun muse-publish-markup-type (category default-func)
1170   (let ((rule (muse-find-markup-element :overrides category (muse-style))))
1171     (funcall (or rule default-func))))
1172
1173 (defun muse-published-buffer-contents (buffer)
1174   (with-current-buffer buffer
1175     (goto-char (point-min))
1176     (let ((beg (and (search-forward "Emacs Muse begins here")
1177                     (muse-line-end-position)))
1178           (end (and (search-forward "Emacs Muse ends here")
1179                     (muse-line-beginning-position))))
1180       (buffer-substring-no-properties beg end))))
1181
1182 (defun muse-published-contents (file)
1183   (when (file-readable-p file)
1184     (muse-with-temp-buffer
1185       (insert-file-contents file)
1186       (muse-published-buffer-contents (current-buffer)))))
1187
1188 (defun muse-publish-transform-output
1189   (file temp-file output-path name gen-func &rest cleanup-exts)
1190   "Transform the given TEMP-FILE into the OUTPUT-PATH, using GEN-FUNC."
1191   (setq file (muse-page-name file))
1192   (message "Generating %s output for %s..." name file)
1193   (if (not (funcall gen-func temp-file output-path))
1194       (message "Generating %s from %s...failed" name file)
1195     (message "Generating %s output for %s...done" name file)
1196     (muse-delete-file-if-exists temp-file)
1197     (dolist (ext cleanup-exts)
1198       (muse-delete-file-if-exists
1199        (expand-file-name (concat file ext)
1200                          (file-name-directory output-path))))
1201     (message "Wrote %s" output-path)))
1202
1203 (defun muse-publish-read-only (string)
1204   (let ((end (1- (length string))))
1205     (add-text-properties 0 end
1206                          '(rear-nonsticky (read-only) read-only t)
1207                          string)
1208     string))
1209
1210 (defun muse-publish-prepare-url (target &rest ignored)
1211   "Transform anchors and get published name, if TARGET is a page."
1212   (save-match-data
1213     (unless (or (string-match muse-url-regexp target)
1214                 (string-match muse-image-regexp target)
1215                 (string-match muse-file-regexp target))
1216       (setq target (if (string-match "#" target)
1217                        (if (eq (aref target 0) ?\#)
1218                            target
1219                          (concat (muse-publish-link-name
1220                                   (substring target 0 (match-beginning 0)))
1221                                  "#" (substring target (match-end 0))))
1222                      (muse-publish-link-name target)))))
1223   target)
1224
1225 (provide 'muse-publish)
1226
1227 ;;; muse-publish.el ends here