~ubuntu-branches/ubuntu/oneiric/muse-el/oneiric

« back to all changes in this revision

Viewing changes to lisp/muse-publish.el

  • Committer: Bazaar Package Importer
  • Author(s): Michael W. Olson (GNU address)
  • Date: 2008-01-09 15:51:46 UTC
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080109155146-vkc4ohnzv96spdpm
Tags: upstream-3.11
ImportĀ upstreamĀ versionĀ 3.11

Show diffs side-by-side

added added

removed removed

Lines of Context:
6
6
 
7
7
;; Emacs Muse is free software; you can redistribute it and/or modify
8
8
;; it under the terms of the GNU General Public License as published
9
 
;; by the Free Software Foundation; either version 2, or (at your
 
9
;; by the Free Software Foundation; either version 3, or (at your
10
10
;; option) any later version.
11
11
 
12
12
;; Emacs Muse is distributed in the hope that it will be useful, but
152
152
          0 list)
153
153
 
154
154
    ;; support table.el style tables
155
 
    (2300 ,(concat muse-table-el-border-regexp "\n"
 
155
    (2300 ,(concat "^" muse-table-el-border-regexp "\n"
156
156
                   "\\(\\(" muse-table-line-regexp "\n\\)+"
157
157
                   "\\(" muse-table-el-border-regexp "\\)"
158
158
                   "\\(\n\\|\\'\\)\\)+")
276
276
    ("ruby"     t   t   nil muse-publish-ruby-tag)
277
277
    ("comment"  t   nil nil muse-publish-comment-tag)
278
278
    ("include"  nil t   nil muse-publish-include-tag)
279
 
    ("markup"   t   t   nil muse-publish-mark-up-tag))
 
279
    ("markup"   t   t   nil muse-publish-mark-up-tag)
 
280
    ("cite"     t   t   nil muse-publish-cite-tag))
280
281
  "A list of tag specifications, for specially marking up text.
281
282
XML-style tags are the best way to add custom markup to Muse.
282
283
This is easily accomplished by customizing this list of markup tags.
307
308
                       function))
308
309
  :group 'muse-publish)
309
310
 
 
311
(defcustom muse-publish-markup-header-footer-tags
 
312
  '(("lisp"     t   t   nil muse-publish-lisp-tag)
 
313
    ("markup"   t   t   nil muse-publish-mark-up-tag))
 
314
  "Tags used when publishing headers and footers.
 
315
See `muse-publish-markup-tags' for details."
 
316
  :type '(repeat (list (string :tag "Markup tag")
 
317
                       (boolean :tag "Expect closing tag" :value t)
 
318
                       (boolean :tag "Parse attributes" :value nil)
 
319
                       (boolean :tag "Nestable" :value nil)
 
320
                       function))
 
321
  :group 'muse-publish)
 
322
 
310
323
(defcustom muse-publish-markup-specials nil
311
324
  "A table of characters which must be represented specially."
312
325
  :type '(alist :key-type character :value-type string)
336
349
  "Last position of the point when publishing.
337
350
This is used to make sure that publishing doesn't get stalled.")
338
351
 
 
352
(defvar muse-publish-inhibit-style-hooks nil
 
353
  "If non-nil, do not call the :before or :before-end hooks when publishing.")
 
354
 
 
355
(defvar muse-publish-use-header-footer-tags nil
 
356
  "If non-nil, use `muse-publish-markup-header-footer-tags' for looking up
 
