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 "^#\\(\\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 (defvar muse-publishing-current-file nil)
 315 (defvar muse-publishing-current-style nil)
 316 (defvar muse-publishing-directives nil
 317   "An alist of publishing directives from the top of a file.")
 318 (defvar muse-publish-generate-contents nil
 319   "Non-nil if a table of contents should be generated.
 320 If non-nil, it is a cons cell specifying (MARKER . DEPTH), to
 321 tell where the <contents> was seen, and to what depth the
 322 contents were requested.")
 323 (defvar muse-publishing-last-position nil
 324   "Last position of the point when publishing.
 325 This is used to make sure that publishing doesn't get stalled.")
 326
 327 ;; Functions for handling style information
 328
 329 (defsubst muse-style (&optional style)
 330   "Resolve the given STYLE into a Muse style, if it is a string."
 331   (if (null style)
 332       muse-publishing-current-style
 333     (if (stringp style)
 334         (assoc style muse-publishing-styles)
 335       (muse-assert (consp style))
 336       style)))
 337
 338 (defun muse-define-style (name &rest elements)
 339   (let ((entry (assoc name muse-publishing-styles)))
 340     (if entry
 341         (error "There is already a style named %s." name)
 342       (setq muse-publishing-styles
 343             (cons (append (list name) elements)
 344                   muse-publishing-styles)))))
 345
 346 (defun muse-derive-style (new-name base-name &rest elements)
 347   (let ((entry (assoc new-name muse-publishing-styles)))
 348     (if entry
 349         (error "There is already a style named %s." new-name)
 350       (apply 'muse-define-style new-name
 351              (append elements (list :base base-name))))))
 352
 353 (defsubst muse-get-keyword (keyword list &optional direct)
 354   (let ((value (cadr (memq keyword list))))
 355     (if (and (not direct) (symbolp value))
 356         (symbol-value value)
 357       value)))
 358
 359 (defun muse-style-elements-list (elem &optional style)
 360   "Return a list all references to ELEM in STYLE, including base styles.
 361 If STYLE is not specified, use current style."
 362   (let (base elements)
 363     (while style
 364       (setq style (muse-style style))
 365       (setq elements (append elements
 366                              (muse-get-keyword elem style)))
 367       (setq style (muse-get-keyword :base style)))
 368     elements))
 369
 370 (defsubst muse-style-element (elem &optional style direct)
 371   "Search for ELEM in STYLE, including base styles.
 372 If STYLE is not specified, use current style."
 373   (setq style (muse-style style))
 374   (let ((value (muse-get-keyword elem style direct)))
 375     (if value
 376         value
 377       (let ((base (muse-get-keyword :base style)))
 378         (if base
 379             (muse-style-element elem base direct))))))
 380
 381 (defun muse-find-markup-element (keyword ident style)
 382   (let ((def (assq ident (muse-style-element keyword style))))
 383     (if def
 384         (cdr def)
 385       (let ((base (muse-style-element :base style)))
 386         (if base
 387             (muse-find-markup-element keyword ident base))))))
 388
 389 (defsubst muse-markup-text (ident &rest args)
 390   (let ((text (muse-find-markup-element :strings ident (muse-style))))
 391     (if (and text args)
 392         (apply 'format text args)
 393       (or text ""))))
 394
 395 (defun muse-find-markup-tag (keyword tagname style)
 396   (let ((def (assoc tagname (muse-style-element keyword style))))
 397     (or def
 398         (let ((base (muse-style-element :base style)))
 399           (if base
 400               (muse-find-markup-tag keyword tagname base))))))
 401
 402 (defsubst muse-markup-tag-info (tagname &rest args)
 403   (let ((tag-info (muse-find-markup-tag :tags tagname (muse-style))))
 404     (or tag-info
 405         (assoc (match-string 1) muse-publish-markup-tags))))
 406
 407 (defsubst muse-markup-function (category)
 408   (let ((func (muse-find-markup-element :functions category (muse-style))))
 409     (or func
 410         (cdr (assq category muse-publish-markup-functions)))))
 411
 412 ;; Publishing routines
 413
 414 (defun muse-publish-markup (name rules)
 415   (let* ((case-fold-search nil)
 416          (inhibit-read-only t)
 417          (limit (* (length rules) (point-max)))
 418          (verbose (and muse-publish-report-threshhold
 419                        (> (point-max) muse-publish-report-threshhold)))
 420          (base 0))
 421     (while rules
 422       (goto-char (point-min))
 423       (let ((regexp (nth 1 (car rules)))
 424             (group (nth 2 (car rules)))
 425             (repl (nth 3 (car rules)))
 426             pos)
 427         (setq muse-publishing-last-position nil)
 428         (if (symbolp regexp)
 429             (setq regexp (symbol-value regexp)))
 430         (if (and verbose (not muse-batch-publishing-p))
 431             (message "Publishing %s...%d%%" name
 432                      (* (/ (float (+ (point) base)) limit) 100)))
 433         (while (and regexp (setq pos (re-search-forward regexp nil t)))
 434           (if (and verbose (not muse-batch-publishing-p))
 435               (message "Publishing %s...%d%%" name
 436                        (* (/ (float (+ (point) base)) limit) 100)))
 437           (unless (and (> (- (match-end 0) (match-beginning 0)) 0)
 438                        (get-text-property (match-beginning group) 'read-only))
 439             (let* (func
 440                    (text (cond
 441                           ((and (symbolp repl)
 442                                 (setq func (muse-markup-function repl)))
 443                            (funcall func))
 444                           ((functionp repl)
 445                            (funcall repl))
 446                           ((symbolp repl)
 447                            (symbol-value repl))
 448                           (t repl))))
 449               (if text
 450                   (replace-match text t))))
 451           (if (and muse-publishing-last-position
 452                    (= pos muse-publishing-last-position))
 453               (if (eobp)
 454                   (setq regexp nil)
 455                 (forward-char 1)))
 456           (setq muse-publishing-last-position pos)))
 457       (setq rules (cdr rules)
 458             base (+ base (point-max))))
 459     (if (and verbose (not muse-batch-publishing-p))
 460         (message "Publishing %s...done" name))))
 461
 462 (defun muse-insert-file-or-string (file-or-string &optional title)
 463   (let ((beg (point)) end)
 464     (if (and (not (string-equal file-or-string ""))
 465              (file-readable-p file-or-string))
 466         (setq end (+ beg (cadr (insert-file-contents file-or-string))))
 467       (insert file-or-string)
 468       (setq end (point)))
 469     (save-restriction
 470       (narrow-to-region beg end)
 471       (muse-publish-markup (or title "")
 472                            '((100 "<\\(lisp\\)>" 0
 473                               muse-publish-markup-tag))))))
 474
 475 (defun muse-style-run-hooks (keyword style &rest args)
 476   (let (handled)
 477     (while (and style (not handled))
 478       (setq style (muse-style style))
 479       (let ((func (muse-get-keyword keyword style t)))
 480         (if func
 481             (if (apply func args)
 482                 (setq handled t))))
 483       (unless handled
 484         (setq style (muse-style-element :base style))))
 485     handled))
 486
 487 (defun muse-publish-markup-region (beg end title style)
 488   "Apply the given STYLE's markup rules to the given region."
 489   (save-restriction
 490     (narrow-to-region beg end)
 491     (muse-style-run-hooks :before style)
 492     (muse-publish-markup
 493      title
 494      (sort (copy-alist (append muse-publish-markup-regexps
 495                                (muse-style-elements-list :regexps style)))
 496            (function
 497             (lambda (l r)
 498               (< (car l) (car r))))))
 499     (muse-style-run-hooks :before-end style)))
 500
 501 (defun muse-publish-markup-buffer (title style)
 502   "Apply the given STYLE's markup rules to the current buffer."
 503   (setq style (muse-style style))
 504   (let ((style-header (muse-style-element :header style))
 505         (style-footer (muse-style-element :footer style))
 506         (muse-publishing-current-style style)
 507         (muse-publishing-directives
 508          (list (cons "title" title)
 509                (cons "author" (user-full-name))
 510                (cons "date" (format-time-string "%B %e, %Y"))))
 511         (muse-publishing-p t))
 512     (run-hooks 'muse-before-publish-hook)
 513     (muse-publish-markup-region (point-min) (point-max) title style)
 514     (goto-char (point-min))
 515     (if style-header (muse-insert-file-or-string style-header title))
 516     (goto-char (point-max))
 517     (if style-footer (muse-insert-file-or-string style-footer title))
 518     (muse-style-run-hooks :after style)
 519     (run-hooks 'muse-after-publish-hook)))
 520
 521 (defun muse-publish-markup-string (string &optional style)
 522   "Markup STRING using the given STYLE's markup rules."
 523   (setq style (muse-style style))
 524   (muse-with-temp-buffer
 525     (insert string)
 526     (let ((muse-publishing-current-style style)
 527           (muse-publishing-p t))
 528       (muse-publish-markup "*string*" (muse-style-element :rules style)))
 529     (buffer-string)))
 530
 531 ;; Commands for publishing files
 532
 533 (defsubst muse-publish-get-style ()
 534   (if (= 1 (length muse-publishing-styles))
 535       (car muse-publishing-styles)
 536     (assoc (completing-read "Publish with style: "
 537                             muse-publishing-styles nil t)
 538            muse-publishing-styles)))
 539
 540 (defsubst muse-publish-get-output-dir (style)
 541   (let ((default-directory (or (muse-style-element :path style)
 542                                default-directory)))
 543     (muse-read-directory-name "Publish to directory: " nil default-directory)))
 544
 545 (defsubst muse-publish-get-info ()
 546   (let ((style (muse-publish-get-style)))
 547     (list style (muse-publish-get-output-dir style)
 548           current-prefix-arg)))
 549
 550 (defsubst muse-publish-output-name (&optional file style)
 551   (setq style (muse-style style))
 552   (concat (muse-style-element :prefix style)
 553           (muse-page-name file)
 554           (muse-style-element :suffix style)))
 555
 556 (defsubst muse-publish-output-file (file &optional output-dir style)
 557   (setq style (muse-style style))
 558   (if output-dir
 559       (expand-file-name (muse-publish-output-name file style) output-dir)
 560     (concat (file-name-directory file)
 561             (muse-publish-output-name file style))))
 562
 563 (defsubst muse-publish-link-name (&optional file style)
 564   (setq style (muse-style style))
 565   (concat (muse-style-element :prefix style)
 566           (muse-page-name file)
 567           (or (muse-style-element :link-suffix style)
 568               (muse-style-element :suffix style))))
 569
 570 (defsubst muse-publish-link-file (file &optional output-dir style)
 571   (setq style (muse-style style))
 572   (if output-dir
 573       (expand-file-name (muse-publish-link-name file style) output-dir)
 574     (concat (file-name-directory file)
 575             (muse-publish-link-name file style))))
 576
 577 (defun muse-publish-file (file style &optional output-dir force)
 578   "Publish the given file in list FILES.
 579 If the argument FORCE is nil, each file is only published if it is
 580 newer than the published version.  If the argument FORCE is non-nil,
 581 the file is published no matter what."
 582   (interactive (cons (read-file-name "Publish file: ")
 583                      (muse-publish-get-info)))
 584   (setq style (muse-style style))
 585   (let* ((output-path (muse-publish-output-file file output-dir style))
 586          (output-suffix (muse-style-element :osuffix style))
 587          (muse-publishing-current-file file)
 588          (target (if output-suffix
 589                      (concat (file-name-sans-extension output-path)
 590                              output-suffix)
 591                    output-path)))
 592     (when (or force (file-newer-than-file-p file target))
 593       (if (and muse-publish-report-threshhold
 594                (> (nth 7 (file-attributes file))
 595                   muse-publish-report-threshhold))
 596           (message "Publishing %s ..." file))
 597       (muse-with-temp-buffer
 598         (insert-file-contents file)
 599         (muse-publish-markup-buffer (muse-page-name file) style)
 600         (let ((backup-inhibited t))
 601           (write-file output-path))
 602         (muse-style-run-hooks :final style file output-path target))
 603       t)))
 604
 605 (defun muse-publish-this-file (style output-dir &optional force)
 606   "Publish the page in the current file."
 607   (interactive (muse-publish-get-info))
 608   (unless (muse-publish-file buffer-file-name style output-dir force)
 609     (message (concat "The published version is up-to-date; use"
 610                      " C-u C-c C-t to force an update."))))
 611
 612 (defun muse-batch-publish-files ()
 613   "Publish Muse files in batch mode."
 614   (let ((muse-batch-publishing-p t)
 615         style-name style output-dir)
 616     (setq style-name (car command-line-args-left)
 617           style (muse-style style-name)
 618           command-line-args-left (cdr command-line-args-left)
 619           output-dir (car command-line-args-left)
 620           output-dir
 621           (if (string-match "\\`--output-dir=" output-dir)
 622               (prog1
 623                   (substring output-dir (match-end 0))
 624                 (setq command-line-args-left (cdr command-line-args-left)))))
 625     (unless style
 626       (error "There is no style '%s' defined." style-name))
 627     (dolist (file command-line-args-left)
 628       (muse-publish-file file style output-dir t))))
 629
 630 ;; Default publishing rules
 631
 632 (defun muse-publish-section-close (depth)
 633   "Seach forward for the closing tag of given DEPTH."
 634   (let (not-end)
 635     (save-excursion
 636       (while (and (setq not-end (re-search-forward
 637                                  (concat "^\\*\\{1," (number-to-string depth)
 638                                          "\\}\\s-+")
 639                                  nil t))
 640                   (get-text-property (match-beginning 0) 'read-only)))
 641       (if not-end
 642           (forward-line 0)
 643         (goto-char (point-max)))
 644       (cond ((not (eq (char-before) ?\n))
 645              (insert "\n\n"))
 646             ((not (eq (char-before (1- (point))) ?\n))
 647              (insert "\n")))
 648       (insert (muse-markup-text 'section-close depth) "\n"))))
 649
 650 (defun muse-publish-markup-directive (&optional name value)
 651   (unless name (setq name (match-string 1)))
 652   (unless value (setq value (match-string 2)))
 653   (let ((elem (assoc name muse-publishing-directives)))
 654     (if elem
 655         (setcdr elem value)
 656       (setq muse-publishing-directives
 657             (cons (cons name value)
 658                   muse-publishing-directives))))
 659   ;; Make sure we don't ever try to move the point forward (past the
 660   ;; beginning of buffer) while we're still searching for directives.
 661   (setq muse-publishing-last-position nil)
 662   (delete-region (match-beginning 0) (match-end 0)))
 663
 664 (defun muse-publish-markup-anchor () "")
 665 (defun muse-publish-markup-comment () "")
 666
 667 (defun muse-publish-markup-tag ()
 668   (let ((tag-info (muse-markup-tag-info (match-string 1))))
 669     (when (and tag-info
 670                (not (get-text-property (match-beginning 0) 'read-only)))
 671       (let ((closed-tag (match-string 3))
 672             (start (match-beginning 0))
 673             (beg (point)) end attrs)
 674         (when (nth 2 tag-info)
 675           (let ((attrstr (match-string 2)))
 676             (while (and attrstr
 677                         (string-match (concat "\\([^"
 678                                               muse-regexp-space
 679                                               "=]+\\)\\(=\"\\"
 680                                               "([^\"]+\\)\"\\)?")
 681                                       attrstr))
 682               (let ((attr (cons (downcase
 683                                  (muse-match-string-no-properties 1 attrstr))
 684                                 (muse-match-string-no-properties 3 attrstr))))
 685                 (setq attrstr (replace-match "" t t attrstr))
 686                 (if attrs
 687                     (nconc attrs (list attr))
 688                   (setq attrs (list attr)))))))
 689         (if (and (cadr tag-info) (not closed-tag))
 690             (if (search-forward (concat "</" (car tag-info) ">") nil t)
 691                 (delete-region (match-beginning 0) (point))
 692               (setq tag-info nil)))
 693         (when tag-info
 694           (setq end (point-marker))
 695           (delete-region start beg)
 696           (goto-char start)
 697           (let ((args (list start end)))
 698             (if (nth 2 tag-info)
 699                 (nconc args (list attrs)))
 700             (apply (nth 3 tag-info) args))))))
 701   nil)
 702
 703 (defun muse-publish-escape-specials (beg end &optional ignore-read-only)
 704   "Escape specials from BEG to END using style-specific :specials.
 705 If IGNORE-READ-ONLY is non-nil, ignore the read-only property."
 706   (save-excursion
 707     (goto-char beg)
 708     (while (< (point) end)
 709       (if (and (not ignore-read-only) (get-text-property (point) 'read-only))
 710           (forward-char 1)
 711         (let ((repl
 712                (or (assoc (char-after) (muse-style-element :specials))
 713                    (assoc (char-after) muse-publish-markup-specials))))
 714           (if (null repl)
 715               (forward-char 1)
 716             (delete-char 1)
 717             (insert-before-markers (cdr repl))))))))
 718
 719 (defun muse-publish-markup-word ()
 720   (let* ((beg (match-beginning 2))
 721          (end (1- (match-end 2)))
 722          (leader (buffer-substring-no-properties beg end))
 723          open-tag close-tag mark-read-only loc)
 724     (cond
 725      ((string= leader "_")
 726       (setq open-tag (muse-markup-text 'begin-underline)
 727             close-tag (muse-markup-text 'end-underline)))
 728      ((string= leader "=")
 729       (setq open-tag (muse-markup-text 'begin-literal)
 730             close-tag (muse-markup-text 'end-literal))
 731       (setq mark-read-only t))
 732      (t
 733       (let ((l (length leader)))
 734         (cond
 735          ((= l 1) (setq open-tag (muse-markup-text 'begin-emph)
 736                         close-tag (muse-markup-text 'end-emph)))
 737          ((= l 2) (setq open-tag (muse-markup-text 'begin-more-emph)
 738                         close-tag (muse-markup-text 'end-more-emph)))
 739          ((= l 3) (setq open-tag (muse-markup-text 'begin-most-emph)
 740                         close-tag (muse-markup-text 'end-most-emph)))))))
 741     (if (and (not (get-text-property beg 'noemphasis))
 742              (setq loc (search-forward leader nil t))
 743              (or (eobp) (not (eq (char-syntax (char-after loc)) ?w)))
 744              (not (eq (char-syntax (char-before (point))) ?\ ))
 745              (not (get-text-property (point) 'noemphasis)))
 746         (progn
 747           (replace-match "")
 748           (delete-region beg end)
 749           (setq end (point-marker))
 750           (insert close-tag)
 751           (save-excursion
 752             (goto-char beg)
 753             (insert open-tag)
 754             (setq beg (point)))
 755           (when mark-read-only
 756             (muse-publish-escape-specials beg end t)
 757             (muse-publish-mark-read-only (1- beg) (1+ end))))
 758       (backward-char))
 759     nil))
 760
 761 (defun muse-publish-markup-emdash ()
 762   (delete-region (match-beginning 0) (match-end 0))
 763   (insert (muse-markup-text 'emdash))
 764   (if (eq (char-after) ?\<)
 765       (insert ?\n)))
 766
 767 (defun muse-publish-markup-enddots ()
 768   (delete-region (match-beginning 0) (match-end 0))
 769   (insert (muse-markup-text 'enddots)))
 770
 771 (defun muse-publish-markup-dots ()
 772   (delete-region (match-beginning 0) (match-end 0))
 773   (insert (muse-markup-text 'dots)))
 774
 775 (defun muse-publish-markup-rule ()
 776   (delete-region (match-beginning 0) (match-end 0))
 777   (insert (muse-markup-text 'rule)))
 778
 779 (defun muse-publish-markup-heading ()
 780   (let* ((len (length (match-string 1)))
 781          (start (muse-markup-text
 782                  (cond ((= len 1) 'section)
 783                        ((= len 2) 'subsection)
 784                        ((= len 3) 'subsubsection)
 785                        (t 'section-other))
 786                  len))
 787          (end   (muse-markup-text
 788                  (cond ((= len 1) 'section-end)
 789                        ((= len 2) 'subsection-end)
 790                        ((= len 3) 'subsubsection-end)
 791                        (t 'section-other-end))
 792                  len)))
 793     (delete-region (match-beginning 0) (match-end 0))
 794     (insert start)
 795     (end-of-line)
 796     (if end (insert end))
 797     (muse-publish-section-close len)))
 798
 799 (defvar muse-publish-footnotes nil)
 800
 801 (defun muse-publish-markup-footnote ()
 802   "Scan ahead and snarf up the footnote body"
 803   (if (= (muse-line-beginning-position) (match-beginning 0))
 804       ""
 805     (let ((footnote (save-match-data
 806                       (string-to-number (match-string 1))))
 807           footnotemark)
 808       (delete-region (match-beginning 0) (match-end 0))
 809       (save-excursion
 810         (when (re-search-forward (format "^\\[%d\\]\\s-+" footnote) nil t)
 811           (let* ((start (match-beginning 0))
 812                  (beg (goto-char (match-end 0)))
 813                  (end (save-excursion
 814                         (if (search-forward "\n\n" nil t)
 815                             (copy-marker (match-beginning 0))
 816                           (goto-char (point-max))
 817                           (skip-chars-backward "\n")
 818                           (point-marker)))))
 819             (while (re-search-forward (concat "^["
 820                                               muse-regexp-blank
 821                                               "]+\\([^\n]\\)")
 822                                       end t)
 823               (replace-match "\\1" t))
 824             (let ((footnotemark-cmd (muse-markup-text 'footnotemark))
 825                   (footnotemark-end-cmd (muse-markup-text 'footnotemark-end)))
 826               (if (string= "" footnotemark-cmd)
 827                   (setq footnotemark
 828                         (concat (muse-markup-text 'footnote)
 829                                 (buffer-substring-no-properties beg end)
 830                                 (muse-markup-text 'footnote-end)))
 831                 (setq footnotemark (format footnotemark-cmd footnote
 832                                            footnotemark-end-cmd))
 833                 (unless muse-publish-footnotes
 834                   (set (make-local-variable 'muse-publish-footnotes)
 835                        (make-vector 256 nil)))
 836                 (unless (aref muse-publish-footnotes footnote)
 837                   (setq footnotemark
 838                         (concat
 839                          footnotemark
 840                          (concat (format (muse-markup-text 'footnotetext)
 841                                          footnote)
 842                                  (buffer-substring-no-properties beg end)
 843                                  (muse-markup-text 'footnotetext-end))))
 844                   (aset muse-publish-footnotes footnote footnotemark))))
 845             (goto-char end)
 846             (skip-chars-forward "\n")
 847             (delete-region start (point)))))
 848       (insert (or footnotemark footnote)))))
 849
 850 (defun muse-publish-markup-fn-sep ()
 851   (delete-region (match-beginning 0) (match-end 0))
 852   (insert (muse-markup-text 'fn-sep)))
 853
 854 (defun muse-publish-surround-text (beg-tag end-tag move-func)
 855   (let ((beg (point)) end)
 856     (skip-chars-backward muse-regexp-space)
 857     (delete-region (point) beg)
 858     (insert "\n\n" beg-tag)
 859     (funcall move-func)
 860     (setq end (point-marker))
 861     (goto-char beg)
 862     (while (< (point) end)
 863       (if (looking-at "^\\s-+")
 864           (replace-match ""))
 865       (forward-line 1))
 866     (goto-char end)
 867     (setq beg (point))
 868     (skip-chars-backward muse-regexp-space)
 869     (delete-region (point) beg))
 870   (insert end-tag "\n"))
 871
 872 (defsubst muse-forward-paragraph (&optional pattern)
 873   (if (re-search-forward (if pattern
 874                              (concat "^\\(" pattern "["
 875                                      muse-regexp-blank
 876                                      "]+\\|$\\|\\'\\)")
 877                            "^\\s-*\\($\\|\\'\\)") nil t)
 878       (goto-char (match-beginning 0))
 879     (goto-char (point-max))))
 880
 881 (defun muse-publish-markup-list ()
 882   "Markup a list entry or quoted paragraph.
 883 The reason this function is so funky, is to prevent text properties
 884 like read-only from being inadvertently deleted."
 885   (let ((str (match-string 1)))
 886     (cond
 887      ((and (eq (aref str 0) ?-))
 888       (delete-region (match-beginning 0) (match-end 0))
 889       (muse-publish-surround-text
 890        (muse-markup-text 'begin-uli)
 891        (muse-markup-text 'end-uli)
 892        (function
 893         (lambda ()
 894           (muse-forward-paragraph (concat "["
 895                                           muse-regexp-blank
 896                                           "]+-"))))))
 897      ((and (>= (aref str 0) ?0)
 898            (<= (aref str 0) ?9))
 899       (delete-region (match-beginning 0) (match-end 0))
 900       (muse-publish-surround-text
 901        (muse-markup-text 'begin-oli)
 902        (muse-markup-text 'end-oli)
 903        (function
 904         (lambda ()
 905           (muse-forward-paragraph (concat "["
 906                                           muse-regexp-blank
 907                                           "]+[0-9]+\\."))))))
 908      (t
 909       (goto-char (match-beginning 1))
 910       (insert (muse-markup-text 'begin-ddt))
 911       (save-match-data
 912         (save-excursion
 913           (forward-line 1)
 914           (while (looking-at (concat "^\\(["
 915                                      muse-regexp-blank
 916                                      "]*\\)[^"
 917                                      muse-regexp-space
 918                                      "]"))
 919             (delete-region (match-beginning 1) (match-end 1))
 920             (forward-line 1))))
 921       (save-match-data
 922         (when (re-search-forward (concat "["
 923                                          muse-regexp-space
 924                                          "]+::["
 925                                          muse-regexp-space
 926                                          "]+")
 927                                  nil t)
 928           (replace-match (muse-markup-text 'start-dde))))
 929       (muse-forward-paragraph)
 930       (insert (muse-markup-text 'end-ddt) ?\n)))))
 931
 932 (defun muse-publish-markup-quote ()
 933   "Markup a list entry or quoted paragraph.
 934 The reason this function is so funky, is to prevent text properties
 935 like read-only from being inadvertently deleted."
 936   (let* ((ws (match-string 0))
 937          (centered (>= (string-width ws) 6))
 938          (begin-elem (if centered 'begin-center 'begin-quote))
 939          (end-elem (if centered 'end-center 'end-quote)))
 940     (muse-publish-surround-text (muse-markup-text begin-elem)
 941                                 (muse-markup-text end-elem)
 942                                 'muse-forward-paragraph)))
 943
 944 (defun muse-publish-markup-leading-space ()
 945   (let ((markup-space (muse-markup-text 'verse-space))
 946         count)
 947     (when (and markup-space
 948                (>= (setq count (skip-chars-forward " ")) 0))
 949       (delete-region (muse-line-beginning-position) (point))
 950       (while (> count 0)
 951         (insert markup-space)
 952         (setq count (- count 2))))))
 953
 954 (defun muse-publish-markup-verse ()
 955   (let ((leader (match-string 0)))
 956     (goto-char (match-beginning 0))
 957     (insert (muse-markup-text 'begin-verse))
 958     (while (looking-at leader)
 959       (replace-match "")
 960       (muse-publish-markup-leading-space)
 961       (let ((beg (point)))
 962         (end-of-line)
 963         (cond
 964          ((bolp)
 965           (let ((text (muse-markup-text 'empty-verse-line)))
 966             (if text (insert text))))
 967          ((save-excursion
 968             (save-match-data
 969               (forward-line 1)
 970               (or (looking-at (concat leader "["
 971                                       muse-regexp-blank
 972                                       "]*$"))
 973                   (not (looking-at leader)))))
 974           (let ((begin-text (muse-markup-text 'begin-last-stanza-line))
 975                 (end-text (muse-markup-text 'end-last-stanza-line)))
 976             (when end-text (insert end-text))
 977             (goto-char beg)
 978             (when begin-text (insert begin-text))
 979             (end-of-line)))
 980          (t
 981           (let ((begin-text (muse-markup-text 'begin-verse-line))
 982                 (end-text (muse-markup-text 'end-verse-line)))
 983             (when end-text (insert end-text))
 984             (goto-char beg)
 985             (when begin-text (insert begin-text))
 986             (end-of-line))))
 987         (forward-line 1))))
 988   (insert (muse-markup-text 'end-verse) ?\n))
 989
 990 (defun muse-publish-markup-table ()
 991   "Style does not support tables.")
 992
 993 (defun muse-publish-escape-specials-in-string (string &rest ignored)
 994   "Escape specials in STRING using style-specific :specials."
 995   (save-excursion
 996     (apply (function concat)
 997            (mapcar
 998             (lambda (ch)
 999               (let ((repl
1000                      (or (assoc ch (muse-style-element :specials))
1001                          (assoc ch muse-publish-markup-specials))))
1002                 (if (null repl)
1003                     (char-to-string ch)
1004                   (cdr repl))))
1005             (append string nil)))))
1006
1007 (defun muse-publish-markup-email ()
1008   (let* ((beg (match-end 1))
1009          (addr (buffer-substring-no-properties beg (match-end 0))))
1010     (setq addr (muse-publish-escape-specials-in-string addr))
1011     (goto-char beg)
1012     (delete-region beg (match-end 0))
1013     (if (or (eq (char-before (match-beginning 0)) ?\")
1014             (eq (char-after (match-end 0)) ?\"))
1015         (insert addr)
1016       (insert (format (muse-markup-text 'email-addr) addr addr)))
1017     (muse-publish-mark-read-only beg (point))))
1018
1019 (defun muse-publish-url (url &optional desc explicit)
1020   "Resolve a URL into its final <a href> form."
1021   (let ((orig-url url))
1022     (dolist (transform muse-publish-url-transforms)
1023       (setq url (save-match-data (when url (funcall transform url explicit)))))
1024     (dolist (transform muse-publish-desc-transforms)
1025       (setq desc (save-match-data
1026                    (when desc (funcall transform desc explicit)))))
1027     (if url
1028         (cond ((string-match muse-image-regexp url)
1029                (if desc
1030                    (muse-markup-text 'image-with-desc url desc)
1031                  (muse-markup-text 'image-link url)))
1032               ((and desc (string-match muse-image-regexp desc))
1033                (muse-markup-text 'url-with-image url desc))
1034               ((eq (aref url 0) ?\#)
1035                (muse-markup-text 'internal-link (substring url 1)
1036                                  (or desc orig-url)))
1037               (t
1038                (muse-markup-text 'url-link url (or desc orig-url))))
1039       desc)))
1040
1041 (defun muse-publish-insert-url (url &optional desc explicit)
1042   "Resolve a URL into its final <a href> form."
1043   (delete-region (match-beginning 0) (match-end 0))
1044   (let ((beg (point))
1045         (text (muse-publish-url url desc explicit)))
1046     (when text
1047       (insert text)
1048       (muse-publish-mark-read-only beg (point)))))
1049
1050 (defun muse-publish-markup-link ()
1051   (let (desc explicit link)
1052     (setq explicit (save-match-data
1053                      (if (string-match muse-explicit-link-regexp
1054                                        (match-string 0))
1055                          t nil)))
1056     (setq desc (if explicit (match-string 2) (match-string 0)))
1057     (setq link (if explicit
1058                    (muse-handle-explicit-link (match-string 1))
1059                  (muse-handle-implicit-link (match-string 0))))
1060     (when (and link
1061                (or explicit
1062                    (not (or (eq (char-before (match-beginning 0)) ?\")
1063                             (eq (char-after (match-end 0)) ?\")))))
1064       (muse-publish-insert-url link desc explicit))))
1065
1066 (defun muse-publish-markup-url ()
1067   (if (not (or (eq (char-before (match-beginning 0)) ?\")
1068                (eq (char-after (match-end 0)) ?\")))
1069       (muse-publish-insert-url (match-string 0))
1070     (let ((beg (match-beginning 0))
1071           (url (match-string 0)))
1072       (delete-region (match-beginning 0) (match-end 0))
1073       (insert (muse-publish-escape-specials-in-string url))
1074       (muse-publish-mark-read-only beg (point)))))
1075
1076 ;; Default publishing tags
1077
1078 (defun muse-publish-contents-tag (beg end attrs)
1079   (set (make-local-variable 'muse-publish-generate-contents)
1080        (cons (copy-marker (point) t)
1081              (let ((depth (cdr (assoc "depth" attrs))))
1082                (or (and depth (string-to-number depth)) 2)))))
1083
1084 (defun muse-publish-verse-tag (beg end)
1085   (save-excursion
1086     (goto-char beg)
1087     (while (eq ?\  (char-syntax (char-after)))
1088       (delete-char 1))
1089     (while (< (point) end)
1090       (insert "> ")
1091       (forward-line))
1092     (if (eq ?\  (char-syntax (char-before)))
1093       (delete-char -1))))
1094
1095 (defun muse-publish-mark-read-only (beg end)
1096   (add-text-properties beg end '(rear-nonsticky (read-only) read-only t))
1097   nil)
1098
1099 (defun muse-publish-mark-noemphasis (&optional beg end)
1100   (unless beg (setq beg (match-beginning 0)))
1101   (unless end (setq end (match-end 0)))
1102   (add-text-properties beg end '(noemphasis t))
1103   nil)
1104
1105 (defun muse-publish-code-tag (beg end)
1106   (muse-publish-escape-specials beg end)
1107   (goto-char beg)
1108   (insert (muse-markup-text 'begin-literal))
1109   (goto-char end)
1110   (insert (muse-markup-text 'end-literal))
1111   (muse-publish-mark-read-only beg (point)))
1112
1113 (defun muse-publish-example-tag (beg end)
1114   (muse-publish-escape-specials beg end)
1115   (goto-char beg)
1116   (insert (muse-markup-text 'begin-example))
1117   (goto-char end)
1118   (insert (muse-markup-text 'end-example))
1119   (muse-publish-mark-read-only beg (point)))
1120
1121 (defun muse-publish-verbatim-tag (beg end)
1122   (muse-publish-escape-specials beg end)
1123   (muse-publish-mark-read-only beg end))
1124
1125 (defalias 'muse-publish-class-tag 'ignore)
1126
1127 (defun muse-publish-lisp-tag (beg end)
1128   (save-excursion
1129     (let ((str (muse-eval-lisp
1130                 (prog1
1131                     (buffer-substring-no-properties beg end)
1132                   (delete-region beg end)))))
1133       (set-text-properties 0 (length str) nil str)
1134       (insert str))))
1135
1136 (defun muse-publish-command-tag (beg end attrs)
1137   (while (looking-at "\\s-*$")
1138     (forward-line))
1139   (let ((interp (cdr (assoc "interp" attrs))))
1140     (if (null interp)
1141         (shell-command
1142          (prog1
1143              (buffer-substring-no-properties (point) end)
1144            (delete-region beg end)) t)
1145       (shell-command-on-region beg end interp t t))
1146     (muse-publish-mark-read-only beg (point))))
1147
1148 (defun muse-publish-comment-tag (beg end)
1149   (delete-region beg end))
1150
1151 ;; Miscellaneous helper functions
1152
1153 (defsubst muse-publishing-directive (name)
1154   (cdr (assoc name muse-publishing-directives)))
1155
1156 (defun muse-publish-strip-tags (string)
1157   "Remove all tags from the string."
1158   (while (string-match "<.*?>" string)
1159     (setq string (replace-match "" nil t string)))
1160   string)
1161
1162 (defun muse-publish-markup-type (category default-func)
1163   (let ((rule (muse-find-markup-element :overrides category (muse-style))))
1164     (funcall (or rule default-func))))
1165
1166 (defun muse-published-buffer-contents (buffer)
1167   (with-current-buffer buffer
1168     (goto-char (point-min))
1169     (let ((beg (and (search-forward "Emacs Muse begins here")
1170                     (muse-line-end-position)))
1171           (end (and (search-forward "Emacs Muse ends here")
1172                     (muse-line-beginning-position))))
1173       (buffer-substring-no-properties beg end))))
1174
1175 (defun muse-published-contents (file)
1176   (when (file-readable-p file)
1177     (muse-with-temp-buffer
1178       (insert-file-contents file)
1179       (muse-published-buffer-contents (current-buffer)))))
1180
1181 (defun muse-publish-transform-output
1182   (file temp-file output-path name gen-func &rest cleanup-exts)
1183   "Transform the given TEMP-FILE into the OUTPUT-PATH, using GEN-FUNC."
1184   (setq file (muse-page-name file))
1185   (message "Generating %s output for %s..." name file)
1186   (if (not (funcall gen-func temp-file output-path))
1187       (message "Generating %s from %s...failed" name file)
1188     (message "Generating %s output for %s...done" name file)
1189     (muse-delete-file-if-exists temp-file)
1190     (dolist (ext cleanup-exts)
1191       (muse-delete-file-if-exists
1192        (expand-file-name (concat file ext)
1193                          (file-name-directory output-path))))
1194     (message "Wrote %s" output-path)))
1195
1196 (defun muse-publish-read-only (string)
1197   (let ((end (1- (length string))))
1198     (add-text-properties 0 end
1199                          '(rear-nonsticky (read-only) read-only t)
1200                          string)
1201     string))
1202
1203 (defun muse-publish-prepare-url (target &rest ignored)
1204   "Transform anchors and get published name, if TARGET is a page."
1205   (save-match-data
1206     (unless (or (string-match muse-url-regexp target)
1207                 (string-match muse-image-regexp target)
1208                 (string-match muse-file-regexp target))
1209       (setq target (if (string-match "#" target)
1210                        (if (eq (aref target 0) ?\#)
1211                            target
1212                          (concat (muse-publish-link-name
1213                                   (substring target 0 (match-beginning 0)))
1214                                  "#" (substring target (match-end 0))))
1215                      (muse-publish-link-name target)))))
1216   target)
1217
1218 (provide 'muse-publish)
1219
1220 ;;; muse-publish.el ends here