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.
12
12
;; Emacs Muse is distributed in the hope that it will be useful, but
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.
308
309
:group 'muse-publish)
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)
321
:group 'muse-publish)
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.")
352
(defvar muse-publish-inhibit-style-hooks nil
353
"If non-nil, do not call the :before or :before-end hooks when publishing.")
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'.")
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.")
339
363
;; Functions for handling style information
341
365
(defsubst muse-style (&optional style)
452
476
(muse-find-markup-tag keyword tagname base))))))
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)))))
457
(assoc tagname muse-publish-markup-tags))))
483
(if muse-publish-use-header-footer-tags
484
muse-publish-markup-header-footer-tags
485
muse-publish-markup-tags)))))
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))))
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)
525
:group 'muse-publish)
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))))
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))))))
558
(defvar muse-publish-inhibit-style-hooks nil
559
"If non-nil, do not call the :before or :before-end hooks when publishing.")
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
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))))
645
661
(cons (muse-get-keyword :path style)
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)
651
668
(defsubst muse-publish-get-output-dir (style)
672
689
(muse-publish-output-name file style))))
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.
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))))
681
703
(defsubst muse-publish-link-file (file &optional style)
704
"Turn FILE into a URL.
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.
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)
686
718
(muse-publish-link-name file style))))
688
720
(defsubst muse-publish-link-page (page)
721
"Turn PAGE into a URL.
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.
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)))
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.
738
Additionally, make sure that BEG is placed on a blank line.
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."
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))
755
(unless (and (bolp) (eolp))
756
(insert-before-markers "\n")))
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)))
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)
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)))
890
(defmacro muse-publish-get-and-delete-attr (attr attrs)
891
"Delete attribute ATTR from ATTRS only once, destructively.
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)
900
(setq ,attrs (cdr ,vals)))
904
(setq ,vals (cdr ,vals))
905
(when (string= (caar ,vals) ,attr)
906
(setq ,found (cdar ,vals))
907
(setcdr ,last (cdr ,vals))
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))))
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.")
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)))))
900
974
(defun muse-publish-escape-specials (beg end &optional ignore-read-only context)
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))
1130
def-on-same-line 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
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
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))
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))
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
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"))
1239
1333
(goto-char (point-max)))))))
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)))
1339
(cond ((eq (point) (point-min)) nil)
1340
((prog2 (backward-char) (bolp) (forward-char)) nil)
1341
(t (insert-before-markers "\n")))
1343
(set-marker pt nil)))
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
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)))
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
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)))))
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)))
1638
1737
(while (< (point) (point-max))
1640
1739
(forward-line))
1695
1794
(insert (muse-markup-text 'end-literal))
1696
1795
(muse-publish-mark-read-only beg (point)))
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")
1801
((string-equal type "year")
1806
(insert (muse-markup-text citetag (muse-publishing-directive "bibsource")))
1808
(insert (muse-markup-text 'end-cite))
1809
(muse-publish-mark-read-only beg (point))))
1698
1811
(defun muse-publish-src-tag (beg end attrs)
1699
1812
(muse-publish-example-tag beg end))
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)))
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)))))
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)))
1769
(defmacro muse-publish-get-and-delete-attr (attr attrs)
1770
"Delete attribute ATTR from ATTRS only once, destructively.
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)
1779
(setq ,attrs (cdr ,vals)))
1783
(setq ,vals (cdr ,vals))
1784
(when (string= (caar ,vals) ,attr)
1785
(setq ,found (cdar ,vals))
1786
(setcdr ,last (cdr ,vals))
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.
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))
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)))))))))
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))
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
1855
(buffer-substring-no-properties (point-min)
1858
(delete-region beg end)))))
1859
(set-text-properties 0 (length str) nil str)
1945
(let ((str (muse-eval-lisp
1948
(buffer-substring-no-properties (point-min)
1951
(delete-region (point-min) (point-max))
1953
(set-text-properties 0 (length str) nil str)
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)))
1917
2011
(setq filename (expand-file-name
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))))
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)
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)))
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)))))
1999
2087
(defun muse-publish-transform-output