357
tags.  Otherwise, use `muse-publish-markup-tags'.")
 
358
 
 
359
(defvar muse-inhibit-style-tags nil
 
360
  "If non-nil, do not search for style-specific tags.
 
361
This is used when publishing headers and footers.")
 
362
 
339
363
;; Functions for handling style information
340
364
 
341
365
(defsubst muse-style (&optional style)
451
475
          (if base
452
476
              (muse-find-markup-tag keyword tagname base))))))
453
477
 
454
 
(defsubst muse-markup-tag-info (tagname &rest args)
455
 
  (let ((tag-info (muse-find-markup-tag :tags tagname (muse-style))))
 
478
(defun muse-markup-tag-info (tagname &rest args)
 
479
  (let ((tag-info (and (not muse-inhibit-style-tags)
 
480
                       (muse-find-markup-tag :tags tagname (muse-style)))))
456
481
    (or tag-info
457
 
        (assoc tagname muse-publish-markup-tags))))
 
482
        (assoc tagname
 
483
               (if muse-publish-use-header-footer-tags
 
484
                   muse-publish-markup-header-footer-tags
 
485
                 muse-publish-markup-tags)))))
458
486
 
459
487
(defsubst muse-markup-function (category)
460
488
  (let ((func (muse-find-markup-element :functions category (muse-style))))
512
540
    (if (and verbose (not muse-batch-publishing-p))
513
541
        (message "Publishing %s...done" name))))
514
542
 
515
 
(defcustom muse-publish-markup-header-footer-tags
516
 
  '(("lisp"     t   t   nil muse-publish-lisp-tag)
517
 
    ("markup"   t   t   nil muse-publish-mark-up-tag))
518
 
  "Tags used when publishing headers and footers.
519
 
See `muse-publish-markup-tags' for details."
520
 
  :type '(repeat (list (string :tag "Markup tag")
521
 
                       (boolean :tag "Expect closing tag" :value t)
522
 
                       (boolean :tag "Parse attributes" :value nil)
523
 
                       (boolean :tag "Nestable" :value nil)
524
 
                       function))
525
 
  :group 'muse-publish)
526
 
 
527
543
(defun muse-insert-file-or-string (file-or-string &optional title)
528
544
  (let ((beg (point)) end)
529
545
    (if (and (not (string-equal file-or-string ""))
530
546
             (not (string-match "\n" file-or-string))
531
547
             (file-readable-p file-or-string))
532
 
        (setq end (+ beg (cadr (insert-file-contents file-or-string))))
 
548
        (setq end (+ beg
 
549
                     (cadr (muse-insert-file-contents file-or-string))))
533
550
      (insert file-or-string)
534
551
      (setq end (point)))
535
552
    (save-restriction
537
554
      (remove-text-properties (point-min) (point-max)
538
555
                              '(read-only nil rear-nonsticky nil))
539
556
      (goto-char (point-min))
540
 
      (let ((muse-inhibit-style-tags t))
 
557
      (let ((muse-inhibit-style-tags t)
 
558
            (muse-publish-use-header-footer-tags t))
541
559
        (muse-publish-markup (or title "")
542
560
                             '((100 muse-tag-regexp 0
543
561
                                    muse-publish-markup-tag)))))))
555
573
              (throw 'handled t))))
556
574
        (setq style (muse-style-element :base style))))))
557
575
 
558
 
(defvar muse-publish-inhibit-style-hooks nil
559
 
  "If non-nil, do not call the :before or :before-end hooks when publishing.")
560
 
 
561
576
(defun muse-publish-markup-region (beg end &optional title style)
562
577
  "Apply the given STYLE's markup rules to the given region.
563
578
TITLE is used when indicating the publishing progress; it may be nil.
637
652
                  (throw 'different t)))))
638
653
      (setq styles (muse-collect-alist
639
654
                    styles
640
 
                    (completing-read "Publish with style: " styles nil t))))
 
655
                    (funcall muse-completing-read-function
 
656
                             "Publish with style: " styles nil t))))
641
657
    (if (or (= 1 (length styles))
642
658
            (not (muse-get-keyword :path (car styles))))
643
659
        (car styles)
645
661
                             (cons (muse-get-keyword :path style)
646
662
                                   style))
647
663
                           styles))
648
 
      (cdr (assoc (completing-read "Publish to directory: " styles nil t)
 
664
      (cdr (assoc (funcall muse-completing-read-function
 
665
                           "Publish to directory: " styles nil t)
649
666
                  styles)))))
650
667
 
