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