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