651
668
(defsubst muse-publish-get-output-dir (style)
672
689
            (muse-publish-output-name file style))))
673
690
 
674
691
(defsubst muse-publish-link-name (&optional file style)
 
692
  "Take FILE and add :prefix and either :link-suffix or :suffix from STYLE.
 
693
We assume that FILE is a Muse file.
 
694
 
 
695
We call `muse-page-name' on FILE to remove the directory part of
 
696
FILE and any extensions that are in `muse-ignored-extensions'."
675
697
  (setq style (muse-style style))
676
698
  (concat (muse-style-element :prefix style)
677
699
          (muse-page-name file)
679
701
              (muse-style-element :suffix style))))
680
702
 
681
703
(defsubst muse-publish-link-file (file &optional style)
 
704
  "Turn FILE into a URL.
 
705
 
 
706
If FILE exists on the system as-is, return it without
 
707
modification.  In the case of wanting to link to Muse files when
 
708
`muse-file-extension' is nil, you should load muse-project.el.
 
709
 
 
710
Otherwise, assume that it is a Muse file and call
 
711
`muse-publish-link-name' to add :prefix, :link-suffix, :suffix,
 
712
and removing ignored file extensions, but preserving the
 
713
directory part of FILE."
682
714
  (setq style (muse-style style))
683
715
  (if (file-exists-p file)
684
716
      file
686
718
            (muse-publish-link-name file style))))
687
719
 
688
720
(defsubst muse-publish-link-page (page)
 
721
  "Turn PAGE into a URL.
 
722
 
 
723
This is called by `muse-publish-classify-url' to figure out what
 
724
a link to another file or Muse page should look like.
 
725
 
 
726
If muse-project.el is loaded, call `muse-project-link-page' for this.
 
727
Otherwise, call `muse-publish-link-file'."
689
728
  (if (fboundp 'muse-project-link-page)
690
729
      (muse-project-link-page page)
691
730
    (muse-publish-link-file page)))
692
731
 
693
 
(defmacro muse-publish-ensure-block (beg)
 
732
(defmacro muse-publish-ensure-block (beg &optional end)
694
733
  "Ensure that block-level markup at BEG is published with at least one
695
 
preceding blank line.  BEG is modified to be the new position.
696
 
The point is left at the new value of BEG."
 
734
preceding blank line.  BEG must be an unquoted symbol that contains a
 
735
position or marker.  BEG is modified to be the new position.
 
736
The point is left at the new value of BEG.
 
737
 
 
738
Additionally, make sure that BEG is placed on a blank line.
 
739
 
 
740
If END is given, make sure that it is placed on a blank line.  In
 
741
order to achieve this, END must be an unquoted symbol that
 
742
contains a marker.  This is the case with Muse tag functions."
697
743
  `(progn
698
744
     (goto-char ,beg)
699
745
     (cond ((not (bolp)) (insert "\n\n"))
700
746
           ((eq (point) (point-min)) nil)
701
747
           ((prog2 (backward-char) (bolp) (forward-char)) nil)
702
748
           (t (insert "\n")))
703
 
     (setq ,beg (point))))
 
749
     (unless (and (bolp) (eolp))
 
750
       (insert "\n")
 
751
       (backward-char))
 
752
     (setq ,beg (point))
 
753
     (when (markerp ,end)
 
754
       (goto-char ,end)
 
755
       (unless (and (bolp) (eolp))
 
756
         (insert-before-markers "\n")))
 
757
     (goto-char ,beg)))
704
758
 
705
759
;;;###autoload
706
760
(defun muse-publish-region (beg end &optional title style)
752
806
                    muse-publish-report-threshhold))
753
807
            (message "Publishing %s ..." file))
754
808
        (muse-with-temp-buffer
755
 
          (insert-file-contents file)
 
809
          (muse-insert-file-contents file)
756
810
          (muse-publish-markup-buffer (muse-page-name file) style)
757
 
          (let ((backup-inhibited t))
758
 
            (write-file output-path))
759
 
          (muse-style-run-hooks :final style file output-path target))
 
