lisp/muse-publish.el

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