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