811
          (when (muse-write-file output-path)
 
812
            (muse-style-run-hooks :final style file output-path target)))
760
813
        t))))
761
814
 
762
815
;;;###autoload
776
829
(defun muse-batch-publish-files ()
777
830
  "Publish Muse files in batch mode."
778
831
  (let ((muse-batch-publishing-p t)
 
832
        muse-current-output-style
779
833
        style output-dir)
 
834
    ;; don't activate VC when publishing files
 
835
    (setq vc-handled-backends nil)
780
836
    (setq style (car command-line-args-left)
781
837
          command-line-args-left (cdr command-line-args-left)
782
838
          output-dir (car command-line-args-left)
784
840
          (if (string-match "\\`--output-dir=" output-dir)
785
841
              (prog1
786
842
                  (substring output-dir (match-end 0))
787
 
                (setq command-line-args-left (cdr command-line-args-left)))))
 
843
                (setq command-line-args-left (cdr command-line-args-left))))
 
844
          muse-current-output-style (list :base style :path output-dir))
788
845
    (setq auto-mode-alist
789
846
          (delete (cons (concat "\\." muse-file-extension "\\'")
790
847
                        'muse-mode-choose-mode)
830
887
(defsubst muse-publishing-directive (name)
831
888
  (cdr (assoc name muse-publishing-directives)))
832
889
 
 
890
(defmacro muse-publish-get-and-delete-attr (attr attrs)
 
891
  "Delete attribute ATTR from ATTRS only once, destructively.
 
892
 
 
893
This function returns the matching attribute value, if found."
 
894
  (let ((last (make-symbol "last"))
 
895
        (found (make-symbol "found"))
 
896
        (vals (make-symbol "vals")))
 
897
    `(let ((,vals ,attrs))
 
898
       (if (string= (caar ,vals) ,attr)
 
899
           (prog1 (cdar ,vals)
 
900
             (setq ,attrs (cdr ,vals)))
 
901
         (let ((,last ,vals)
 
902
               (,found nil))
 
903
           (while ,vals
 
904
             (setq ,vals (cdr ,vals))
 
905
             (when (string= (caar ,vals) ,attr)
 
906
               (setq ,found (cdar ,vals))
 
907
               (setcdr ,last (cdr ,vals))
 
908
               (setq ,vals nil))
 
909
             (setq ,last ,vals))
 
910
           ,found)))))
 
911
 
833
912
(defun muse-publish-markup-anchor ()
834
913
  (unless (get-text-property (match-end 1) 'muse-link)
835
914
    (let ((text (muse-markup-text 'anchor (match-string 2))))
852
931
    (goto-char (match-beginning 0))
853
932
    (muse-insert-markup (muse-markup-text 'comment-begin))))
854
933
 
855
 
(defvar muse-inhibit-style-tags nil
856
 
  "If non-nil, do not search for style-specific tags.
857
 
This is used when publishing headers and footers.")
858
 
 
859
934
(defun muse-publish-markup-tag ()
860
 
  (let ((tag-info (if muse-inhibit-style-tags
861
 
                      (assoc (match-string 1) muse-publish-markup-tags)
862
 
                    (muse-markup-tag-info (match-string 1)))))
 
935
  (let ((tag-info (muse-markup-tag-info (match-string 1))))
863
936
    (when (and tag-info
864
937
               (not (get-text-property (match-beginning 0) 'read-only)))
865
938
      (let ((closed-tag (match-string 3))
894
967
                (nconc args (list attrs)))
895
968
            (let ((muse-inhibit-style-tags nil))
896
969
              ;; remove the inhibition
897
 
              (apply (nth 4 tag-info) args)))))))
 
970
              (apply (nth 4 tag-info) args)))
 
971
          (set-marker end nil)))))
898
972
  nil)
899
973
 
900
974
(defun muse-publish-escape-specials (beg end &optional ignore-read-only context)
979
1053
          (setq beg (point))
980
1054
          (when mark-read-only
981
1055
            (muse-publish-escape-specials beg end t context)
982
 
            (muse-publish-mark-read-only beg end)))
 
1056
            (muse-publish-mark-read-only beg end))
 
1057
          (set-marker end nil))
983
1058
      (backward-char))
984
1059
    nil))
985
1060
 
1088
1163
                  (aset muse-publish-footnotes footnote footnotemark))))
1089
1164
            (goto-char end)
1090
1165
            (skip-chars-forward "\n")
1091
 
            (delete-region start (point)))))
 
1166
            (delete-region start (point))
 
1167
            (set-marker end nil))))
1092
1168
      (if footnotemark
1093
1169
          (muse-insert-markup footnotemark)
1094
1170
        (insert oldtext))))))
1127
1203
         (beg-dde (muse-markup-text 'begin-dde)) ;; definition
1128
1204
         (end-dde (muse-markup-text 'end-dde))
1129
1205
         (continue t)
1130
 
         def-on-same-line beg)
 
1206
         (no-terms t)
 
1207
         beg)
1131
1208
    (while continue
1132
1209
      ;; envelope this as one term+definitions unit -- HTML does not
1133
1210
      ;; need this, but DocBook and Muse's custom XML format do
1134
1211
      (muse-insert-markup beg-item)
1135
1212
      (when (looking-at muse-dl-term-regexp)
1136
1213
        ;; find the term and wrap it with published markup
1137
 
        (setq beg (point))
 
1214
        (setq beg (point)
 
1215
              no-terms nil)
1138
1216
        (goto-char (match-end 1))
1139
1217
        (delete-region (point) (match-end 0))
1140
1218
        (muse-insert-markup-end-list end-ddt)
1145
1223
          (goto-char beg)
1146
1224
          (delete-region (point) (match-beginning 1))
1147
1225
          (muse-insert-markup beg-ddt)))
 
1226
      ;; handle pathological edge case where there is no term -- I
 
1227
      ;; would prefer to just disallow this, but people seem to want
 
1228
      ;; this behavior
 
1229
      (when (and no-terms
 
1230
                 (looking-at (concat "[" muse-regexp-blank "]*::"
 
1231
                                     "[" muse-regexp-blank "]*")))
 
1232
        (delete-region (point) (match-end 0))
 
1233
        ;; but only do this once
 
1234
        (setq no-terms nil))
1148
1235
      (setq beg (point)
1149
1236
            ;; move past current item
1150
1237
            continue (muse-forward-list-item 'dl-term indent))
1223
1310
          ;; same type
1224
1311
          (replace-match "" t t nil 1))
1225
1312
      (save-restriction
1226
 
        (narrow-to-region beg (point))
1227
1313
        ;; narrow to current item
 
1314
        (narrow-to-region beg (point))
1228
1315
        (goto-char (point-min))
1229
 
        (forward-line 1)
 
1316
        (if (looking-at empty-line)
 
1317
            ;; if initial line is blank, move to first non-blank line
 
1318
            (while (progn (forward-line 1)
 
1319
                          (and (< (point) (point-max))
 
1320
                               (looking-at empty-line))))
 
1321
          ;; otherwise, move to second line of text
 
1322
          (forward-line 1))
 
1323
        ;; strip list indentation
1230
1324
        (muse-publish-strip-list-indentation list-item empty-line
1231
1325
                                             indent post-indent)
1232
1326
        (skip-chars-backward (concat muse-regexp-blank "\n"))
1238
1332
        (when continue
1239
1333
          (goto-char (point-max)))))))
1240
1334
 
 
1335
(defun muse-publish-ensure-blank-line ()
 
1336
  "Make sure that a blank line exists on the line before point."
 
1337
  (let ((pt (point-marker)))
 
1338
    (beginning-of-line)
 
1339
    (cond ((eq (point) (point-min)) nil)
 
1340
          ((prog2 (backward-char) (bolp) (forward-char)) nil)
 
1341
          (t (insert-before-markers "\n")))
 
1342
    (goto-char pt)
 
1343
    (set-marker pt nil)))
 
1344
 
1241
1345
(defun muse-publish-markup-list ()
1242
1346
  "Markup a list entry.
1243
1347
This function works by marking up items of the same list level
1254
1358
     ((eq type 'ul)
1255
1359
      (unless (eq (char-after (match-end 1)) ?-)
1256
1360
        (delete-region (match-beginning 0) (match-end 0))
1257
 
        (let ((beg (point)))
1258
 
          (muse-publish-ensure-block beg))
 
1361
        (muse-publish-ensure-blank-line)
1259
1362
        (muse-insert-markup (muse-markup-text 'begin-uli))
1260
1363
        (save-excursion
1261
1364
          (muse-publish-surround-text
1268
1371
        (forward-line 1)))
1269
1372
     ((eq type 'ol)
1270
1373
      (delete-region (match-beginning 0) (match-end 0))
1271
 
      (let ((beg (point)))
1272
 
        (muse-publish-ensure-block beg))
 
1374
      (muse-publish-ensure-blank-line)
1273
1375
      (muse-insert-markup (muse-markup-text 'begin-oli))
1274
1376
      (save-excursion
1275
1377
        (muse-publish-surround-text
1280
1382
         indent post-indent)
1281
1383
        (muse-insert-markup-end-list (muse-markup-text 'end-oli)))
1282
1384
      (forward-line 1))
1283
 
     ((not (string= (match-string 2) ""))
1284
 
      ;; must have an initial term
 
1385
     (t
1285
1386
      (goto-char (match-beginning 0))
1286
 
      (let ((beg (point)))
1287
 
        (muse-publish-ensure-block beg))
 
1387
      (muse-publish-ensure-blank-line)
1288
1388
      (muse-insert-markup (muse-markup-text 'begin-dl))
1289
1389
      (save-excursion
1290
1390
        (muse-publish-surround-dl indent post-indent)
1628
1728
                   muse-publish-contents-depth)))))
1629
1729
 
1630
1730
(defun muse-publish-verse-tag (beg end)
1631
 
  (muse-publish-ensure-block beg)
 
1731
  (muse-publish-ensure-block beg end)
1632
1732
  (save-excursion
1633
1733
    (save-restriction
1634
1734
      (narrow-to-region beg end)
1635
1735
      (goto-char (point-min))
1636
 
      (while (eq ?\  (char-syntax (char-after)))
1637
 
        (delete-char 1))
 
1736
      (delete-char 1)
1638
1737
      (while (< (point) (point-max))
1639
1738
        (insert "> ")
1640
1739
        (forward-line))
1695
1794
  (insert (muse-markup-text 'end-literal))
1696
1795
  (muse-publish-mark-read-only beg (point)))
1697
1796
 
 
1797
(defun muse-publish-cite-tag (beg end attrs)
 
1798
  (let* ((type (muse-publish-get-and-delete-attr "type" attrs))
 
1799
         (citetag (cond ((string-equal type "author")
 
1800
                         'begin-cite-author)
 
1801
                        ((string-equal type "year")
 
1802
                         'begin-cite-year)
 
1803
                        (t
 
1804
                         'begin-cite))))
 
1805
    (goto-char beg)
 
1806
    (insert (muse-markup-text citetag (muse-publishing-directive "bibsource")))
 
1807
    (goto-char end)
 
1808
    (insert (muse-markup-text 'end-cite))
 
1809
    (muse-publish-mark-read-only beg (point))))
 
1810
 
1698
1811
(defun muse-publish-src-tag (beg end attrs)
1699
1812
  (muse-publish-example-tag beg end))
1700
1813
 
1701
1814
(defun muse-publish-example-tag (beg end)
1702
 
  (muse-publish-ensure-block beg)
 
1815
  (muse-publish-ensure-block beg end)
1703
1816
  (muse-publish-escape-specials beg end nil 'example)
1704
1817
  (goto-char beg)
1705
1818
  (insert (muse-markup-text 'begin-example))
1739
1852
(defun muse-publish-call-tag-on-buffer (tag &optional attrs)
1740
1853
  "Transform the current buffer as if it were surrounded by the tag TAG.
1741
1854
If attributes ATTRS are given, pass them to the tag function."
1742
 
  (let ((tag-info (if muse-inhibit-style-tags
1743
 
                      (assoc tag muse-publish-markup-tags)
1744
 
                    (muse-markup-tag-info tag))))
 
1855
  (let ((tag-info (muse-markup-tag-info tag)))
1745
1856
    (when tag-info
1746
1857
      (let* ((end (progn (goto-char (point-max)) (point-marker)))
1747
1858
             (args (list (point-min) end))
1748
1859
             (muse-inhibit-style-tags nil))
1749
1860
        (when (nth 2 tag-info)
1750
1861
          (nconc args (list attrs)))
1751
 
        (apply (nth 4 tag-info) args)))))
 
1862
        (apply (nth 4 tag-info) args)
 
1863
        (set-marker end nil)))))
1752
1864
 
1753
1865
(defun muse-publish-examplify-buffer (&optional attrs)
1754
1866
  "Transform the current buffer as if it were an <example> region."
1766
1878
                              muse-publish-markup-verse)))
1767
1879
  (goto-char (point-min)))
1768
1880
 
1769
 
(defmacro muse-publish-get-and-delete-attr (attr attrs)
1770
 
  "Delete attribute ATTR from ATTRS only once, destructively.
1771
 
 
1772
 
This function returns the matching attribute value, if found."
1773
 
  (let ((last (make-symbol "last"))
1774
 
        (found (make-symbol "found"))
1775
 
        (vals (make-symbol "vals")))
1776
 
    `(let ((,vals ,attrs))
1777
 
       (if (string= (caar ,vals) ,attr)
1778
 
           (prog1 (cdar ,vals)
1779
 
             (setq ,attrs (cdr ,vals)))
1780
 
         (let ((,last ,vals)
1781
 
               (,found nil))
1782
 
           (while ,vals
1783
 
             (setq ,vals (cdr ,vals))
1784
 
             (when (string= (caar ,vals) ,attr)
1785
 
               (setq ,found (cdar ,vals))
1786
 
               (setcdr ,last (cdr ,vals))
1787
 
               (setq ,vals nil))
1788
 
             (setq ,last ,vals))
1789
 
           ,found)))))
1790
 
 
1791
1881
(defmacro muse-publish-markup-attribute (beg end attrs reinterp &rest body)
1792
1882
  "Evaluate BODY within the bounds of BEG and END.
1793
1883
ATTRS is an alist.  Only the \"markup\" element of ATTRS is acted
1815
1905
take the ATTRS parameter.
1816
1906
 
1817
1907
BEG is modified to be the start of the published markup."
1818
 
  (let ((markup (make-symbol "markup"))
 
1908
  (let ((attrs-sym (make-symbol "attrs"))
 
1909
        (markup (make-symbol "markup"))
1819
1910
        (markup-function (make-symbol "markup-function")))
1820
 
    `(let ((,markup (muse-publish-get-and-delete-attr "markup" ,attrs)))
 
1911
    `(let* ((,attrs-sym ,attrs)
 
1912
            (,markup (muse-publish-get-and-delete-attr "markup" ,attrs-sym)))
1821
1913
       (save-restriction
1822
1914
         (narrow-to-region ,beg ,end)
1823
1915
         (goto-char (point-min))
1838
1930
                    (error "Invalid markup function `%s'" ,markup))
1839
1931
                   (t nil))
1840
1932
             (if ,markup-function
1841
 
                 (funcall ,markup-function ,attrs)
 
1933
                 (funcall ,markup-function ,attrs-sym)
1842
1934
               (muse-publish-mark-read-only (point-min) (point-max))
1843
1935
               (goto-char (point-max)))))))))
1844
1936
 
1845
1937
(put 'muse-publish-markup-attribute 'lisp-indent-function 4)
1846
1938
(put 'muse-publish-markup-attribute 'edebug-form-spec
1847
 
     '(form form form form body))
 
1939
     '(sexp sexp sexp sexp body))
1848
1940
 
1849
1941
(defun muse-publish-lisp-tag (beg end attrs)
1850
1942
  (muse-publish-markup-attribute beg end attrs nil
1851
1943
    (save-excursion
1852
 
      (let ((str (muse-eval-lisp
1853
 
                  (prog1
1854
 
                      (concat "(progn "
1855
 
                              (buffer-substring-no-properties (point-min)
1856
 
                                                              (point-max))
1857
 
                              ")")
1858
 
                    (delete-region beg end)))))
1859
 
        (set-text-properties 0 (length str) nil str)
1860
 
        (insert str)))))
 
1944
      (save-restriction
 
1945
        (let ((str (muse-eval-lisp
 
1946
                    (prog1
 
1947
                        (concat "(progn "
 
1948
                                (buffer-substring-no-properties (point-min)
 
1949
                                                                (point-max))
 
1950
                                ")")
 
1951
                      (delete-region (point-min) (point-max))
 
1952
                      (widen)))))
 
1953
          (set-text-properties 0 (length str) nil str)
 
1954
          (insert str))))))
