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