1861
1955
 
1862
1956
(defun muse-publish-command-tag (beg end attrs)
1863
1957
  (muse-publish-markup-attribute beg end attrs nil
1912
2006
being inserted.  See `muse-publish-markup-attribute' for an
1913
2007
explanation of how it works."
1914
2008
  (let ((filename (muse-publish-get-and-delete-attr "file" attrs))
1915
 
        (muse-publishing-directives muse-publishing-directives))
 
2009
        (muse-publishing-directives (copy-alist muse-publishing-directives)))
1916
2010
    (if filename
1917
2011
        (setq filename (expand-file-name
1918
2012
                        filename
1919
2013
                        (file-name-directory muse-publishing-current-file)))
1920
2014
      (error "No file attribute specified in <include> tag"))
1921
2015
    (muse-publish-markup-attribute beg end attrs t
1922
 
      (insert-file-contents filename))))
 
2016
      (muse-insert-file-contents filename))))
1923
2017
 
1924
2018
(defun muse-publish-mark-up-tag (beg end attrs)
1925
2019
  "Run an Emacs Lisp function on the region delimted by this tag.
1949
2043
                               muse-publishing-current-style))
1950
2044
            (and (not exactp) (muse-style-derived-p style)))
1951
2045
        (let* ((function (cdr (assoc "function" attrs)))
1952
 
               (muse-publishing-directives muse-publishing-directives)
 
2046
               (muse-publish-use-header-footer-tags nil)
1953
2047
               (markup-function (and function (intern function))))
1954
2048
          (if (and markup-function (functionp markup-function))
1955
2049
              (save-restriction
1971
2065
        (match-string 1 string)
1972
2066
      string)))
1973
2067
 
1974
 
(defun muse-publish-strip-tags (string)
1975
 
  "Remove all tags from the string."
1976
 
  (while (string-match "<.*?>" string)
1977
 
    (setq string (replace-match "" nil t string)))
1978
 
  string)
1979
 
 
1980
2068
(defun muse-publish-markup-type (category default-func)
1981
2069
  (let ((rule (muse-find-markup-element :overrides category (muse-style))))
1982
2070
    (funcall (or rule default-func))))
1993
2081
(defun muse-published-contents (file)
1994
2082
  (when (file-readable-p file)
1995
2083
    (muse-with-temp-buffer
1996
 
      (insert-file-contents file)
 
2084
      (muse-insert-file-contents file)
1997
2085
      (muse-published-buffer-contents (current-buffer)))))
1998
2086
 
1999
2087
(defun muse-publish-transform-output