diff options
| author |  Tom Willemsen | 2011-03-17 11:23:07 +0100 |
|---|---|---|
| committer | Tom Willemsen | 2011-03-17 11:23:07 +0100 |
| commit | 57366f385a2f1f35bbe741d7542096db81368c72 (patch) | |
| tree | 0313b707c3a472aec1c857dd75a4ad56cba7f747 | |
| parent | a502df33cea9806665f550d93999d89585269e93 (diff) | |
| download | dotfiles-57366f385a2f1f35bbe741d7542096db81368c72.tar.gz dotfiles-57366f385a2f1f35bbe741d7542096db81368c72.zip | |
Big changes, last one before I wipe it all.
* Added muse
* Added graphviz-dot-mode
* Remove all trailing whitespace on save.
This is the last commit I'm going to do before throwing it all away
again.
38 files changed, 15070 insertions, 7 deletions
diff --git a/emacs.d/.gitignore b/emacs.d/.gitignore index 2a5e743..c3659e1 100644 --- a/emacs.d/.gitignore +++ b/emacs.d/.gitignore @@ -1,2 +1,3 @@ tramp elpa +bookmarks diff --git a/emacs.d/00-paths.el b/emacs.d/00-paths.el index 41f9a31..1990c59 100644 --- a/emacs.d/00-paths.el +++ b/emacs.d/00-paths.el @@ -2,3 +2,4 @@ (add-to-list 'load-path "~/.emacs.d/naquadah-theme") (add-to-list 'load-path "~/.emacs.d/auto-complete-clang") (add-to-list 'load-path "~/.emacs.d/nxhtml") +(add-to-list 'load-path "~/.emacs.d/elisp/muse") diff --git a/emacs.d/10-modules.el b/emacs.d/10-modules.el index 61c2533..6a9b01d 100644 --- a/emacs.d/10-modules.el +++ b/emacs.d/10-modules.el @@ -1,19 +1,25 @@ (require 'minimap) (require 'naquadah-theme) ;(require 'auto-complete-clang) +(require 'muse-mode) +(require 'muse-html) +(require 'muse-project) + (load "autostart.el") (autoload 'vala-mode - "vala-mode" "A Major mode for editing Vala files" t) + "vala-mode" "A Major mode for editing Vala files" t) (autoload 'csharp-mode - "csharp-mode" "A Major mode for editing C# files" t) + "csharp-mode" "A Major mode for editing C# files" t) (autoload 'javascript-mode - "javascript" "A Major mode for editing JavaScript files" t) + "javascript" "A Major mode for editing JavaScript files" t) (autoload 'sqlplus-mode - "sqlplus" "A Major mode for communicating with Oracle" t) + "sqlplus" "A Major mode for communicating with Oracle" t) (autoload 'batch-mode - "batch-mode" "A Major mode for editing Batch files" t) + "batch-mode" "A Major mode for editing Batch files" t) (autoload 'lua-mode - "lua-mode" "A Major mode for editing Lua files" t) + "lua-mode" "A Major mode for editing Lua files" t) (autoload 'php-mode - "php-mode" "A Major mode for editing PHP files" t) + "php-mode" "A Major mode for editing PHP files" t) +(autoload 'graphviz-dot-mode + "graphviz-dot-mode" "A Major mode for editing graphviz dot files" t) diff --git a/emacs.d/10-settings.el b/emacs.d/10-settings.el index 1877c58..6a43f8a 100644 --- a/emacs.d/10-settings.el +++ b/emacs.d/10-settings.el @@ -24,6 +24,7 @@ (delete-selection-mode t) ; delete selection upon typing ;; Byte-compile elisp files on save +(add-hook 'before-save-hook 'delete-trailing-whitespace) (add-hook 'after-save-hook (lambda () (let ((fname (buffer-file-name))) diff --git a/emacs.d/20-org.el b/emacs.d/20-org.el index 6aa5b0a..267f853 100644 --- a/emacs.d/20-org.el +++ b/emacs.d/20-org.el @@ -13,6 +13,10 @@ (setq org-crypt-key "33E8CC1CC4") ; GPG key used for encryption (setq org-use-fast-todo-selection t) +(setq org-default-notes-file (concat org-directory "/notes.org")) +(setq org-refile-targets '((org-agenda-files :maxlevel . 5) + (nil :maxlevel . 5))) +(setq org-outline-path-complete-in-steps t) (setq org-todo-keyword-faces '(("TODO" :foreground "red" :weight bold) diff --git a/emacs.d/50-muse-projects.el b/emacs.d/50-muse-projects.el new file mode 100644 index 0000000..086ab60 --- /dev/null +++ b/emacs.d/50-muse-projects.el @@ -0,0 +1,3 @@ +(setq muse-project-alist + '(("lxcoding-docs" ("~/prj/lxcoding-docs" :default "index") + (:base "html" :path "~/devel/mnt/lxcoding/www/docs")))) diff --git a/emacs.d/50-org-projects.el b/emacs.d/50-org-projects.el new file mode 100644 index 0000000..72c271d --- /dev/null +++ b/emacs.d/50-org-projects.el @@ -0,0 +1,13 @@ +(require 'org-publish) +(setq org-publish-project-alist + '(("lxcoding-docs" + :base-directory "~/devel/lxcoding-docs/" + :base-extension "org" + :publishing-directory "~/lxcoding-docs-test/" + :recursive t + :publishing-function org-publish-org-to-html + :headline-levels + :auto-preamble t + :auto-sitemap t + :sitemap-filename "sitemap.org" + :sitemap-title "docs sitemap"))) diff --git a/emacs.d/elisp/graphviz-dot-mode.el b/emacs.d/elisp/graphviz-dot-mode.el new file mode 100644 index 0000000..6691d0e --- /dev/null +++ b/emacs.d/elisp/graphviz-dot-mode.el @@ -0,0 +1,946 @@ +;;; graphviz-dot-mode.el --- Mode for the dot-language used by graphviz (att). + +;; Copyright (C) 2002 - 2011 Pieter Pareit <pieter.pareit@gmail.com> + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be +;; useful, but WITHOUT ANY WARRANTY; without even the implied +;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. See the GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public +;; License along with this program; if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, +;; MA 02111-1307 USA + +;; Authors: Pieter Pareit <pieter.pareit@gmail.com> +;; Rubens Ramos <rubensr AT users.sourceforge.net> +;; Eric Anderson http://www.ece.cmu.edu/~andersoe/ +;; Maintainer: Pieter Pareit <pieter.pareit@gmail.com> +;; Homepage: http://users.skynet.be/ppareit/projects/graphviz-dot-mode/graphviz-dot-mode.html +;; Created: 28 Oct 2002 +;; Last modified: 09 march 2011 +;; Version: 0.3.7 +;; Keywords: mode dot dot-language dotlanguage graphviz graphs att + +;;; Commentary: +;; Use this mode for editing files in the dot-language (www.graphviz.org and +;; http://www.research.att.com/sw/tools/graphviz/). +;; +;; To use graphviz-dot-mode, add +;; (load-file "PATH_TO_FILE/graphviz-dot-mode.el") +;; to your ~/.emacs(.el) or ~/.xemacs/init.el +;; +;; The graphviz-dot-mode will do font locking, indentation, preview of graphs +;; and eases compilation/error location. There is support for both GNU Emacs +;; and XEmacs. +;; +;; Font locking is automatic, indentation uses the same commands as +;; other modes, tab, M-j and C-M-q. Insertion of comments uses the +;; same commands as other modes, M-; . You can compile a file using +;; M-x compile or C-c c, after that M-x next-error will also work. +;; There is support for viewing an generated image with C-c p. + +;;; Todo: +;; * cleanup the mess of graphviz-dot-compilation-parse-errors. +;; * electric indentation is fundamentally broken, because +;; {...} are also used for record nodes. You could argue, I suppose, that +;; many diagrams don't need those, but it would be worth having a note (and +;; it makes sense that the default is now for electric indentation to be +;; off). +;; * lines that start with # are comments, lines that start with one or more +;; whitespaces and then a # should give an error. + +;;; History: + +;; Version 0.3.7 Tim Allen +;; 09/03/2011: * fix spaces in file names when compiling +;; Version 0.3.6 maintenance +;; 19/02/2011: * .gv is the new extension (Pander) +;; * comments can start with # (Pander) +;; * highlight of new keywords (Pander) +;; Version 0.3.5 bug (or at least feature I dislike) fix +;; 11/11/2010: Eric Anderson http://www.ece.cmu.edu/~andersoe/ +;; * Preserve indentation across blank (whitespace-only) lines +;; Version 0.3.4 bug fixes +;; 24/02/2005: * fixed a bug in graphviz-dot-preview +;; Version 0.3.3 bug fixes +;; 13/02/2005: Reuben Thomas <rrt AT sc3d.org> +;; * add graphviz-dot-indent-width +;; Version 0.3.2 bug fixes +;; 25/03/2004: Rubens Ramos <rubensr AT users.sourceforge.net> +;; * semi-colons and brackets are added when electric +;; behaviour is disabled. +;; * electric characters do not behave electrically inside +;; comments or strings. +;; * default for electric-braces is disabled now (makes more +;; sense I guess). +;; * using read-from-minibuffer instead of read-shell-command +;; for emacs. +;; * Fixed test for easymenu, so that it works on older +;; versions of XEmacs. +;; * Fixed indentation error when trying to indent last brace +;; of an empty graph. +;; * region-active-p does not exist in emacs (21.2 at least), +;; so removed from code +;; * Added uncomment menu option +;; Version 0.3.1 bug fixes +;; 03/03/2004: * backward-word needs argument for older emacs +;; Version 0.3 added features and fixed bugs +;; 10/01/2004: fixed a bug in graphviz-dot-indent-graph +;; 08/01/2004: Rubens Ramos <rubensr AT users.sourceforge.net> +;; * added customization support +;; * Now it works on XEmacs and Emacs +;; * Added support to use an external Viewer +;; * Now things do not break when dot mode is entered +;; when there is no buffer name, but the side effect is +;; that in this case, the compilation command is not +;; correct. +;; * Preview works on XEmacs and emacs. +;; * Electric indentation on newline +;; * Minor changes to indentation +;; * Added keyword completion (but could be A LOT better) +;; * There are still a couple of ugly hacks. Look for 'RR'. +;; Version 0.2 added features +;; 11/11/2002: added preview support. +;; 10/11/2002: indent a graph or subgraph at once with C-M-q. +;; 08/11/2002: relaxed rules for indentation, the may now be extra chars +;; after beginning of graph (comment's for example). +;; Version 0.1.2 bug fixes and naming issues +;; 06/11/2002: renamed dot-font-lock-defaults to dot-font-lock-keywords. +;; added some documentation to dot-colors. +;; provided a much better way to handle my max-specpdl-size +;; problem. +;; added an extra autoload cookie (hope this helps, as I don't +;; yet use autoload myself) +;; Version 0.1.1 bug fixes +;; 06/11/2002: added an missing attribute, for font-locking to work. +;; fixed the regex generating, so that it only recognizes +;; whole words +;; 05/11/2002: there can now be extra white space chars after an '{'. +;; 04/11/2002: Why I use max-specpdl-size is now documented, and old value +;; gets restored. +;; Version 0.1 initial release +;; 02/11/2002: implemented parser for *compilation* of a .dot file. +;; 01/11/2002: implemented compilation of an .dot file. +;; 31/10/2002: added syntax-table to the mode. +;; 30/10/2002: implemented indentation code. +;; 29/10/2002: implemented all of font-lock. +;; 28/10/2002: derived graphviz-dot-mode from fundamental-mode, started +;; implementing font-lock. + +;;; Code: + +(defconst graphviz-dot-mode-version "0.3.6" + "Version of `graphviz-dot-mode.el'.") + +(defgroup graphviz nil + "Major mode for editing Graphviz Dot files" + :group 'tools) + +(defun graphviz-dot-customize () + "Run \\[customize-group] for the `graphviz' group." + (interactive) + (customize-group 'graphviz)) + +(defvar graphviz-dot-mode-abbrev-table nil + "Abbrev table in use in Graphviz Dot mode buffers.") +(define-abbrev-table 'graphviz-dot-mode-abbrev-table ()) + +(defcustom graphviz-dot-dot-program "dot" + "*Location of the dot program. This is used by `compile'." + :type 'string + :group 'graphviz) + +(defcustom graphviz-dot-view-command "doted %s" + "*External program to run on the buffer. You can use `%s' in this string, +and it will be substituted by the buffer name." + :type 'string + :group 'graphviz) + +(defcustom graphviz-dot-view-edit-command nil + "*Whether to allow the user to edit the command to run an external +viewer." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-save-before-view t + "*If not nil, M-x graphviz-dot-view saves the current buffer before running +the command." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-auto-indent-on-newline t + "*If not nil, `electric-graphviz-dot-terminate-line' is executed in a line is terminated." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-indent-width default-tab-width + "*Indentation width in Graphviz Dot mode buffers." + :type 'integer + :group 'graphviz) + +(defcustom graphviz-dot-auto-indent-on-braces nil + "*If not nil, `electric-graphviz-dot-open-brace' and `electric-graphviz-dot-close-brace' are executed when { or } are typed" + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-auto-indent-on-semi t + "*If not nil, `electric-graphviz-dot-semi' is executed when semicolon is typed" + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-preview-extension "png" + "*The extension to use for the compilation and preview commands. The format +for the compilation command is +`dot -T<extension> file.dot > file.<extension>'." + :type 'string + :group 'graphviz) + +(defcustom graphviz-dot-toggle-completions nil + "*Non-nil means that repeated use of \ +\\<graphviz-dot-mode-map>\\[graphviz-dot-complete-word] will toggle the possible +completions in the minibuffer. Normally, when there is more than one possible +completion, a buffer will display all completions." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-delete-completions nil + "*Non-nil means that the completion buffer is automatically deleted when a +key is pressed." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-attr-keywords + '("graph" "digraph" "subgraph" "node" "edge" "strict" "rankdir" + "size" "page" "Damping" "Epsilon" "URL" "arrowhead" "arrowsize" + "arrowtail" "bb" "bgcolor" "bottomlabel" "center" "clusterrank" + "color" "comment" "compound" "concentrate" "constraint" "decorate" + "dim" "dir" "distortion" "fillcolor" "fixedsize" "fontcolor" + "fontname" "fontpath" "fontsize" "group" "headURL" "headlabel" + "headport" "height" "label" "labelangle" "labeldistance" "labelfloat" + "labelfontcolor" "labelfontname" "labelfontsize" "labeljust" + "labelloc" "layer" "layers" "len" "lhead" "lp" "ltail" "margin" + "maxiter" "mclimit" "minlen" "model" "nodesep" "normalize" "nslimit" + "nslimit1" "ordering" "orientation" "overlap" "pack" "pagedir" + "pencolor" "peripheries" "pin" "pos" "quantum" "rank" "ranksep" + "ratio" "rects" "regular" "remincross" "rotate" "samehead" "sametail" + "samplepoint" "searchsize" "sep" "shape" "shapefile" "showboxes" + "sides" "skew" "splines" "start" "style" "stylesheet" "tailURL" + "taillabel" "tailport" "toplabel" "vertices" "voro_margin" "weight" + "z" "width" "penwidth" "mindist" "scale" "patch" "root") + "*Keywords for attribute names in a graph. This is used by the auto +completion code. The actual completion tables are built when the mode +is loaded, so changes to this are not immediately visible. +Check http://www.graphviz.org/doc/schema/attributes.xml on new releases." + :type '(repeat (string :tag "Keyword")) + :group 'graphviz) + +(defcustom graphviz-dot-value-keywords + '("true" "false" "normal" "inv" "dot" "invdot" "odot" "invodot" + "none" "tee" "empty" "invempty" "diamond" "odiamond" "box" "obox" + "open" "crow" "halfopen" "local" "global" "none" "forward" "back" + "both" "none" "BL" "BR" "TL" "TR" "RB" "RT" "LB" "LT" ":n" ":ne" ":e" + ":se" ":s" ":sw" ":w" ":nw" "same" "min" "source" "max" "sink" "LR" + "box" "polygon" "ellipse" "circle" "point" "egg" "triangle" + "plaintext" "diamond" "trapezium" "parallelogram" "house" "hexagon" + "octagon" "doublecircle" "doubleoctagon" "tripleoctagon" "invtriangle" + "invtrapezium" "invhouse" "Mdiamond" "Msquare" "Mcircle" "record" + "Mrecord" "dashed" "dotted" "solid" "invis" "bold" "filled" + "diagonals" "rounded" ) + "*Keywords for attribute values. This is used by the auto completion +code. The actual completion tables are built when the mode is loaded, +so changes to this are not immediately visible." + :type '(repeat (string :tag "Keyword")) + :group 'graphviz) + +;;; Font-locking: +(defvar graphviz-dot-colors-list + '(aliceblue antiquewhite antiquewhite1 antiquewhite2 + antiquewhite3 antiquewhite4 aquamarine aquamarine1 + aquamarine2 aquamarine3 aquamarine4 azure azure1 + azure2 azure3 azure4 beige bisque bisque1 bisque2 + bisque3 bisque4 black blanchedalmond blue blue1 + blue2 blue3 blue4 blueviolet brown brown1 brown2 + brown3 brown4 burlywood burlywood1 burlywood2 + burlywood3 burlywood4 cadetblue cadetblue1 + cadetblue2 cadetblue3 cadetblue4 chartreuse + chartreuse1 chartreuse2 chartreuse3 chartreuse4 + chocolate chocolate1 chocolate2 chocolate3 chocolate4 + coral coral1 coral2 coral3 coral4 cornflowerblue + cornsilk cornsilk1 cornsilk2 cornsilk3 cornsilk4 + crimson cyan cyan1 cyan2 cyan3 cyan4 darkgoldenrod + darkgoldenrod1 darkgoldenrod2 darkgoldenrod3 + darkgoldenrod4 darkgreen darkkhaki darkolivegreen + darkolivegreen1 darkolivegreen2 darkolivegreen3 + darkolivegreen4 darkorange darkorange1 darkorange2 + darkorange3 darkorange4 darkorchid darkorchid1 + darkorchid2 darkorchid3 darkorchid4 darksalmon + darkseagreen darkseagreen1 darkseagreen2 + darkseagreen3 darkseagreen4 darkslateblue + darkslategray darkslategray1 darkslategray2 + darkslategray3 darkslategray4 darkslategrey + darkturquoise darkviolet deeppink deeppink1 + deeppink2 deeppink3 deeppink4 deepskyblue + deepskyblue1 deepskyblue2 deepskyblue3 deepskyblue4 + dimgray dimgrey dodgerblue dodgerblue1 dodgerblue2 + dodgerblue3 dodgerblue4 firebrick firebrick1 + firebrick2 firebrick3 firebrick4 floralwhite + forestgreen gainsboro ghostwhite gold gold1 gold2 + gold3 gold4 goldenrod goldenrod1 goldenrod2 + goldenrod3 goldenrod4 gray gray0 gray1 gray10 gray100 + gray11 gray12 gray13 gray14 gray15 gray16 gray17 + gray18 gray19 gray2 gray20 gray21 gray22 gray23 + gray24 gray25 gray26 gray27 gray28 gray29 gray3 + gray30 gray31 gray32 gray33 gray34 gray35 gray36 + gray37 gray38 gray39 gray4 gray40 gray41 gray42 + gray43 gray44 gray45 gray46 gray47 gray48 gray49 + gray5 gray50 gray51 gray52 gray53 gray54 gray55 + gray56 gray57 gray58 gray59 gray6 gray60 gray61 + gray62 gray63 gray64 gray65 gray66 gray67 gray68 + gray69 gray7 gray70 gray71 gray72 gray73 gray74 + gray75 gray76 gray77 gray78 gray79 gray8 gray80 + gray81 gray82 gray83 gray84 gray85 gray86 gray87 + gray88 gray89 gray9 gray90 gray91 gray92 gray93 + gray94 gray95 gray96 gray97 gray98 gray99 green + green1 green2 green3 green4 greenyellow grey grey0 + grey1 grey10 grey100 grey11 grey12 grey13 grey14 + grey15 grey16 grey17 grey18 grey19 grey2 grey20 + grey21 grey22 grey23 grey24 grey25 grey26 grey27 + grey28 grey29 grey3 grey30 grey31 grey32 grey33 + grey34 grey35 grey36 grey37 grey38 grey39 grey4 + grey40 grey41 grey42 grey43 grey44 grey45 grey46 + grey47 grey48 grey49 grey5 grey50 grey51 grey52 + grey53 grey54 grey55 grey56 grey57 grey58 grey59 + grey6 grey60 grey61 grey62 grey63 grey64 grey65 + grey66 grey67 grey68 grey69 grey7 grey70 grey71 + grey72 grey73 grey74 grey75 grey76 grey77 grey78 + grey79 grey8 grey80 grey81 grey82 grey83 grey84 + grey85 grey86 grey87 grey88 grey89 grey9 grey90 + grey91 grey92 grey93 grey94 grey95 grey96 grey97 + grey98 grey99 honeydew honeydew1 honeydew2 honeydew3 + honeydew4 hotpink hotpink1 hotpink2 hotpink3 hotpink4 + indianred indianred1 indianred2 indianred3 indianred4 + indigo ivory ivory1 ivory2 ivory3 ivory4 khaki khaki1 + khaki2 khaki3 khaki4 lavender lavenderblush + lavenderblush1 lavenderblush2 lavenderblush3 + lavenderblush4 lawngreen lemonchiffon lemonchiffon1 + lemonchiffon2 lemonchiffon3 lemonchiffon4 lightblue + lightblue1 lightblue2 lightblue3 lightblue4 + lightcoral lightcyan lightcyan1 lightcyan2 lightcyan3 + lightcyan4 lightgoldenrod lightgoldenrod1 + lightgoldenrod2 lightgoldenrod3 lightgoldenrod4 + lightgoldenrodyellow lightgray lightgrey lightpink + lightpink1 lightpink2 lightpink3 lightpink4 + lightsalmon lightsalmon1 lightsalmon2 lightsalmon3 + lightsalmon4 lightseagreen lightskyblue lightskyblue1 + lightskyblue2 lightskyblue3 lightskyblue4 + lightslateblue lightslategray lightslategrey + lightsteelblue lightsteelblue1 lightsteelblue2 + lightsteelblue3 lightsteelblue4 lightyellow + lightyellow1 lightyellow2 lightyellow3 lightyellow4 + limegreen linen magenta magenta1 magenta2 magenta3 + magenta4 maroon maroon1 maroon2 maroon3 maroon4 + mediumaquamarine mediumblue mediumorchid + mediumorchid1 mediumorchid2 mediumorchid3 + mediumorchid4 mediumpurple mediumpurple1 + mediumpurple2 mediumpurple3 mediumpurple4 + mediumseagreen mediumslateblue mediumspringgreen + mediumturquoise mediumvioletred midnightblue + mintcream mistyrose mistyrose1 mistyrose2 mistyrose3 + mistyrose4 moccasin navajowhite navajowhite1 + navajowhite2 navajowhite3 navajowhite4 navy navyblue + oldlace olivedrab olivedrap olivedrab1 olivedrab2 + olivedrap3 oragne palegoldenrod palegreen palegreen1 + palegreen2 palegreen3 palegreen4 paleturquoise + paleturquoise1 paleturquoise2 paleturquoise3 + paleturquoise4 palevioletred palevioletred1 + palevioletred2 palevioletred3 palevioletred4 + papayawhip peachpuff peachpuff1 peachpuff2 + peachpuff3 peachpuff4 peru pink pink1 pink2 pink3 + pink4 plum plum1 plum2 plum3 plum4 powderblue + purple purple1 purple2 purple3 purple4 red red1 red2 + red3 red4 rosybrown rosybrown1 rosybrown2 rosybrown3 + rosybrown4 royalblue royalblue1 royalblue2 royalblue3 + royalblue4 saddlebrown salmon salmon1 salmon2 salmon3 + salmon4 sandybrown seagreen seagreen1 seagreen2 + seagreen3 seagreen4 seashell seashell1 seashell2 + seashell3 seashell4 sienna sienna1 sienna2 sienna3 + sienna4 skyblue skyblue1 skyblue2 skyblue3 skyblue4 + slateblue slateblue1 slateblue2 slateblue3 slateblue4 + slategray slategray1 slategray2 slategray3 slategray4 + slategrey snow snow1 snow2 snow3 snow4 springgreen + springgreen1 springgreen2 springgreen3 springgreen4 + steelblue steelblue1 steelblue2 steelblue3 steelblue4 + tan tan1 tan2 tan3 tan4 thistle thistle1 thistle2 + thistle3 thistle4 tomato tomato1 tomato2 tomato3 + tomato4 transparent turquoise turquoise1 turquoise2 + turquoise3 turquoise4 violet violetred violetred1 + violetred2 violetred3 violetred4 wheat wheat1 wheat2 + wheat3 wheat4 white whitesmoke yellow yellow1 yellow2 + yellow3 yellow4 yellowgreen) + "Possible color constants in the dot language. +The list of constant is available at http://www.research.att.com/~erg/graphviz\ +/info/colors.html") + + +(defvar graphviz-dot-color-keywords + (mapcar 'symbol-name graphviz-dot-colors-list)) + +(defvar graphviz-attr-keywords + (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-attr-keywords)) + +(defvar graphviz-value-keywords + (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-value-keywords)) + +(defvar graphviz-color-keywords + (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-color-keywords)) + +;;; Key map +(defvar graphviz-dot-mode-map () + "Keymap used in Graphviz Dot mode.") + +(if graphviz-dot-mode-map + () + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'electric-graphviz-dot-terminate-line) + (define-key map "{" 'electric-graphviz-dot-open-brace) + (define-key map "}" 'electric-graphviz-dot-close-brace) + (define-key map ";" 'electric-graphviz-dot-semi) + (define-key map "\M-\t" 'graphviz-dot-complete-word) + (define-key map "\C-\M-q" 'graphviz-dot-indent-graph) + (define-key map "\C-cp" 'graphviz-dot-preview) + (define-key map "\C-cc" 'compile) + (define-key map "\C-cv" 'graphviz-dot-view) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-u" 'graphviz-dot-uncomment-region) + (setq graphviz-dot-mode-map map) + )) + +;;; Syntax table +(defvar graphviz-dot-mode-syntax-table nil + "Syntax table for `graphviz-dot-mode'.") + +(if graphviz-dot-mode-syntax-table + () + (let ((st (make-syntax-table))) + (modify-syntax-entry ?/ ". 124b" st) + (modify-syntax-entry ?* ". 23" st) + (modify-syntax-entry ?\n "> b" st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?_ "_" st) + (modify-syntax-entry ?- "_" st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?[ "(" st) + (modify-syntax-entry ?] ")" st) + (modify-syntax-entry ?\" "\"" st) + (setq graphviz-dot-mode-syntax-table st) + )) + +(defvar graphviz-dot-font-lock-keywords + `(("\\(:?di\\|sub\\)?graph \\(\\sw+\\)" + (2 font-lock-function-name-face)) + (,(regexp-opt graphviz-dot-value-keywords 'words) + . font-lock-reference-face) + ;; to build the font-locking for the colors, + ;; we need more room for max-specpdl-size, + ;; after that we take the list of symbols, + ;; convert them to a list of strings, and make + ;; an optimized regexp from them + (,(let ((max-specpdl-size (max max-specpdl-size 1200))) + (regexp-opt graphviz-dot-color-keywords)) + . font-lock-string-face) + (,(concat + (regexp-opt graphviz-dot-attr-keywords 'words) + "[ \\t\\n]*=") + ;; RR - ugly, really, but I dont know why xemacs does not work + ;; if I change the next car to "1"... + (0 font-lock-variable-name-face))) + "Keyword highlighting specification for `graphviz-dot-mode'.") + +;;;###autoload +(defun graphviz-dot-mode () + "Major mode for the dot language. \\<graphviz-dot-mode-map> +TAB indents for graph lines. + +\\[graphviz-dot-indent-graph]\t- Indentaion function. +\\[graphviz-dot-preview]\t- Previews graph in a buffer. +\\[graphviz-dot-view]\t- Views graph in an external viewer. +\\[graphviz-dot-indent-line]\t- Indents current line of code. +\\[graphviz-dot-complete-word]\t- Completes the current word. +\\[electric-graphviz-dot-terminate-line]\t- Electric newline. +\\[electric-graphviz-dot-open-brace]\t- Electric open braces. +\\[electric-graphviz-dot-close-brace]\t- Electric close braces. +\\[electric-graphviz-dot-semi]\t- Electric semi colons. + +Variables specific to this mode: + + graphviz-dot-dot-program (default `dot') + Location of the dot program. + graphviz-dot-view-command (default `doted %s') + Command to run when `graphviz-dot-view' is executed. + graphviz-dot-view-edit-command (default nil) + If the user should be asked to edit the view command. + graphviz-dot-save-before-view (default t) + Automatically save current buffer berore `graphviz-dot-view'. + graphviz-dot-preview-extension (default `png') + File type to use for `graphviz-dot-preview'. + graphviz-dot-auto-indent-on-newline (default t) + Whether to run `electric-graphviz-dot-terminate-line' when + newline is entered. + graphviz-dot-auto-indent-on-braces (default t) + Whether to run `electric-graphviz-dot-open-brace' and + `electric-graphviz-dot-close-brace' when braces are + entered. + graphviz-dot-auto-indent-on-semi (default t) + Whether to run `electric-graphviz-dot-semi' when semi colon + is typed. + graphviz-dot-toggle-completions (default nil) + If completions should be displayed in the buffer instead of a + completion buffer when \\[graphviz-dot-complete-word] is + pressed repeatedly. + +This mode can be customized by running \\[graphviz-dot-customize]. + +Turning on Graphviz Dot mode calls the value of the variable +`graphviz-dot-mode-hook' with no args, if that value is non-nil." + (interactive) + (kill-all-local-variables) + (use-local-map graphviz-dot-mode-map) + (setq major-mode 'graphviz-dot-mode) + (setq mode-name "dot") + (setq local-abbrev-table graphviz-dot-mode-abbrev-table) + (set-syntax-table graphviz-dot-mode-syntax-table) + (set (make-local-variable 'indent-line-function) 'graphviz-dot-indent-line) + (set (make-local-variable 'comment-start) "//") + (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *") + (modify-syntax-entry ?# "< b" graphviz-dot-mode-syntax-table) + (modify-syntax-entry ?\n "> b" graphviz-dot-mode-syntax-table) + (set (make-local-variable 'font-lock-defaults) + '(graphviz-dot-font-lock-keywords)) + ;; RR - If user is running this in the scratch buffer, there is no + ;; buffer file name... + (if (buffer-file-name) + (set (make-local-variable 'compile-command) + (concat graphviz-dot-dot-program + " -T" graphviz-dot-preview-extension " " + "\"" buffer-file-name "\"" + " > \"" + (file-name-sans-extension + buffer-file-name) + "." graphviz-dot-preview-extension "\""))) + (set (make-local-variable 'compilation-parse-errors-function) + 'graphviz-dot-compilation-parse-errors) + (if dot-menu + (easy-menu-add dot-menu)) + (run-hooks 'graphviz-dot-mode-hook) + ) + +;;;; Menu definitions + +(defvar dot-menu nil + "Menu for Graphviz Dot Mode. +This menu will get created automatically if you have the `easymenu' +package. Note that the latest X/Emacs releases contain this package.") + +(and (condition-case nil + (require 'easymenu) + (error nil)) + (easy-menu-define + dot-menu graphviz-dot-mode-map "Graphviz Mode menu" + '("Graphviz" + ["Indent Graph" graphviz-dot-indent-graph t] + ["Comment Out Region" comment-region (mark)] + ["Uncomment Region" graphviz-dot-uncomment-region (mark)] + "-" + ["Compile" compile t] + ["Preview" graphviz-dot-preview + (and (buffer-file-name) + (not (buffer-modified-p)))] + ["External Viewer" graphviz-dot-view (buffer-file-name)] + "-" + ["Customize..." graphviz-dot-customize t] + ))) + +;;;; Compilation + +;; note on graphviz-dot-compilation-parse-errors: +;; It would nicer if we could just use compilation-error-regexp-alist +;; to do that, 3 options: +;; - still write dot-compilation-parse-errors, don't build +;; a return list, but modify the *compilation* buffer +;; in a way compilation-error-regexp-alist recognizes the +;; format. +;; to do that, I should globally change compilation-parse-function +;; to this function, and call the old value of comp..-parse-fun.. +;; to provide the return value. +;; two drawbacks are that, every compilation would be run through +;; this function (performance) and that in autoload there would +;; be a chance that this function would not yet be known. +;; - let the compilation run through a filter that would +;; modify the output of dot or neato: +;; dot -Tpng input.dot | filter +;; drawback: ugly, extra work for user, extra decency ... +;; no-option +;; - modify dot and neato !!! (PP:15/02/2005 seems to have happend, +;; so version 0.4.0 should clean this mess up!) +(defun graphviz-dot-compilation-parse-errors (limit-search find-at-least) + "Parse the current buffer for dot errors. +See variable `compilation-parse-errors-functions' for interface." + (interactive) + (save-excursion + (set-buffer "*compilation*") + (goto-char (point-min)) + (setq compilation-error-list nil) + (let (buffer-of-error) + (while (not (eobp)) + (cond + ((looking-at "^dot\\( -[^ ]+\\)* \\(.*\\)") + (setq buffer-of-error (find-file-noselect + (buffer-substring-no-properties + (nth 4 (match-data t)) + (nth 5 (match-data t)))))) + ((looking-at ".*:.*line \\([0-9]+\\)") + (let ((line-of-error + (string-to-number (buffer-substring-no-properties + (nth 2 (match-data t)) + (nth 3 (match-data t)))))) + (setq compilation-error-list + (cons + (cons + (point-marker) + (save-excursion + (set-buffer buffer-of-error) + (goto-line line-of-error) + (beginning-of-line) + (point-marker))) + compilation-error-list)))) + (t t)) + (forward-line 1)) ))) + +;;;; +;;;; Indentation +;;;; +(defun graphviz-dot-uncomment-region (begin end) + "Uncomments a region of code." + (interactive "r") + (comment-region begin end '(4))) + +(defun graphviz-dot-indent-line () + "Indent current line of dot code." + (interactive) + (if (bolp) + (graphviz-dot-real-indent-line) + (save-excursion + (graphviz-dot-real-indent-line)))) + +(defun graphviz-dot-get-indendation() + "Return current line's indentation" + (interactive) + (message "Current indentation is %d." + (current-indentation)) + (current-indentation)) + +(defun graphviz-dot-real-indent-line () + "Indent current line of dot code." + (beginning-of-line) + (cond + ((bobp) + ;; simple case, indent to 0 + (indent-line-to 0)) + ((looking-at "^[ \t]*}[ \t]*$") + ;; block closing, deindent relative to previous line + (indent-line-to (save-excursion + (forward-line -1) + (max 0 (- (current-indentation) graphviz-dot-indent-width))))) + ;; other cases need to look at previous lines + (t + (indent-line-to (save-excursion + (forward-line -1) + (cond + ((looking-at "\\(^.*{[^}]*$\\)") + ;; previous line opened a block + ;; indent to that line + (+ (current-indentation) graphviz-dot-indent-width)) + ((and (not (looking-at ".*\\[.*\\].*")) + (looking-at ".*\\[.*")) ; TODO:PP : can be 1 regex + ;; previous line started filling + ;; attributes, intend to that start + (search-forward "[") + (current-column)) + ((and (not (looking-at ".*\\[.*\\].*")) + (looking-at ".*\\].*")) ; TODO:PP : " + ;; previous line stopped filling + ;; attributes, find the line that started + ;; filling them and indent to that line + (while (or (looking-at ".*\\[.*\\].*") + (not (looking-at ".*\\[.*"))) ; TODO:PP : " + (forward-line -1)) + (current-indentation)) + (t + ;; default case, indent the + ;; same as previous NON-BLANK line + ;; (or the first line, if there are no previous non-blank lines) + (while (and (< (point-min) (point)) + (looking-at "^\[ \t\]*$")) + (forward-line -1)) + (current-indentation)) ))) ))) + +(defun graphviz-dot-indent-graph () + "Indent the graph/digraph/subgraph where point is at. +This will first teach the beginning of the graph were point is at, and +then indent this and each subgraph in it." + (interactive) + (save-excursion + ;; position point at start of graph + (while (not (or (looking-at "\\(^.*{[^}]*$\\)") (bobp))) + (forward-line -1)) + ;; bracket { one +; bracket } one - + (let ((bracket-count 0)) + (while + (progn + (cond + ;; update bracket-count + ((looking-at "\\(^.*{[^}]*$\\)") + (setq bracket-count (+ bracket-count 1))) + ;; update bracket-count + ((looking-at "^[ \t]*}[ \t]*$") + (setq bracket-count (- bracket-count 1)))) + ;; indent this line and move on + (graphviz-dot-indent-line) + (forward-line 1) + ;; as long as we are not completed or at end of buffer + (and (> bracket-count 0) (not (eobp)))))))) + +;;;; +;;;; Electric indentation +;;;; +(defun graphviz-dot-comment-or-string-p () + (let ((state (parse-partial-sexp (point-min) (point)))) + (or (nth 4 state) (nth 3 state)))) + +(defun graphviz-dot-newline-and-indent () + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (graphviz-dot-indent-line)) + (delete-horizontal-space) + (newline) + (graphviz-dot-indent-line)) + +(defun electric-graphviz-dot-terminate-line () + "Terminate line and indent next line." + (interactive) + (if graphviz-dot-auto-indent-on-newline + (graphviz-dot-newline-and-indent) + (newline))) + +(defun electric-graphviz-dot-open-brace () + "Terminate line and indent next line." + (interactive) + (insert "{") + (if (and graphviz-dot-auto-indent-on-braces + (not (graphviz-dot-comment-or-string-p))) + (graphviz-dot-newline-and-indent))) + +(defun electric-graphviz-dot-close-brace () + "Terminate line and indent next line." + (interactive) + (insert "}") + (if (and graphviz-dot-auto-indent-on-braces + (not (graphviz-dot-comment-or-string-p))) + (progn + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (graphviz-dot-indent-line)) + (newline) + (graphviz-dot-indent-line)))) + +(defun electric-graphviz-dot-semi () + "Terminate line and indent next line." + (interactive) + (insert ";") + (if (and graphviz-dot-auto-indent-on-semi + (not (graphviz-dot-comment-or-string-p))) + (graphviz-dot-newline-and-indent))) + +;;;; +;;;; Preview +;;;; +(defun graphviz-dot-preview () + "Shows an example of the current dot file in an emacs buffer. +This assumes that we are running GNU Emacs or XEmacs under a windowing system. +See `image-file-name-extensions' for customizing the files that can be +loaded in GNU Emacs, and `image-formats-alist' for XEmacs." + (interactive) + ;; unsafe to compile ourself, ask it to the user + (if (buffer-modified-p) + (message "Buffer needs to be compiled.") + (if (string-match "XEmacs" emacs-version) + ;; things are easier in XEmacs... + (find-file-other-window (concat (file-name-sans-extension + buffer-file-name) + "." graphviz-dot-preview-extension)) + ;; run through all the extensions for images + (let ((l image-file-name-extensions)) + (while + (let ((f (concat (file-name-sans-extension (buffer-file-name)) + "." + (car l)))) + ;; see if a file matches, might be best also to check + ;; if file is up to date TODO:PP + (if (file-exists-p f) + (progn (auto-image-file-mode 1) + ;; OK, this is ugly, I would need to + ;; know how I can reload a file in an existing buffer + (if (get-buffer "*preview*") + (kill-buffer "*preview*")) + (set-buffer (find-file-noselect f)) + (rename-buffer "*preview*") + (display-buffer (get-buffer "*preview*")) + ;; stop iterating + '()) + ;; will stop iterating when l is nil + (setq l (cdr l))))) + ;; each extension tested and nothing found, let user know + (when (eq l '()) + (message "No image found.")))))) + +;;;; +;;;; View +;;;; +(defun graphviz-dot-view () + "Runs an external viewer. This creates an external process every time it +is executed. If `graphviz-dot-save-before-view' is set, the current +buffer is saved before the command is executed." + (interactive) + (let ((cmd (if graphviz-dot-view-edit-command + (if (string-match "XEmacs" emacs-version) + (read-shell-command "View command: " + (format graphviz-dot-view-command + (buffer-file-name))) + (read-from-minibuffer "View command: " + (format graphviz-dot-view-command + (buffer-file-name)))) + (format graphviz-dot-view-command (buffer-file-name))))) + (if graphviz-dot-save-before-view + (save-buffer)) + (setq novaproc (start-process-shell-command + (downcase mode-name) nil cmd)) + (message (format "Executing `%s'..." cmd)))) + +;;;; +;;;; Completion +;;;; +(defvar graphviz-dot-str nil) +(defvar graphviz-dot-all nil) +(defvar graphviz-dot-pred nil) +(defvar graphviz-dot-buffer-to-use nil) +(defvar graphviz-dot-flag nil) + +(defun graphviz-dot-get-state () + "Returns the syntax state of the current point." + (let ((state (parse-partial-sexp (point-min) (point)))) + (cond + ((nth 4 state) 'comment) + ((nth 3 state) 'string) + ((not (nth 1 state)) 'out) + (t (save-excursion + (skip-chars-backward "^[,=\\[]{};") + (backward-char) + (cond + ((looking-at "[\\[,]{};") 'attribute) + ((looking-at "=") (progn + (backward-word 1) + (if (looking-at "[a-zA-Z]*color") + 'color + 'value))) + (t 'other))))))) + +(defun graphviz-dot-get-keywords () + "Return possible completions for a word" + (let ((state (graphviz-dot-get-state))) + (cond + ((equal state 'comment) ()) + ((equal state 'string) ()) + ((equal state 'out) graphviz-attr-keywords) + ((equal state 'value) graphviz-value-keywords) + ((equal state 'color) graphviz-color-keywords) + ((equal state 'attribute) graphviz-attr-keywords) + (t graphviz-attr-keywords)))) + +(defvar graphviz-dot-last-word-numb 0) +(defvar graphviz-dot-last-word-shown nil) +(defvar graphviz-dot-last-completions nil) + +(defun graphviz-dot-complete-word () + "Complete word at current point." + (interactive) + (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) + (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) + (graphviz-dot-str (buffer-substring b e)) + (allcomp (if (and graphviz-dot-toggle-completions + (string= graphviz-dot-last-word-shown + graphviz-dot-str)) + graphviz-dot-last-completions + (all-completions graphviz-dot-str + (graphviz-dot-get-keywords)))) + (match (if graphviz-dot-toggle-completions + "" (try-completion + graphviz-dot-str (mapcar '(lambda (elm) + (cons elm 0)) allcomp))))) + ;; Delete old string + (delete-region b e) + + ;; Toggle-completions inserts whole labels + (if graphviz-dot-toggle-completions + (progn + ;; Update entry number in list + (setq graphviz-dot-last-completions allcomp + graphviz-dot-last-word-numb + (if (>= graphviz-dot-last-word-numb (1- (length allcomp))) + 0 + (1+ graphviz-dot-last-word-numb))) + (setq graphviz-dot-last-word-shown + (elt allcomp graphviz-dot-last-word-numb)) + ;; Display next match or same string if no match was found + (if (not (null allcomp)) + (insert "" graphviz-dot-last-word-shown) + (insert "" graphviz-dot-str) + (message "(No match)"))) + ;; The other form of completion does not necessarily do that. + + ;; Insert match if found, or the original string if no match + (if (or (null match) (equal match 't)) + (progn (insert "" graphviz-dot-str) + (message "(No match)")) + (insert "" match)) + ;; Give message about current status of completion + (cond ((equal match 't) + (if (not (null (cdr allcomp))) + (message "(Complete but not unique)") + (message "(Sole completion)"))) + ;; Display buffer if the current completion didn't help + ;; on completing the label. + ((and (not (null (cdr allcomp))) (= (length graphviz-dot-str) + (length match))) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list allcomp)) + ;; Wait for a keypress. Then delete *Completion* window + (momentary-string-display "" (point)) + (if graphviz-dot-delete-completions + (delete-window + (get-buffer-window (get-buffer "*Completions*")))) + ))))) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.dot\\'" . graphviz-dot-mode)) +(add-to-list 'auto-mode-alist '("\\.gv\\'" . graphviz-dot-mode)) + +;;; graphviz-dot-mode.el ends here + diff --git a/emacs.d/elisp/muse/Makefile b/emacs.d/elisp/muse/Makefile new file mode 100644 index 0000000..8fa07a0 --- /dev/null +++ b/emacs.d/elisp/muse/Makefile @@ -0,0 +1,99 @@ +.PHONY: all lisp autoloads clean realclean distclean fullclean install test +.PRECIOUS: %.elc + +DEFS = $(shell test -f ../Makefile.defs && echo ../Makefile.defs \ + || echo ../Makefile.defs.default) + +include $(DEFS) + +EL = $(filter-out $(PROJECT)-autoloads.el,$(wildcard *.el)) +ELC = $(patsubst %.el,%.elc,$(EL)) + +all: lisp + +lisp: autoloads $(ELC) + +$(PROJECT)-build.elc: ../scripts/$(PROJECT)-build.el + @echo $(PROJECT)-build.el is not byte-compiled + +autoloads: $(PROJECT)-autoloads.el + +$(PROJECT)-autoloads.el: $(EL) + @$(EMACS) -q $(SITEFLAG) -batch -l ../scripts/$(PROJECT)-build.el \ + -f $(PROJECT)-generate-autoloads . ../contrib ../experimental + +%.elc: %.el + @$(EMACS) -q $(SITEFLAG) -batch -l ../scripts/$(PROJECT)-build.el \ + -f batch-byte-compile $< + +clean distclean: + -rm -f *.elc *~ + +realclean fullclean: clean + -rm -f $(PROJECT)-autoloads.el + +install: autoloads $(ELC) + install -d $(ELISPDIR) + install -m 0644 $(PROJECT)-autoloads.el $(EL) $(ELC) $(ELISPDIR) + +test: $(ELC) + $(EMACS) -q $(SITEFLAG) -batch -l ../scripts/$(PROJECT)-build.el \ + -f $(PROJECT)-elint-files $(EL) + +# Dependencies +# +# This allows us to recompile Muse safely after an update. + +muse-backlink.elc: muse-mode.elc muse-publish.elc muse.elc + +muse-blosxom.elc: muse-html.elc muse-project.elc muse-publish.elc + +muse-book.elc: muse-latex.elc muse-project.elc muse-publish.elc +muse-book.elc: muse-regexps.elc + +muse-colors.elc: muse-mode.elc muse-regexps.elc + +muse-context.elc: muse-publish.elc + +muse-docbook.elc: muse-publish.elc muse-regexps.elc muse-xml-common.elc + +muse-groff.elc: muse-publish.elc + +muse-html.elc: muse-publish.elc muse-regexps.elc muse-xml-common.elc + +muse-http.elc: muse-html.elc muse-project.elc + +muse-ikiwiki.elc: muse-html.elc muse-ipc.elc muse-publish.elc muse.elc + +muse-import-docbook.elc: muse-import-xml.elc + +muse-import-latex.elc: muse-regexps.elc muse.elc + +muse-ipc.elc: muse-publish.elc muse.elc + +muse-journal.elc: muse-book.elc muse-html.elc muse-latex.elc +muse-journal.elc: muse-publish.elc + +muse-latex.elc: muse-publish.elc + +muse-latex2png.elc: muse-publish.elc + +muse-mode.elc: muse-regexps.elc muse-project.elc + +muse-poem.elc: muse-latex.elc muse-project.elc + +muse-project.elc: muse-publish.elc muse.elc + +muse-protocols.elc: muse-regexps.elc + +muse-publish.elc: muse-regexps.elc muse.elc + +muse-texinfo.elc: muse-latex.elc muse-publish.elc + +muse-wiki.elc: muse-colors.elc muse-regexps.elc muse-mode.elc + +muse-xml-common.elc: muse-publish.elc muse-regexps.elc + +muse-xml.elc: muse-publish.elc muse-regexps.elc muse-xml-common.elc + +muse.elc: muse-protocols.elc muse-regexps.elc diff --git a/emacs.d/elisp/muse/muse-autoloads.el b/emacs.d/elisp/muse/muse-autoloads.el new file mode 100644 index 0000000..d22ce26 --- /dev/null +++ b/emacs.d/elisp/muse/muse-autoloads.el @@ -0,0 +1,303 @@ +;;; muse-autoloads.el --- autoloads for Muse +;; +;;; Code: + +;;;### (autoloads nil "muse" "muse.el" (19301 54276)) +;;; Generated autoloads from muse.el + (add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode)) + +;;;*** + +;;;### (autoloads (muse-colors-toggle-inline-images) "muse-colors" +;;;;;; "muse-colors.el" (19301 53189)) +;;; Generated autoloads from muse-colors.el + +(autoload 'muse-colors-toggle-inline-images "muse-colors" "\ +Toggle display of inlined images on/off. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (muse-import-docbook-files muse-import-docbook) +;;;;;; "muse-import-docbook" "muse-import-docbook.el" (19301 53204)) +;;; Generated autoloads from muse-import-docbook.el + +(autoload 'muse-import-docbook "muse-import-docbook" "\ +Convert the Docbook buffer SRC to Muse, writing output in the DEST buffer. + +\(fn SRC DEST)" t nil) + +(autoload 'muse-import-docbook-files "muse-import-docbook" "\ +Convert the Docbook file SRC to Muse, writing output to the DEST file. + +\(fn SRC DEST)" t nil) + +;;;*** + +;;;### (autoloads (muse-import-latex) "muse-import-latex" "muse-import-latex.el" +;;;;;; (19301 53192)) +;;; Generated autoloads from muse-import-latex.el + +(autoload 'muse-import-latex "muse-import-latex" "\ +Not documented + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (muse-message-markup) "muse-message" "../experimental/muse-message.el" +;;;;;; (18175 10245)) +;;; Generated autoloads from ../experimental/muse-message.el + +(autoload 'muse-message-markup "muse-message" "\ +Markup a wiki-ish e-mail message as HTML alternative e-mail. +This step is manual by default, to give the author a chance to review +the results and ensure they are appropriate. +If you wish it to be automatic (a risky proposition), just add this +function to `message-send-hook'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (muse-list-edit-minor-mode muse-insert-tag muse-index +;;;;;; muse-find-backlinks muse-search muse-search-with-command +;;;;;; muse-what-changed muse-previous-reference muse-next-reference +;;;;;; muse-follow-name-at-point-other-window muse-follow-name-at-point +;;;;;; muse-browse-result muse-edit-link-at-point muse-insert-relative-link-to-file +;;;;;; muse-decrease-list-item-indentation muse-increase-list-item-indentation +;;;;;; muse-insert-list-item muse-mode-choose-mode muse-mode) "muse-mode" +;;;;;; "muse-mode.el" (19301 53218)) +;;; Generated autoloads from muse-mode.el + +(autoload 'muse-mode "muse-mode" "\ +Muse is an Emacs mode for authoring and publishing documents. +\\{muse-mode-map} + +\(fn)" t nil) + +(autoload 'muse-mode-choose-mode "muse-mode" "\ +Turn the proper Emacs Muse related mode on for this file. + +\(fn)" nil nil) + +(autoload 'muse-insert-list-item "muse-mode" "\ +Insert a list item at the current point, taking into account +your current list type and indentation level. + +\(fn)" t nil) + +(autoload 'muse-increase-list-item-indentation "muse-mode" "\ +Increase the indentation of the current list item. + +\(fn)" t nil) + +(autoload 'muse-decrease-list-item-indentation "muse-mode" "\ +Decrease the indentation of the current list item. + +\(fn)" t nil) + +(autoload 'muse-insert-relative-link-to-file "muse-mode" "\ +Insert a relative link to a file, with optional description, at point. + +\(fn)" t nil) + +(autoload 'muse-edit-link-at-point "muse-mode" "\ +Edit the current link. +Do not rename the page originally referred to. + +\(fn)" t nil) + +(autoload 'muse-browse-result "muse-mode" "\ +Visit the current page's published result. + +\(fn STYLE &optional OTHER-WINDOW)" t nil) + +(autoload 'muse-follow-name-at-point "muse-mode" "\ +Visit the link at point. + +\(fn &optional OTHER-WINDOW)" t nil) + +(autoload 'muse-follow-name-at-point-other-window "muse-mode" "\ +Visit the link at point in other window. + +\(fn)" t nil) + +(autoload 'muse-next-reference "muse-mode" "\ +Move forward to next Muse link or URL, cycling if necessary. + +\(fn)" t nil) + +(autoload 'muse-previous-reference "muse-mode" "\ +Move backward to the next Muse link or URL, cycling if necessary. +In case of Emacs x <= 21 and ignoring of intangible properties (see +`muse-mode-intangible-links'). + +This function is not entirely accurate, but it's close enough. + +\(fn)" t nil) + +(autoload 'muse-what-changed "muse-mode" "\ +Show the unsaved changes that have been made to the current file. + +\(fn)" t nil) + +(autoload 'muse-search-with-command "muse-mode" "\ +Search for the given TEXT string in the project directories +using the specified command. + +\(fn TEXT)" t nil) + +(autoload 'muse-search "muse-mode" "\ +Search for the given TEXT using the default grep command. + +\(fn)" t nil) + +(autoload 'muse-find-backlinks "muse-mode" "\ +Grep for the current pagename in all the project directories. + +\(fn)" t nil) + +(autoload 'muse-index "muse-mode" "\ +Display an index of all known Muse pages. + +\(fn)" t nil) + +(autoload 'muse-insert-tag "muse-mode" "\ +Insert a tag interactively with a blank line after it. + +\(fn TAG)" t nil) + +(autoload 'muse-list-edit-minor-mode "muse-mode" "\ +This is a global minor mode for editing files with lists. +It is meant to be used with other major modes, and not with Muse mode. + +Interactively, with no prefix argument, toggle the mode. +With universal prefix ARG turn mode on. +With zero or negative ARG turn mode off. + +This minor mode provides the Muse keybindings for editing lists, +and support for filling lists properly. + +It recognizes not only Muse-style lists, which use the \"-\" +character or numbers, but also lists that use asterisks or plus +signs. This should make the minor mode generally useful. + +Definition lists and footnotes are also recognized. + +Note that list items may omit leading spaces, for compatibility +with modes that set `left-margin', such as +`debian-changelog-mode'. + +\\{muse-list-edit-minor-mode-map} + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads (muse-project-publish muse-project-publish-this-file +;;;;;; muse-project-find-file) "muse-project" "muse-project.el" +;;;;;; (19301 53195)) +;;; Generated autoloads from muse-project.el + +(autoload 'muse-project-find-file "muse-project" "\ +Open the Muse page given by NAME in PROJECT. +If COMMAND is non-nil, it is the function used to visit the file. +If DIRECTORY is non-nil, it is the directory in which the page +will be created if it does not already exist. Otherwise, the +first directory within the project's fileset is used. + +\(fn NAME PROJECT &optional COMMAND DIRECTORY)" t nil) + +(autoload 'muse-project-publish-this-file "muse-project" "\ +Publish the currently-visited file according to `muse-project-alist', +prompting if more than one style applies. + +If FORCE is given, publish the file even if it is up-to-date. + +If STYLE is given, use that publishing style rather than +prompting for one. + +\(fn &optional FORCE STYLE)" t nil) + +(autoload 'muse-project-publish "muse-project" "\ +Publish the pages of PROJECT that need publishing. + +\(fn PROJECT &optional FORCE)" t nil) + +;;;*** + +;;;### (autoloads (muse-browse-url) "muse-protocols" "muse-protocols.el" +;;;;;; (19301 53239)) +;;; Generated autoloads from muse-protocols.el + +(autoload 'muse-browse-url "muse-protocols" "\ +Handle URL with the function specified in `muse-url-protocols'. +If OTHER-WINDOW is non-nil, open in a different window. + +\(fn URL &optional OTHER-WINDOW)" t nil) + +;;;*** + +;;;### (autoloads (muse-publish-this-file muse-publish-file muse-publish-region) +;;;;;; "muse-publish" "muse-publish.el" (19301 53119)) +;;; Generated autoloads from muse-publish.el + +(autoload 'muse-publish-region "muse-publish" "\ +Apply the given STYLE's markup rules to the given region. +The result is placed in a new buffer that includes TITLE in its name. + +\(fn BEG END &optional TITLE STYLE)" t nil) + +(autoload 'muse-publish-file "muse-publish" "\ +Publish the given FILE in a particular STYLE to OUTPUT-DIR. +If the argument FORCE is nil, each file is only published if it is +newer than the published version. If the argument FORCE is non-nil, +the file is published no matter what. + +\(fn FILE STYLE &optional OUTPUT-DIR FORCE)" t nil) + +(autoload 'muse-publish-this-file "muse-publish" "\ +Publish the currently-visited file. +Prompt for both the STYLE and OUTPUT-DIR if they are not +supplied. + +\(fn STYLE OUTPUT-DIR &optional FORCE)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("../contrib/cgi.el" "../contrib/htmlize-hack.el" +;;;;;; "../contrib/httpd.el" "../experimental/muse-cite.el" "../experimental/muse-mathml.el" +;;;;;; "../experimental/muse-protocol-iw.el" "../experimental/muse-split.el" +;;;;;; "muse-backlink.el" "muse-book.el" "muse-context.el" "muse-docbook.el" +;;;;;; "muse-groff.el" "muse-html.el" "muse-http.el" "muse-ikiwiki.el" +;;;;;; "muse-import-xml.el" "muse-ipc.el" "muse-journal.el" "muse-latex.el" +;;;;;; "muse-latex2png.el" "muse-poem.el" "muse-regexps.el" "muse-texinfo.el" +;;;;;; "muse-wiki.el" "muse-xml-common.el" "muse-xml.el") (19301 +;;;;;; 55001 866391)) + +;;;*** + +;;;### (autoloads (muse-blosxom-new-entry) "muse-blosxom" "muse-blosxom.el" +;;;;;; (19301 53232)) +;;; Generated autoloads from muse-blosxom.el + +(autoload 'muse-blosxom-new-entry "muse-blosxom" "\ +Start a new blog entry with given CATEGORY. +The filename of the blog entry is derived from TITLE. +The page will be initialized with the current date and TITLE. + +\(fn CATEGORY TITLE)" t nil) + +;;;*** + +(provide 'muse-autoloads) +;;; muse-autoloads.el ends here +;; +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: + diff --git a/emacs.d/elisp/muse/muse-backlink.el b/emacs.d/elisp/muse/muse-backlink.el new file mode 100644 index 0000000..bc21ddd --- /dev/null +++ b/emacs.d/elisp/muse/muse-backlink.el @@ -0,0 +1,327 @@ +;;; muse-backlink.el --- backlinks for Muse + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Jim Ottaway <j.ottaway@lse.ac.uk> +;; Keywords: + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Hierarchical backlink insertion into new muse pages. +;; +;; To add: +;; +;; (require 'muse-backlink) +;; (muse-backlink-install) +;; +;; To control what gets backlinked, modify +;; `muse-backlink-exclude-backlink-regexp' and +;; `muse-backlink-exclude-backlink-parent-regexp'. +;; +;; To stop backlinking temporarily: +;; (setq muse-backlink-create-backlinks nil) +;; +;; To remove the backlink functionality completely: +;; +;; (muse-backlink-remove) + +;;; Contributors: + +;;; Code: + +(require 'muse) +(require 'muse-project) + +(eval-when-compile (require 'muse-mode)) + +(eval-and-compile + (if (< emacs-major-version 22) + (progn + ;; Swiped from Emacs 22.0.50.4 + (defvar muse-backlink-split-string-default-separators "[ \f\t\n\r\v]+" + "The default value of separators for `split-string'. + +A regexp matching strings of whitespace. May be locale-dependent +\(as yet unimplemented). Should not match non-breaking spaces. + +Warning: binding this to a different value and using it as default is +likely to have undesired semantics.") + + (defun muse-backlink-split-string (string &optional separators omit-nulls) + "Split STRING into substrings bounded by matches for SEPARATORS. + +The beginning and end of STRING, and each match for SEPARATORS, are +splitting points. The substrings matching SEPARATORS are removed, and +the substrings between the splitting points are collected as a list, +which is returned. + +If SEPARATORS is non-nil, it should be a regular expression matching text +which separates, but is not part of, the substrings. If nil it defaults to +`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and +OMIT-NULLS is forced to t. + +If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so +that for the default value of SEPARATORS leading and trailing whitespace +are effectively trimmed). If nil, all zero-length substrings are retained, +which correctly parses CSV format, for example. + +Note that the effect of `(split-string STRING)' is the same as +`(split-string STRING split-string-default-separators t)'). In the rare +case that you wish to retain zero-length substrings when splitting on +whitespace, use `(split-string STRING split-string-default-separators)'. + +Modifies the match data; use `save-match-data' if necessary." + (let ((keep-nulls (not (if separators omit-nulls t))) + (rexp (or separators muse-backlink-split-string-default-separators)) + (start 0) + notfirst + (list nil)) + (while (and (string-match rexp string + (if (and notfirst + (= start (match-beginning 0)) + (< start (length string))) + (1+ start) start)) + (< start (length string))) + (setq notfirst t) + (if (or keep-nulls (< start (match-beginning 0))) + (setq list + (cons (substring string start (match-beginning 0)) + list))) + (setq start (match-end 0))) + (if (or keep-nulls (< start (length string))) + (setq list + (cons (substring string start) + list))) + (nreverse list)))) + (defalias 'muse-backlink-split-string 'split-string))) + +(defgroup muse-backlink nil + "Hierarchical backlinking for Muse." + :group 'muse) + +(defcustom muse-backlink-create-backlinks t + "When non-nil, create hierarchical backlinks in new Muse pages. +For control over which pages will receive backlinks, see +`muse-backlink-exclude-backlink-parent-regexp' and +`muse-backlink-exclude-backlink-regexp'." + :type 'boolean + :group 'muse-backlink) + +(defcustom muse-backlink-avoid-bad-links t + "When non-nil, avoid bad links when backlinking." + :type 'boolean + :group 'muse-backlink) + +;; The default for exclusion stops backlinks from being added to and +;; from planner day pages. +(defcustom muse-backlink-exclude-backlink-parent-regexp + "^[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]$" + "Regular expression matching pages whose children should not have backlinks." + :type 'regexp + :group 'muse-backlink) + +(defcustom muse-backlink-exclude-backlink-regexp + "^[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]$" + "Regular expression matching pages that should not have backlinks." + :type 'regexp + :group 'muse-backlink) + +(defcustom muse-backlink-separator "/" + "String that separates backlinks. +Should be something that will not appear as a substring in an explicit +link that has no description." + :type 'string + :group 'muse-backlink) + +(defcustom muse-backlink-before-string "backlinks: " + "String to come before the backlink list." + :type 'string + :group 'muse-backlink) + +(defcustom muse-backlink-after-string "" + "String to come after the backlink list." + :type 'string + :group 'muse-backlink) + +(defcustom muse-backlink-separator "/" + "String that separates backlinks. +Should be something that will not appear as a substring in an explicit +link that has no description." + :type 'string + :group 'muse-backlink) + +(defcustom muse-backlink-regexp + (concat "^" + (regexp-quote muse-backlink-before-string) + "\\(" + (regexp-quote muse-backlink-separator) + ".+\\)" + (regexp-quote muse-backlink-after-string)) + ;; Really, I want something like this, but I can't make it work: + ;; (concat "^\\(" + ;; (regexp-quote muse-backlink-separator) + ;; "\\(?:" + ;; muse-explicit-link-regexp + ;; "\\)\\)+") + "Regular expression to match backlinks in a buffer. +Match 1 is the list of backlinks without `muse-backlink-before-string' +and `muse-backlink-after-string'." + :type 'regexp + :group 'muse-backlink) + +(defun muse-backlink-goto-insertion-point () + "Find the right place to add backlinks." + (goto-char (point-min)) + (when (looking-at "\\(?:^#.+[ \t]*\n\\)+") + (goto-char (match-end 0)))) + +(defun muse-backlink-get-current () + "Return a list of backlinks in the current buffer." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward muse-backlink-regexp nil t) + (muse-backlink-split-string + (match-string 1) + (regexp-quote muse-backlink-separator) t)))) + +(defun muse-backlink-format-link-list (links) + "Format the list of LINKS as backlinks." + (concat muse-backlink-separator + (mapconcat #'identity links muse-backlink-separator))) + +(defun muse-backlink-insert-links (links) + "Insert backlinks to LINKS into the current page. +LINKS is a list of links ordered by ancestry, with the parent as the +last element." + (muse-backlink-goto-insertion-point) + (insert muse-backlink-before-string + (muse-backlink-format-link-list links) + muse-backlink-after-string + ;; Could have this in the after string, but they might get + ;; deleted. + "\n\n")) + +(defun muse-backlink-unsaved-page-p (page project) + "Return non-nil if PAGE is in PROJECT but has not been saved." + (member + page + (mapcar + #'(lambda (b) + (with-current-buffer b + (and (derived-mode-p 'muse-mode) + (equal muse-current-project project) + (not (muse-project-page-file + (muse-page-name) + muse-current-project)) + (muse-page-name)))) + (buffer-list)))) + +(defvar muse-backlink-links nil + "Internal variable. +The links to insert in the forthcomingly visited muse page.") + +(defvar muse-backlink-pending nil + "Internal variable.") + +(defvar muse-backlink-parent-buffer nil + "Internal variable. +The parent buffer of the forthcomingly visited muse page.") + + +;;; Attach hook to the derived mode hook, to avoid problems such as +;;; planner-prepare-file thinking that the buffer needs no template. +(defun muse-backlink-get-mode-hook () + (derived-mode-hook-name major-mode)) + +(defun muse-backlink-insert-hook-func () + "Insert backlinks into the current buffer and clean up." + (when (and muse-backlink-links + muse-backlink-pending + (string= (car muse-backlink-links) (muse-page-name))) + (muse-backlink-insert-links (cdr muse-backlink-links)) + (when muse-backlink-avoid-bad-links + (save-buffer) + (when muse-backlink-parent-buffer + (with-current-buffer muse-backlink-parent-buffer + (font-lock-fontify-buffer)))) + (setq muse-backlink-links nil + muse-backlink-parent-buffer nil + muse-backlink-pending nil) + (remove-hook (muse-backlink-get-mode-hook) #'muse-backlink-insert-hook-func))) + +(defun muse-backlink-handle-link (link) + "When appropriate, arrange for backlinks on visiting LINK." + (when (and muse-backlink-create-backlinks + (not muse-backlink-pending) + (memq this-command + '(muse-follow-name-at-point muse-follow-name-at-mouse)) + (not muse-publishing-p) + (not (and (boundp 'muse-colors-fontifying-p) + muse-colors-fontifying-p))) + (require 'muse-mode) + (setq + muse-backlink-links + (save-match-data + (let* ((orig-link (or link (match-string 1))) + (link (if (string-match "#" orig-link) + (substring orig-link 0 (match-beginning 0)) + orig-link))) + (unless + (or (not muse-current-project) + (string-match muse-url-regexp orig-link) + (string-match muse-image-regexp orig-link) + (and (boundp 'muse-wiki-interwiki-regexp) + (string-match muse-wiki-interwiki-regexp + orig-link)) + ;; Don't add a backlink if the page already + ;; exists, whether it has been saved or not. + (or (muse-project-page-file link muse-current-project) + (muse-backlink-unsaved-page-p link muse-current-project)) + (string-match muse-backlink-exclude-backlink-parent-regexp + (muse-page-name)) + (string-match muse-backlink-exclude-backlink-regexp link)) + ;; todo: Hmm. This will only work if the child page is the + ;; same mode as the parent page. + (add-hook (muse-backlink-get-mode-hook) #'muse-backlink-insert-hook-func) + (setq muse-backlink-pending t) + (when muse-backlink-avoid-bad-links + (setq muse-backlink-parent-buffer (current-buffer)) + (unless (muse-project-page-file + (muse-page-name) muse-current-project) + ;; It must be modified... + (save-buffer))) + (cons link + (append (muse-backlink-get-current) + (list (muse-make-link (muse-page-name)))))))))) + ;; Make sure we always return nil + nil) + +(defun muse-backlink-install () + "Add backlinking functionality to muse-mode." + (add-to-list 'muse-explicit-link-functions #'muse-backlink-handle-link)) + +(defun muse-backlink-remove () + "Remove backlinking functionality from muse-mode." + (setq muse-explicit-link-functions + (delq #'muse-backlink-handle-link muse-explicit-link-functions))) + +(provide 'muse-backlink) +;;; muse-backlink.el ends here diff --git a/emacs.d/elisp/muse/muse-blosxom.el b/emacs.d/elisp/muse/muse-blosxom.el new file mode 100644 index 0000000..78038d7 --- /dev/null +++ b/emacs.d/elisp/muse/muse-blosxom.el @@ -0,0 +1,306 @@ +;;; muse-blosxom.el --- publish a document tree for serving by (py)Blosxom + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Michael Olson <mwolson@gnu.org> +;; Date: Wed, 23 March 2005 + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; The Blosxom publishing style publishes a tree of categorised files +;; to a mirrored tree of stories to be served by blosxom.cgi or +;; pyblosxom.cgi. +;; +;; Serving entries with (py)blosxom +;; -------------------------------- +;; +;; Each Blosxom file must include `#date yyyy-mm-dd', or optionally +;; the longer `#date yyyy-mm-dd-hh-mm', a title (using the `#title' +;; directive) plus whatever normal content is desired. +;; +;; The date directive is not used directly by (py)blosxom or this +;; program. You need to find two additional items to make use of this +;; feature. +;; +;; 1. A script to gather date directives from the entire blog tree +;; into a single file. The file must associate a blog entry with +;; a date. +;; +;; 2. A plugin for (py)blosxom that reads this file. +;; +;; These 2 things are provided for pyblosxom in the contrib/pyblosxom +;; subdirectory. `getstamps.py' provides the 1st service, while +;; `hardcodedates.py' provides the second service. Eventually it is +;; hoped that a blosxom plugin and script will be found/written. +;; +;; Alternately, the pyblosxom metadate plugin may be used. On the +;; plus side, there is no need to run a script to gather the date. On +;; the downside, each entry is read twice rather than once when the +;; page is rendered. Set the value of muse-blosxom-use-metadate to +;; non-nil to enable adding a #postdate directive to all published +;; files. You can do this by: +;; +;; M-x customize-variable RET muse-blosxom-use-metadate RET +;; +;; With the metadate plugin installed in pyblosxom, the date set in +;; this directive will be used instead of the file's modification +;; time. The plugin is included with Muse at +;; contrib/pyblosxom/metadate.py. +;; +;; Generating a Muse project entry +;; ------------------------------- +;; +;; Muse-blosxom has some helper functions to make specifying +;; muse-blosxom projects a lot easier. An example follows. +;; +;; (setq muse-project-alist +;; `(("blog" +;; (,@(muse-project-alist-dirs "~/path/to/blog-entries") +;; :default "index") +;; ,@(muse-project-alist-styles "~/path/to/blog-entries" +;; "~/public_html/blog" +;; "blosxom-xhtml") +;; ))) +;; +;; Note that we need a backtick instead of a single quote on the +;; second line of this example. +;; +;; Creating new blog entries +;; ------------------------- +;; +;; There is a function called `muse-blosxom-new-entry' that will +;; automate the process of making a new blog entry. To make use of +;; it, do the following. +;; +;; - Customize `muse-blosxom-base-directory' to the location that +;; your blog entries are stored. +;; +;; - Assign the `muse-blosxom-new-entry' function to a key sequence. +;; I use the following code to assign this function to `C-c p l'. +;; +;; (global-set-key "\C-cpl" 'muse-blosxom-new-entry) +;; +;; - You should create your directory structure ahead of time under +;; your base directory. These directories, which correspond with +;; category names, may be nested. +;; +;; - When you enter this key sequence, you will be prompted for the +;; category of your entry and its title. Upon entering this +;; information, a new file will be created that corresponds with +;; the title, but in lowercase letters and having special +;; characters converted to underscores. The title and date +;; directives will be inserted automatically. +;; +;; Using tags +;; ---------- +;; +;; If you wish to keep all of your blog entries in one directory and +;; use tags to classify your entries, set `muse-blosxom-use-tags' to +;; non-nil. +;; +;; For this to work, you will need to be using the PyBlosxom plugin at +;; http://pyblosxom.sourceforge.net/blog/registry/meta/Tags. + +;;; Contributors: + +;; Gary Vaughan (gary AT gnu DOT org) is the original author of +;; `emacs-wiki-blosxom.el', which is the ancestor of this file. + +;; Brad Collins (brad AT chenla DOT org) ported this file to Muse. + +;; Björn Lindström (bkhl AT elektrubadur DOT se) made many valuable +;; suggestions. + +;; Sasha Kovar (sasha AT arcocene DOT org) fixed +;; muse-blosxom-new-entry when using tags and also implemented support +;; for the #postdate directive. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Blosxom Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-project) +(require 'muse-publish) +(require 'muse-html) + +(defgroup muse-blosxom nil + "Options controlling the behavior of Muse Blosxom publishing. +See `muse-blosxom' for more information." + :group 'muse-publish) + +(defcustom muse-blosxom-extension ".txt" + "Default file extension for publishing Blosxom files." + :type 'string + :group 'muse-blosxom) + +(defcustom muse-blosxom-header + "<lisp>(concat (muse-publishing-directive \"title\") \"\\n\" + (when muse-blosxom-use-metadate + (let ((date (muse-publishing-directive \"date\"))) + (when date (concat \"#postdate \" + (muse-blosxom-format-date date) \"\\n\")))) + (when muse-blosxom-use-tags + (let ((tags (muse-publishing-directive \"tags\"))) + (when tags (concat \"#tags \" tags \"\\n\")))))</lisp>" + "Header used for publishing Blosxom files. This may be text or a filename." + :type 'string + :group 'muse-blosxom) + +(defcustom muse-blosxom-footer "" + "Footer used for publishing Blosxom files. This may be text or a filename." + :type 'string + :group 'muse-blosxom) + +(defcustom muse-blosxom-base-directory "~/Blog" + "Base directory of blog entries. +This is the top-level directory where your Muse blog entries may be found." + :type 'directory + :group 'muse-blosxom) + +(defcustom muse-blosxom-use-tags nil + "Determine whether or not to enable use of the #tags directive. + +If you wish to keep all of your blog entries in one directory and +use tags to classify your entries, set `muse-blosxom-use-tags' to +non-nil. + +For this to work, you will need to be using the PyBlosxom plugin +at http://pyblosxom.sourceforge.net/blog/registry/meta/Tags." + :type 'boolean + :group 'muse-blosxom) + +(defcustom muse-blosxom-use-metadate nil + "Determine whether or not to use the #postdate directive. + +If non-nil, published entries include the original date (as specified +in the muse #date line) which can be read by the metadate PyBlosxom +plugin. + +For this to work, you will need to be using the PyBlosxom plugin +at http://pyblosxom.sourceforge.net/blog/registry/date/metadate." + :type 'boolean + :group 'muse-blosxom) + +;; Maintain (published-file . date) alist, which will later be written +;; to a timestamps file; not implemented yet. + +(defvar muse-blosxom-page-date-alist nil) + +(defun muse-blosxom-update-page-date-alist () + "Add a date entry to `muse-blosxom-page-date-alist' for this page." + (when muse-publishing-current-file + ;; Make current file be relative to base directory + (let ((rel-file + (concat + (file-name-as-directory + (or (muse-publishing-directive "category") + (file-relative-name + (file-name-directory + (expand-file-name muse-publishing-current-file)) + (file-truename muse-blosxom-base-directory)))) + (file-name-nondirectory muse-publishing-current-file)))) + ;; Strip the file extension + (when muse-ignored-extensions-regexp + (setq rel-file (save-match-data + (and (string-match muse-ignored-extensions-regexp + rel-file) + (replace-match "" t t rel-file))))) + ;; Add to page-date alist + (add-to-list + 'muse-blosxom-page-date-alist + `(,rel-file . ,(muse-publishing-directive "date")))))) + +;; Enter a new blog entry + +(defun muse-blosxom-title-to-file (title) + "Derive a file name from the given TITLE. + +Feel free to overwrite this if you have a different concept of what +should be allowed in a filename." + (muse-replace-regexp-in-string (concat "[^-." muse-regexp-alnum "]") + "_" (downcase title))) + +(defun muse-blosxom-format-date (date) + "Convert a date string to PyBlosxom metadate plugin format." + (apply #'format "%s-%s-%s %s:%s" (split-string date "-"))) + +;;;###autoload +(defun muse-blosxom-new-entry (category title) + "Start a new blog entry with given CATEGORY. +The filename of the blog entry is derived from TITLE. +The page will be initialized with the current date and TITLE." + (interactive + (list + (if muse-blosxom-use-tags + (let ((tag "foo") + (tags nil)) + (while (progn (setq tag (read-string "Tag (RET to continue): ")) + (not (string= tag ""))) + (add-to-list 'tags tag t)) + tags) + (funcall muse-completing-read-function + "Category: " + (mapcar 'list (muse-project-recurse-directory + muse-blosxom-base-directory)))) + (read-string "Title: "))) + (let ((file (muse-blosxom-title-to-file title))) + (muse-project-find-file + file "blosxom" nil + (if muse-blosxom-use-tags + (directory-file-name muse-blosxom-base-directory) + (concat (directory-file-name muse-blosxom-base-directory) + "/" category)))) + (goto-char (point-min)) + (insert "#date " (format-time-string "%Y-%m-%d-%H-%M") + "\n#title " title) + (if muse-blosxom-use-tags + (if (> (length category) 0) + (insert (concat "\n#tags " (mapconcat #'identity category ",")))) + (unless (string= category "") + (insert (concat "\n#category " category)))) + (insert "\n\n") + (forward-line 2)) + +;;; Register the Muse Blosxom Publisher + +(muse-derive-style "blosxom-html" "html" + :suffix 'muse-blosxom-extension + :link-suffix 'muse-html-extension + :header 'muse-blosxom-header + :footer 'muse-blosxom-footer + :after 'muse-blosxom-update-page-date-alist + :browser 'find-file) + +(muse-derive-style "blosxom-xhtml" "xhtml" + :suffix 'muse-blosxom-extension + :link-suffix 'muse-xhtml-extension + :header 'muse-blosxom-header + :footer 'muse-blosxom-footer + :after 'muse-blosxom-update-page-date-alist + :browser 'find-file) + +(provide 'muse-blosxom) + +;;; muse-blosxom.el ends here diff --git a/emacs.d/elisp/muse/muse-book.el b/emacs.d/elisp/muse/muse-book.el new file mode 100644 index 0000000..213a64e --- /dev/null +++ b/emacs.d/elisp/muse/muse-book.el @@ -0,0 +1,284 @@ +;;; muse-book.el --- publish entries into a compilation + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Book Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) +(require 'muse-project) +(require 'muse-latex) +(require 'muse-regexps) + +(defgroup muse-book nil + "Module for publishing a series of Muse pages as a complete book. +Each page will become a separate chapter in the book, unless the +style keyword :nochapters is used, in which case they are all run +together as if one giant chapter." + :group 'muse-publish) + +(defcustom muse-book-before-publish-hook nil + "A hook run in the book buffer before it is marked up." + :type 'hook + :group 'muse-book) + +(defcustom muse-book-after-publish-hook nil + "A hook run in the book buffer after it is marked up." + :type 'hook + :group 'muse-book) + +(defcustom muse-book-latex-header + "\\documentclass{book} + +\\usepackage[english]{babel} +\\usepackage[latin1]{inputenc} +\\usepackage[T1]{fontenc} + +\\begin{document} + +\\title{<lisp>(muse-publishing-directive \"title\")</lisp>} +\\author{<lisp>(muse-publishing-directive \"author\")</lisp>} +\\date{<lisp>(muse-publishing-directive \"date\")</lisp>} + +\\maketitle + +\\tableofcontents\n" + "Header used for publishing books to LaTeX. This may be text or a filename." + :type 'string + :group 'muse-book) + +(defcustom muse-book-latex-footer + "<lisp>(muse-latex-bibliography)</lisp> +\\end{document}" + "Footer used for publishing books to LaTeX. This may be text or a filename." + :type 'string + :group 'muse-book) + +(defun muse-book-publish-chapter (title entry style &optional nochapters) + "Publish the chapter TITLE for the file ENTRY using STYLE. +TITLE is a string, ENTRY is a cons of the form (PAGE-NAME . +FILE), and STYLE is a Muse style list. + +This routine does the same basic work as `muse-publish-markup-buffer', +but treating the page as if it were a single chapter within a book." + (let ((muse-publishing-directives (list (cons "title" title))) + (muse-publishing-current-file (cdr entry)) + (beg (point)) end) + (muse-insert-file-contents (cdr entry)) + (setq end (copy-marker (point-max) t)) + (muse-publish-markup-region beg end (car entry) style) + (goto-char beg) + (unless (or nochapters + (muse-style-element :nochapters style)) + (insert "\n") + (muse-insert-markup (muse-markup-text 'chapter)) + (insert (let ((chap (muse-publishing-directive "title"))) + (if (string= chap title) + (car entry) + chap))) + (muse-insert-markup (muse-markup-text 'chapter-end)) + (insert "\n\n")) + (save-restriction + (narrow-to-region beg end) + (muse-publish-markup (or title "") + '((100 "<\\(lisp\\)>" 0 + muse-publish-markup-tag))) + (muse-style-run-hooks :after style)) + (goto-char end))) + +(defun muse-book-publish-p (project target) + "Determine whether the book in PROJECT is out-of-date." + (let ((pats (cadr project))) + (catch 'publish + (while pats + (if (symbolp (car pats)) + (if (eq :book-end (car pats)) + (throw 'publish nil) + ;; skip past symbol-value pair + (setq pats (cddr pats))) + (dolist (entry (muse-project-file-entries (car pats))) + (when (and (not (muse-project-private-p (cdr entry))) + (file-newer-than-file-p (cdr entry) target)) + (throw 'publish t))) + (setq pats (cdr pats))))))) + +(defun muse-book-get-directives (file) + "Interpret any publishing directives contained in FILE. +This is meant to be called in a temp buffer that will later be +used for publishing." + (save-restriction + (narrow-to-region (point) (point)) + (unwind-protect + (progn + (muse-insert-file-contents file) + (muse-publish-markup + "attributes" + `(;; Remove leading and trailing whitespace from the file + (100 "\\(\\`\n+\\|\n+\\'\\)" 0 "") + ;; Remove trailing whitespace from all lines + (200 ,(concat "[" muse-regexp-blank "]+$") 0 "") + ;; Handle any leading #directives + (300 "\\`#\\([a-zA-Z-]+\\)\\s-+\\(.+\\)\n+" + 0 muse-publish-markup-directive)))) + (delete-region (point-min) (point-max))))) + +(defun muse-book-publish-project + (project book title style &optional output-dir force) + "Publish PROJECT under the name BOOK with the given TITLE and STYLE. +BOOK should be a page name, i.e., letting the style determine the +prefix and/or suffix. The book is published to OUTPUT-DIR. If FORCE +is nil, the book is only published if at least one of its component +pages has changed since it was last published." + (interactive + (let ((project (muse-read-project "Publish project as book: " nil t))) + (append (list project + (read-string "Basename of book (without extension): ") + (read-string "Title of book: ")) + (muse-publish-get-info)))) + (setq project (muse-project project)) + (let ((muse-current-project project)) + ;; See if any of the project's files need saving first + (muse-project-save-buffers project) + ;; Publish the book + (muse-book-publish book style output-dir force title))) + +(defun muse-book-publish (file style &optional output-dir force title) + "Publish FILE as a book with the given TITLE and STYLE. +The book is published to OUTPUT-DIR. If FORCE is nil, the book +is only published if at least one of its component pages has +changed since it was last published." + ;; Cleanup some of the arguments + (let ((style-name style)) + (setq style (muse-style style)) + (unless style + (error "There is no style '%s' defined" style-name))) + ;; Publish each page in the project as a chapter in one large book + (let* ((output-path (muse-publish-output-file file output-dir style)) + (output-suffix (muse-style-element :osuffix style)) + (target output-path) + (project muse-current-project) + (published nil)) + (when output-suffix + (setq target (concat (muse-path-sans-extension target) + output-suffix))) + ;; Unless force is non-nil, determine if the book needs publishing + (if (and (not force) + (not (muse-book-publish-p project target))) + (message "The book \"%s\" is up-to-date." file) + ;; Create the book from all its component parts + (muse-with-temp-buffer + (let ((style-final (muse-style-element :final style t)) + (style-header (muse-style-element :header style)) + (style-footer (muse-style-element :footer style)) + (muse-publishing-current-style style) + (muse-publishing-directives + (list (cons "title" (or title (muse-page-name file))) + (cons "date" (format-time-string "%B %e, %Y")))) + (muse-publishing-p t) + (muse-current-project project) + (pats (cadr project)) + (nochapters nil)) + (run-hooks 'muse-before-book-publish-hook) + (let ((style-final style-final) + (style-header style-header) + (style-footer style-footer)) + (unless title + (muse-book-get-directives file) + (setq title (muse-publishing-directive "title"))) + (while pats + (if (symbolp (car pats)) + (cond + ((eq :book-part (car pats)) + (insert "\n") + (muse-insert-markup (muse-markup-text 'part)) + (insert (cadr pats)) + (muse-insert-markup (muse-markup-text 'part-end)) + (insert "\n") + (setq pats (cddr pats))) + ((eq :book-chapter (car pats)) + (insert "\n") + (muse-insert-markup (muse-markup-text 'chapter)) + (insert (cadr pats)) + (muse-insert-markup (muse-markup-text 'chapter-end)) + (insert "\n") + (setq pats (cddr pats))) + ((eq :nochapters (car pats)) + (setq nochapters t + pats (cddr pats))) + ((eq :book-style (car pats)) + (setq style (muse-style (cadr pats))) + (setq style-final (muse-style-element :final style t) + style-header (muse-style-element :header style) + style-footer (muse-style-element :footer style) + muse-publishing-current-style style) + (setq pats (cddr pats))) + ((eq :book-funcall (car pats)) + (funcall (cadr pats)) + (setq pats (cddr pats))) + ((eq :book-end (car pats)) + (setq pats nil)) + (t + (setq pats (cddr pats)))) + (let ((entries (muse-project-file-entries (car pats)))) + (while (and entries (car entries) (caar entries)) + (unless (muse-project-private-p (cdar entries)) + (muse-book-publish-chapter title (car entries) + style nochapters) + (setq published t)) + (setq entries (cdr entries)))) + (setq pats (cdr pats))))) + (goto-char (point-min)) + (if style-header (muse-insert-file-or-string style-header file)) + (goto-char (point-max)) + (if style-footer (muse-insert-file-or-string style-footer file)) + (run-hooks 'muse-after-book-publish-hook) + (if (muse-write-file output-path) + (if style-final + (funcall style-final file output-path target)) + (setq published nil))))) + (if published + (message "The book \"%s\" has been published." file)) + published)) + +;;; Register the Muse BOOK Publishers + +(muse-derive-style "book-latex" "latex" + :header 'muse-book-latex-header + :footer 'muse-book-latex-footer + :publish 'muse-book-publish) + +(muse-derive-style "book-pdf" "pdf" + :header 'muse-book-latex-header + :footer 'muse-book-latex-footer + :publish 'muse-book-publish) + +(provide 'muse-book) + +;;; muse-book.el ends here diff --git a/emacs.d/elisp/muse/muse-colors.el b/emacs.d/elisp/muse/muse-colors.el new file mode 100644 index 0000000..fb76ac5 --- /dev/null +++ b/emacs.d/elisp/muse/muse-colors.el @@ -0,0 +1,1022 @@ +;;; muse-colors.el --- coloring and highlighting used by Muse + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: John Wiegley (johnw AT gnu DOT org) +;; Keywords: hypermedia +;; Date: Thu 11-Mar-2004 + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;; Lan Yufeng (nlany DOT web AT gmail DOT com) found an error where +;; headings were being given the wrong face, contributing a patch to +;; fix this. + +;; Sergey Vlasov (vsu AT altlinux DOT ru) fixed an issue with coloring +;; links that are in consecutive lines. + +;; Jim Ottaway ported the <lisp> tag from emacs-wiki. + +;; Per B. Sederberg (per AT med DOT upenn DOT edu) contributed the +;; viewing of inline images. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Emacs Muse Highlighting +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-mode) +(require 'muse-regexps) +(require 'font-lock) + +(defgroup muse-colors nil + "Options controlling the behavior of Emacs Muse highlighting. +See `muse-colors-buffer' for more information." + :group 'muse-mode) + +(defcustom muse-colors-autogen-headings t + "Specify whether the heading faces should be auto-generated. +The default is to scale them. + +Choosing 'outline will copy the colors from the outline-mode +headings. + +If you want to customize each of the headings individually, set +this to nil." + :type '(choice (const :tag "Default (scaled) headings" t) + (const :tag "Use outline-mode headings" outline) + (const :tag "Don't touch the headings" nil)) + :group 'muse-colors) + +(defcustom muse-colors-evaluate-lisp-tags t + "Specify whether to evaluate the contents of <lisp> tags at +display time. If nil, don't evaluate them. If non-nil, evaluate +them. + +The actual contents of the buffer are not changed, only the +displayed text." + :type 'boolean + :group 'muse-colors) + +(defcustom muse-colors-inline-images t + "Specify whether to inline images inside the Emacs buffer. If +nil, don't inline them. If non-nil, an image link will be +replaced by the image. + +The actual contents of the buffer are not changed, only whether +an image is displayed." + :type 'boolean + :group 'muse-colors) + +(defcustom muse-colors-inline-image-method 'default-directory + "Determine how to locate inline images. +Setting this to 'default-directory uses the current directory of +the current Muse buffer. + +Setting this to a function calls that function with the filename +of the image to be inlined. The value that is returned will be +used as the filename of the image." + :type '(choice (const :tag "Current directory" default-directory) + (const :tag "Publishing directory" + muse-colors-use-publishing-directory) + (function :tag "Custom function")) + :group 'muse-colors) + +(defvar muse-colors-region-end nil + "Indicate the end of the region that is currently being font-locked.") +(make-variable-buffer-local 'muse-colors-region-end) + +;;;###autoload +(defun muse-colors-toggle-inline-images () + "Toggle display of inlined images on/off." + (interactive) + ;; toggle the custom setting + (if (not muse-colors-inline-images) + (setq muse-colors-inline-images t) + (setq muse-colors-inline-images nil)) + ;; reprocess the buffer + (muse-colors-buffer) + ;; display informative message + (if muse-colors-inline-images + (message "Images are now displayed inline") + (message "Images are now displayed as links"))) + +(defvar muse-colors-outline-faces-list + (if (facep 'outline-1) + '(outline-1 outline-2 outline-3 outline-4 outline-5) + ;; these are equivalent in coloring to the outline faces + '(font-lock-function-name-face + font-lock-variable-name-face + font-lock-keyword-face + font-lock-builtin-face + font-lock-comment-face)) + "Outline faces to use when assigning Muse header faces.") + +(defun muse-make-faces-default (&optional later) + "Generate the default face definitions for headers." + (dolist (num '(1 2 3 4 5)) + (let ((newsym (intern (concat "muse-header-" (int-to-string num)))) + (docstring (concat + "Muse header face. See " + "`muse-colors-autogen-headings' before changing it."))) + ;; put in the proper group and give documentation + (if later + (unless (featurep 'xemacs) + (muse-copy-face 'variable-pitch newsym) + (set-face-attribute newsym nil :height (1+ (* 0.1 (- 5 num))) + :weight 'bold)) + (if (featurep 'xemacs) + (eval `(defface ,newsym + '((t (:size + ,(nth (1- num) + '("24pt" "18pt" "14pt" "12pt" "11pt")) + :bold t))) + ,docstring + :group 'muse-colors)) + (eval `(defface ,newsym + '((t (:height ,(1+ (* 0.1 (- 5 num))) + :inherit variable-pitch + :weight bold))) + ,docstring + :group 'muse-colors))))))) + +(progn (muse-make-faces-default)) + +(defun muse-make-faces (&optional frame) + "Generate face definitions for headers based the user's preferences." + (cond + ((not muse-colors-autogen-headings) + nil) + ((eq muse-colors-autogen-headings t) + (muse-make-faces-default t)) + (t + (dolist (num '(1 2 3 4 5)) + (let ((newsym (intern (concat "muse-header-" (int-to-string num))))) + ;; copy the desired face definition + (muse-copy-face (nth (1- num) muse-colors-outline-faces-list) + newsym)))))) + +;; after displaying the Emacs splash screen, the faces are wiped out, +;; so recover from that +(add-hook 'window-setup-hook #'muse-make-faces) +;; ditto for when a new frame is created +(when (boundp 'after-make-frame-functions) + (add-hook 'after-make-frame-functions #'muse-make-faces)) + +(defface muse-link + '((((class color) (background light)) + (:foreground "blue" :underline "blue" :bold t)) + (((class color) (background dark)) + (:foreground "cyan" :underline "cyan" :bold t)) + (t (:bold t))) + "Face for Muse cross-references." + :group 'muse-colors) + +(defface muse-bad-link + '((((class color) (background light)) + (:foreground "red" :underline "red" :bold t)) + (((class color) (background dark)) + (:foreground "coral" :underline "coral" :bold t)) + (t (:bold t))) + "Face for bad Muse cross-references." + :group 'muse-colors) + +(defface muse-verbatim + '((((class color) (background light)) + (:foreground "slate gray")) + (((class color) (background dark)) + (:foreground "gray"))) + "Face for verbatim text." + :group 'muse-colors) + +(defface muse-emphasis-1 + '((t (:italic t))) + "Face for italic emphasized text." + :group 'muse-colors) + +(defface muse-emphasis-2 + '((t (:bold t))) + "Face for bold emphasized text." + :group 'muse-colors) + +(defface muse-emphasis-3 + '((t (:bold t :italic t))) + "Face for bold italic emphasized text." + :group 'muse-colors) + +(muse-copy-face 'italic 'muse-emphasis-1) +(muse-copy-face 'bold 'muse-emphasis-2) +(muse-copy-face 'bold-italic 'muse-emphasis-3) + +(defcustom muse-colors-buffer-hook nil + "A hook run after a region is highlighted. +Each function receives three arguments: BEG END VERBOSE. +BEG and END mark the range being highlighted, and VERBOSE specifies +whether progress messages should be displayed to the user." + :type 'hook + :group 'muse-colors) + +(defvar muse-colors-highlighting-registry nil + "The rules for highlighting Muse and Muse-derived buffers. +This is automatically generated when using font-lock in Muse buffers. + +This an alist of major-mode symbols to `muse-colors-rule' objects.") + +(defun muse-colors-make-highlighting-struct () + (list nil nil nil)) +(defconst muse-colors-highlighting.regexp 0 + "Regexp matching each car of the markup of the current rule.") +(defconst muse-colors-highlighting.vector 1 + "Vector of all characters that are part of the markup of the current rule. +This is composed of the 2nd element of each markup entry.") +(defconst muse-colors-highlighting.remaining 2 + "Expressions for highlighting a buffer which have no corresponding +entry in the vector.") + +(defsubst muse-colors-highlighting-entry (mode) + "Return the highlighting rules for MODE." + (assq mode muse-colors-highlighting-registry)) + +(defun muse-colors-find-highlighting (mode) + "Return the highlighting rules to be used for MODE. +If MODE does not have highlighting rules, check its parent modes." + (let ((seen nil)) + (catch 'rules + (while (and mode (not (memq mode seen))) + (let ((entry (muse-colors-highlighting-entry mode))) + (when entry (throw 'rules (cdr entry)))) + (setq seen (cons mode seen)) + (setq mode (get mode 'derived-mode-parent))) + nil))) + +(defun muse-colors-define-highlighting (mode markup) + "Create or update the markup rules for MODE, using MARKUP. + +See `muse-colors-markup' for an explanation of the format that MARKUP +should take." + (unless (and (symbolp mode) mode (consp markup)) + (error "Invalid arguments")) + (let* ((highlighting-entry (muse-colors-highlighting-entry mode)) + (struct (cdr highlighting-entry)) + (regexp nil) + (vector nil) + (remaining nil)) + ;; Initialize struct + (if struct + (setq vector (nth muse-colors-highlighting.vector struct)) + (setq struct (muse-colors-make-highlighting-struct))) + ;; Initialize vector + (if vector + (let ((i 0)) + (while (< i 128) + (aset vector i nil) + (setq i (1+ i)))) + (setq vector (make-vector 128 nil))) + ;; Determine vector, regexp, remaining + (let ((regexps nil) + (rules nil)) + (dolist (rule markup) + (let ((value (cond ((symbolp (car rule)) + (symbol-value (car rule))) + ((stringp (car rule)) + (car rule)) + (t nil)))) + (when value + (setq rules (cons rule rules)) + (setq regexps (cons value regexps))))) + (setq regexps (nreverse regexps)) + (setq regexp (concat "\\(" (mapconcat #'identity regexps "\\|") "\\)")) + (dolist (rule rules) + (if (eq (nth 1 rule) t) + (setq remaining (cons (cons (nth 0 rule) (nth 2 rule)) + remaining)) + (aset vector (nth 1 rule) + (cons (cons (nth 0 rule) (nth 2 rule)) + (aref vector (nth 1 rule))))))) + ;; Update the struct + (setcar (nthcdr muse-colors-highlighting.regexp struct) regexp) + (setcar (nthcdr muse-colors-highlighting.vector struct) vector) + (setcar (nthcdr muse-colors-highlighting.remaining struct) remaining) + ;; Update entry for mode in muse-colors-highlighting-registry + (if highlighting-entry + (setcdr highlighting-entry struct) + (setq muse-colors-highlighting-registry + (cons (cons mode struct) + muse-colors-highlighting-registry))))) + +(defun muse-configure-highlighting (sym val) + "Extract color markup information from VAL and set to SYM. +This is usually called with `muse-colors-markup' as both arguments." + (muse-colors-define-highlighting 'muse-mode val) + (set sym val)) + +(defun muse-colors-emphasized () + "Color emphasized text and headings." + ;; Here we need to check four different points - the start and end + ;; of the leading *s, and the start and end of the trailing *s. We + ;; allow the outsides to be surrounded by whitespace or punctuation, + ;; but no word characters, and the insides must not be surrounded by + ;; whitespace or punctuation. Thus the following are valid: + ;; + ;; " *foo bar* " + ;; "**foo**," + ;; and the following is invalid: + ;; "** testing **" + (let* ((beg (match-beginning 0)) + (e1 (match-end 0)) + (leader (- e1 beg)) + b2 e2 multiline) + (unless (or (eq (get-text-property beg 'invisible) 'muse) + (get-text-property beg 'muse-comment) + (get-text-property beg 'muse-directive)) + ;; check if it's a header + (if (eq (char-after e1) ?\ ) + (when (or (= beg (point-min)) + (eq (char-before beg) ?\n)) + (add-text-properties + (muse-line-beginning-position) (muse-line-end-position) + (list 'face (intern (concat "muse-header-" + (int-to-string leader)))))) + ;; beginning of line or space or symbol + (when (or (= beg (point-min)) + (eq (char-syntax (char-before beg)) ?\ ) + (memq (char-before beg) + '(?\- ?\[ ?\< ?\( ?\' ?\` ?\" ?\n))) + (save-excursion + (skip-chars-forward "^*<>\n" muse-colors-region-end) + (when (eq (char-after) ?\n) + (setq multiline t) + (skip-chars-forward "^*<>" muse-colors-region-end)) + (setq b2 (point)) + (skip-chars-forward "*" muse-colors-region-end) + (setq e2 (point)) + ;; Abort if space exists just before end + ;; or bad leader + ;; or no '*' at end + ;; or word constituent follows + (unless (or (> leader 5) + (not (eq leader (- e2 b2))) + (eq (char-syntax (char-before b2)) ?\ ) + (not (eq (char-after b2) ?*)) + (and (not (eobp)) + (eq (char-syntax (char-after (1+ b2))) ?w))) + (add-text-properties beg e1 '(invisible muse)) + (add-text-properties + e1 b2 (list 'face (cond ((= leader 1) 'muse-emphasis-1) + ((= leader 2) 'muse-emphasis-2) + ((= leader 3) 'muse-emphasis-3)))) + (add-text-properties b2 e2 '(invisible muse)) + (when multiline + (add-text-properties + beg e2 '(font-lock-multiline t)))))))))) + +(defun muse-colors-underlined () + "Color underlined text." + (let ((start (match-beginning 0)) + multiline) + (unless (or (eq (get-text-property start 'invisible) 'muse) + (get-text-property start 'muse-comment) + (get-text-property start 'muse-directive)) + ;; beginning of line or space or symbol + (when (or (= start (point-min)) + (eq (char-syntax (char-before start)) ?\ ) + (memq (char-before start) + '(?\- ?\[ ?\< ?\( ?\' ?\` ?\" ?\n))) + (save-excursion + (skip-chars-forward "^_<>\n" muse-colors-region-end) + (when (eq (char-after) ?\n) + (setq multiline t) + (skip-chars-forward "^_<>" muse-colors-region-end)) + ;; Abort if space exists just before end + ;; or no '_' at end + ;; or word constituent follows + (unless (or (eq (char-syntax (char-before (point))) ?\ ) + (not (eq (char-after (point)) ?_)) + (and (not (eobp)) + (eq (char-syntax (char-after (1+ (point)))) ?w))) + (add-text-properties start (1+ start) '(invisible muse)) + (add-text-properties (1+ start) (point) '(face underline)) + (add-text-properties (point) + (min (1+ (point)) (point-max)) + '(invisible muse)) + (when multiline + (add-text-properties + start (min (1+ (point)) (point-max)) + '(font-lock-multiline t))))))))) + +(defun muse-colors-verbatim () + "Render in teletype and suppress further parsing." + (let ((start (match-beginning 0)) + multiline) + (unless (or (eq (get-text-property start 'invisible) 'muse) + (get-text-property start 'muse-comment) + (get-text-property start 'muse-directive)) + ;; beginning of line or space or symbol + (when (or (= start (point-min)) + (eq (char-syntax (char-before start)) ?\ ) + (memq (char-before start) + '(?\- ?\[ ?\< ?\( ?\' ?\` ?\" ?\n))) + (let ((pos (point))) + (skip-chars-forward "^=\n" muse-colors-region-end) + (when (eq (char-after) ?\n) + (setq multiline t) + (skip-chars-forward "^=" muse-colors-region-end)) + ;; Abort if space exists just before end + ;; or no '=' at end + ;; or word constituent follows + (unless (or (eq (char-syntax (char-before (point))) ?\ ) + (not (eq (char-after (point)) ?=)) + (and (not (eobp)) + (eq (char-syntax (char-after (1+ (point)))) ?w))) + (setq pos (min (1+ (point)) (point-max))) + (add-text-properties start (1+ start) '(invisible muse)) + (add-text-properties (1+ start) (point) '(face muse-verbatim)) + (add-text-properties (point) + (min (1+ (point)) (point-max)) + '(invisible muse)) + (when multiline + (add-text-properties + start (min (1+ (point)) (point-max)) + '(font-lock-multiline t)))) + (goto-char pos)))))) + +(defcustom muse-colors-markup + `(;; make emphasized text appear emphasized + ("\\*\\{1,5\\}" ?* muse-colors-emphasized) + + ;; make underlined text appear underlined + (,(concat "_[^" muse-regexp-blank "_\n]") + ?_ muse-colors-underlined) + + ("^#title " ?\# muse-colors-title) + + (muse-explicit-link-regexp ?\[ muse-colors-explicit-link) + + ;; render in teletype and suppress further parsing + (,(concat "=[^" muse-regexp-blank "=\n]") ?= muse-colors-verbatim) + + ;; highlight any markup tags encountered + (muse-tag-regexp ?\< muse-colors-custom-tags) + + ;; display comments + (,(concat "^;[" muse-regexp-blank "]") ?\; muse-colors-comment) + + ;; this has to come later since it doesn't have a special + ;; character in the second cell + (muse-url-regexp t muse-colors-implicit-link) + ) + "Expressions to highlight an Emacs Muse buffer. +These are arranged in a rather special fashion, so as to be as quick as +possible. + +Each element of the list is itself a list, of the form: + + (LOCATE-REGEXP TEST-CHAR MATCH-FUNCTION) + +LOCATE-REGEXP is a partial regexp, and should be the smallest possible +regexp to differentiate this rule from other rules. It may also be a +symbol containing such a regexp. The buffer region is scanned only +once, and LOCATE-REGEXP indicates where the scanner should stop to +look for highlighting possibilities. + +TEST-CHAR is a char or t. The character should match the beginning +text matched by LOCATE-REGEXP. These chars are used to build a vector +for fast MATCH-FUNCTION calling. + +MATCH-FUNCTION is the function called when a region has been +identified. It is responsible for adding the appropriate text +properties to change the appearance of the buffer. + +This markup is used to modify the appearance of the original text to +make it look more like the published HTML would look (like making some +markup text invisible, inlining images, etc). + +font-lock is used to apply the markup rules, so that they can happen +on a deferred basis. They are not always accurate, but you can use +\\[font-lock-fontifty-block] near the point of error to force +fontification in that area." + :type '(repeat + (list :tag "Highlight rule" + (choice (regexp :tag "Locate regexp") + (symbol :tag "Regexp symbol")) + (choice (character :tag "Confirm character") + (const :tag "Default rule" t)) + function)) + :set 'muse-configure-highlighting + :group 'muse-colors) + +;; XEmacs users don't have `font-lock-multiline'. +(unless (boundp 'font-lock-multiline) + (defvar font-lock-multiline nil)) + +(defun muse-use-font-lock () + "Set up font-locking for Muse." + (muse-add-to-invisibility-spec 'muse) + (set (make-local-variable 'font-lock-multiline) 'undecided) + (set (make-local-variable 'font-lock-defaults) + `(nil t nil nil beginning-of-line + (font-lock-fontify-region-function . muse-colors-region) + (font-lock-unfontify-region-function + . muse-unhighlight-region))) + (set (make-local-variable 'font-lock-fontify-region-function) + 'muse-colors-region) + (set (make-local-variable 'font-lock-unfontify-region-function) + 'muse-unhighlight-region) + (muse-make-faces) + (muse-colors-define-highlighting 'muse-mode muse-colors-markup) + (font-lock-mode t)) + +(defun muse-colors-buffer () + "Re-highlight the entire Muse buffer." + (interactive) + (muse-colors-region (point-min) (point-max) t)) + +(defvar muse-colors-fontifying-p nil + "Indicate whether Muse is fontifying the current buffer.") +(make-variable-buffer-local 'muse-colors-fontifying-p) + +(defvar muse-colors-delayed-commands nil + "Commands to be run immediately after highlighting a region. + +This is meant to accommodate highlighting <lisp> in #title +directives after everything else. + +It may be modified by Muse functions during highlighting, but not +the user.") +(make-variable-buffer-local 'muse-colors-delayed-commands) + +(defun muse-colors-region (beg end &optional verbose) + "Apply highlighting according to `muse-colors-markup'. +Note that this function should NOT change the buffer, nor should any +of the functions listed in `muse-colors-markup'." + (let ((buffer-undo-list t) + (inhibit-read-only t) + (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t) + (modified-p (buffer-modified-p)) + (muse-colors-fontifying-p t) + (muse-colors-region-end (muse-line-end-position end)) + (muse-colors-delayed-commands nil) + (highlighting (muse-colors-find-highlighting major-mode)) + regexp vector remaining + deactivate-mark) + (unless highlighting + (error "No highlighting found for this mode")) + (setq regexp (nth muse-colors-highlighting.regexp highlighting) + vector (nth muse-colors-highlighting.vector highlighting) + remaining (nth muse-colors-highlighting.remaining highlighting)) + (unwind-protect + (save-excursion + (save-restriction + (widen) + ;; check to see if we should expand the beg/end area for + ;; proper multiline matches + (when (and font-lock-multiline + (> beg (point-min)) + (get-text-property (1- beg) 'font-lock-multiline)) + ;; We are just after or in a multiline match. + (setq beg (or (previous-single-property-change + beg 'font-lock-multiline) + (point-min))) + (goto-char beg) + (setq beg (muse-line-beginning-position))) + (when font-lock-multiline + (setq end (or (text-property-any end (point-max) + 'font-lock-multiline nil) + (point-max)))) + (goto-char end) + (setq end (muse-line-beginning-position 2)) + ;; Undo any fontification in the area. + (font-lock-unfontify-region beg end) + ;; And apply fontification based on `muse-colors-markup' + (let ((len (float (- end beg))) + (case-fold-search nil) + markup-list) + (goto-char beg) + (while (and (< (point) end) + (re-search-forward regexp end t)) + (if verbose + (message "Highlighting buffer...%d%%" + (* (/ (float (- (point) beg)) len) 100))) + (let ((ch (char-after (match-beginning 0)))) + (when (< ch 128) + (setq markup-list (aref vector ch)))) + (unless markup-list + (setq markup-list remaining)) + (let ((prev (point))) + ;; backtrack and figure out which rule matched + (goto-char (match-beginning 0)) + (catch 'done + (dolist (entry markup-list) + (let ((value (cond ((symbolp (car entry)) + (symbol-value (car entry))) + ((stringp (car entry)) + (car entry)) + (t nil)))) + (when (and (stringp value) (looking-at value)) + (goto-char (match-end 0)) + (when (cdr entry) + (funcall (cdr entry))) + (throw 'done t)))) + ;; if no rule matched, which should never happen, + ;; return to previous position so that forward + ;; progress is ensured + (goto-char prev)))) + (dolist (command muse-colors-delayed-commands) + (apply (car command) (cdr command))) + (run-hook-with-args 'muse-colors-buffer-hook + beg end verbose) + (if verbose (message "Highlighting buffer...done"))))) + (set-buffer-modified-p modified-p)))) + +(defcustom muse-colors-tags + '(("example" t nil nil muse-colors-example-tag) + ("code" t nil nil muse-colors-example-tag) + ("verbatim" t nil nil muse-colors-literal-tag) + ("lisp" t t nil muse-colors-lisp-tag) + ("literal" t nil nil muse-colors-literal-tag)) + "A list of tag specifications for specially highlighting text. +XML-style tags are the best way to add custom highlighting to Muse. +This is easily accomplished by customizing this list of markup tags. + +For each entry, the name of the tag is given, whether it expects +a closing tag and/or an optional set of attributes, whether it is +nestable, and a function that performs whatever action is desired +within the delimited region. + +The function is called with three arguments, the beginning and +end of the region surrounded by the tags. If properties are +allowed, they are passed as a third argument in the form of an +alist. The `end' argument to the function is the last character +of the enclosed tag or region. + +Functions should not modify the contents of the buffer." + :type '(repeat (list (string :tag "Markup tag") + (boolean :tag "Expect closing tag" :value t) + (boolean :tag "Parse attributes" :value nil) + (boolean :tag "Nestable" :value nil) + function)) + :group 'muse-colors) + +(defvar muse-colors-inhibit-tags-in-directives t + "If non-nil, don't allow tags to be interpreted in directives. +This is used to delay highlighting of <lisp> tags in #title until later.") +(make-variable-buffer-local 'muse-colors-inhibit-tags-in-directives) + +(defsubst muse-colors-tag-info (tagname &rest args) + "Get tag info associated with TAGNAME, ignoring ARGS." + (assoc tagname muse-colors-tags)) + +(defun muse-colors-custom-tags () + "Highlight `muse-colors-tags'." + (let ((tag-info (muse-colors-tag-info (match-string 1)))) + (unless (or (not tag-info) + (get-text-property (match-beginning 0) 'muse-comment) + (and muse-colors-inhibit-tags-in-directives + (get-text-property (match-beginning 0) 'muse-directive))) + (let ((closed-tag (match-string 3)) + (start (match-beginning 0)) + end attrs) + (when (nth 2 tag-info) + (let ((attrstr (match-string 2))) + (while (and attrstr + (string-match (concat "\\([^" + muse-regexp-blank + "=\n]+\\)\\(=\"" + "\\([^\"]+\\)\"\\)?") + attrstr)) + (let ((attr (cons (downcase + (muse-match-string-no-properties 1 attrstr)) + (muse-match-string-no-properties 3 attrstr)))) + (setq attrstr (replace-match "" t t attrstr)) + (if attrs + (nconc attrs (list attr)) + (setq attrs (list attr))))))) + (if (and (cadr tag-info) (not closed-tag)) + (if (muse-goto-tag-end (car tag-info) (nth 3 tag-info)) + (setq end (match-end 0)) + (setq tag-info nil))) + (when tag-info + (let ((args (list start end))) + (if (nth 2 tag-info) + (nconc args (list attrs))) + (apply (nth 4 tag-info) args))))))) + +(defun muse-unhighlight-region (begin end &optional verbose) + "Remove all visual highlights in the buffer (except font-lock)." + (let ((buffer-undo-list t) + (inhibit-read-only t) + (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t) + (modified-p (buffer-modified-p)) + deactivate-mark) + (unwind-protect + (remove-text-properties + begin end '(face nil font-lock-multiline nil end-glyph nil + invisible nil intangible nil display nil + mouse-face nil keymap nil help-echo nil + muse-link nil muse-directive nil muse-comment nil + muse-no-implicit-link nil muse-no-flyspell nil)) + (set-buffer-modified-p modified-p)))) + +(defun muse-colors-example-tag (beg end) + "Strip properties and colorize with `muse-verbatim'." + (muse-unhighlight-region beg end) + (let ((multi (save-excursion + (goto-char beg) + (forward-line 1) + (> end (point))))) + (add-text-properties beg end `(face muse-verbatim + font-lock-multiline ,multi)))) + +(defun muse-colors-literal-tag (beg end) + "Strip properties and mark as literal." + (muse-unhighlight-region beg end) + (let ((multi (save-excursion + (goto-char beg) + (forward-line 1) + (> end (point))))) + (add-text-properties beg end `(font-lock-multiline ,multi)))) + +(defun muse-colors-lisp-tag (beg end attrs) + "Color the region enclosed by a <lisp> tag." + (if (not muse-colors-evaluate-lisp-tags) + (muse-colors-literal-tag beg end) + (muse-unhighlight-region beg end) + (let (beg-lisp end-lisp) + (save-match-data + (goto-char beg) + (setq beg-lisp (and (looking-at "<[^>]+>") + (match-end 0))) + (goto-char end) + (setq end-lisp (and (muse-looking-back "</[^>]+>") + (match-beginning 0)))) + (add-text-properties + beg end + (list 'font-lock-multiline t + 'display (muse-eval-lisp + (concat + "(progn " + (buffer-substring-no-properties beg-lisp end-lisp) + ")")) + 'intangible t))))) + +(defvar muse-mode-local-map + (let ((map (make-sparse-keymap))) + (define-key map [return] 'muse-follow-name-at-point) + (define-key map [(control ?m)] 'muse-follow-name-at-point) + (define-key map [(shift return)] 'muse-follow-name-at-point-other-window) + (if (featurep 'xemacs) + (progn + (define-key map [(button2)] 'muse-follow-name-at-mouse) + (define-key map [(shift button2)] + 'muse-follow-name-at-mouse-other-window)) + (define-key map [(shift control ?m)] + 'muse-follow-name-at-point-other-window) + (define-key map [mouse-2] 'muse-follow-name-at-mouse) + (define-key map [(shift mouse-2)] + 'muse-follow-name-at-mouse-other-window) + (unless (eq emacs-major-version 21) + (set-keymap-parent map muse-mode-map))) + map) + "Local keymap used by Muse while on a link.") + +(defvar muse-keymap-property + (if (or (featurep 'xemacs) + (>= emacs-major-version 21)) + 'keymap + 'local-map) + "The name of the keymap or local-map property.") + +(defsubst muse-link-properties (help-str &optional face) + "Determine text properties to use for a link." + (append (if face + (list 'face face 'mouse-face 'highlight 'muse-link t) + (list 'invisible 'muse 'intangible t)) + (list 'help-echo help-str 'rear-nonsticky t + muse-keymap-property muse-mode-local-map))) + +(defun muse-link-face (link-name &optional explicit) + "Return the type of LINK-NAME as a face symbol. +For EXPLICIT links, this is either a normal link or a bad-link +face. For implicit links, it is either colored normally or +ignored." + (save-match-data + (let ((link (if explicit + (muse-handle-explicit-link link-name) + (muse-handle-implicit-link link-name)))) + (when link + (cond ((string-match muse-url-regexp link) + 'muse-link) + ((muse-file-remote-p link) + 'muse-link) + ((string-match muse-file-regexp link) + (when (string-match "/[^/]+#[^#./]+\\'" link) + ;; strip anchor from the end of a path + (setq link (substring link 0 (match-beginning 0)))) + (if (file-exists-p link) + 'muse-link + 'muse-bad-link)) + ((not (featurep 'muse-project)) + 'muse-link) + (t + (if (string-match "#" link) + (setq link (substring link 0 (match-beginning 0)))) + (if (or (and (muse-project-of-file) + (muse-project-page-file + link muse-current-project t)) + (file-exists-p link)) + 'muse-link + 'muse-bad-link))))))) + +(defun muse-colors-use-publishing-directory (link) + "Make LINK relative to the directory where we will publish the +current file." + (let ((style (car (muse-project-applicable-styles + link (cddr (muse-project))))) + path) + (when (and style + (setq path (muse-style-element :path style))) + (expand-file-name link path)))) + +(defun muse-colors-resolve-image-file (link) + "Determine if we can create images and see if the link is an image +file." + (save-match-data + (and (or (fboundp 'create-image) + (fboundp 'make-glyph)) + (not (string-match "\\`[uU][rR][lL]:" link)) + (string-match muse-image-regexp link)))) + +(defun muse-make-file-glyph (filename) + "Given a file name, return a newly-created image glyph. +This is a hack for supporting inline images in XEmacs." + (let ((case-fold-search nil)) + ;; Scan filename to determine image type + (when (fboundp 'make-glyph) + (save-match-data + (cond ((string-match "jpe?g" filename) + (make-glyph (vector 'jpeg :file filename) 'buffer)) + ((string-match "gif" filename) + (make-glyph (vector 'gif :file filename) 'buffer)) + ((string-match "png" filename) + (make-glyph (vector 'png :file filename) 'buffer))))))) + +(defun muse-colors-insert-image (link beg end invis-props) + "Create an image using create-image or make-glyph and insert it +in place of an image link defined by BEG and END." + (setq link (expand-file-name link)) + (let ((image-file (cond + ((eq muse-colors-inline-image-method 'default-directory) + link) + ((functionp muse-colors-inline-image-method) + (funcall muse-colors-inline-image-method link)))) + glyph) + (when (stringp image-file) + (if (fboundp 'create-image) + ;; use create-image and display property + (let ((display-stuff (condition-case nil + (create-image image-file) + (error nil)))) + (when display-stuff + (add-text-properties beg end (list 'display display-stuff)))) + ;; use make-glyph and invisible property + (and (setq glyph (muse-make-file-glyph image-file)) + (progn + (add-text-properties beg end invis-props) + (add-text-properties beg end (list + 'end-glyph glyph + 'help-echo link)))))))) + +(defun muse-colors-explicit-link () + "Color explicit links." + (when (and (eq ?\[ (char-after (match-beginning 0))) + (not (get-text-property (match-beginning 0) 'muse-comment)) + (not (get-text-property (match-beginning 0) 'muse-directive))) + ;; remove flyspell overlays + (when (fboundp 'flyspell-unhighlight-at) + (let ((cur (match-beginning 0))) + (while (> (match-end 0) cur) + (flyspell-unhighlight-at cur) + (setq cur (1+ cur))))) + (let* ((unesc-link (muse-get-link)) + (unesc-desc (muse-get-link-desc)) + (link (muse-link-unescape unesc-link)) + (desc (muse-link-unescape unesc-desc)) + (props (muse-link-properties desc (muse-link-face link t))) + (invis-props (append props (muse-link-properties desc)))) + ;; see if we should try and inline an image + (if (and muse-colors-inline-images + (or (muse-colors-resolve-image-file link) + (and desc + (muse-colors-resolve-image-file desc) + (setq link desc)))) + ;; we found an image, so inline it + (muse-colors-insert-image + link + (match-beginning 0) (match-end 0) invis-props) + (if desc + (progn + ;; we put the normal face properties on the invisible + ;; portion too, since emacs sometimes will position + ;; the cursor on an intangible character + (add-text-properties (match-beginning 0) + (match-beginning 2) invis-props) + (add-text-properties (match-beginning 2) (match-end 2) props) + (add-text-properties (match-end 2) (match-end 0) invis-props) + ;; in case specials were escaped, cause the unescaped + ;; text to be displayed + (unless (string= desc unesc-desc) + (add-text-properties (match-beginning 2) (match-end 2) + (list 'display desc)))) + (add-text-properties (match-beginning 0) + (match-beginning 1) invis-props) + (add-text-properties (match-beginning 1) (match-end 0) props) + (add-text-properties (match-end 1) (match-end 0) invis-props) + (unless (string= link unesc-link) + (add-text-properties (match-beginning 1) (match-end 1) + (list 'display link)))) + (goto-char (match-end 0)) + (add-text-properties + (match-beginning 0) (match-end 0) + (muse-link-properties (muse-match-string-no-properties 0) + (muse-link-face link t))))))) + +(defun muse-colors-implicit-link () + "Color implicit links." + (unless (or (eq (get-text-property (match-beginning 0) 'invisible) 'muse) + (get-text-property (match-beginning 0) 'muse-comment) + (get-text-property (match-beginning 0) 'muse-directive) + (get-text-property (match-beginning 0) 'muse-no-implicit-link) + (eq (char-before (match-beginning 0)) ?\") + (eq (char-after (match-end 0)) ?\")) + ;; remove flyspell overlays + (when (fboundp 'flyspell-unhighlight-at) + (let ((cur (match-beginning 0))) + (while (> (match-end 0) cur) + (flyspell-unhighlight-at cur) + (setq cur (1+ cur))))) + ;; colorize link + (let ((link (muse-match-string-no-properties 0)) + (face (muse-link-face (match-string 0)))) + (when face + (add-text-properties (match-beginning 0) (match-end 0) + (muse-link-properties + (muse-match-string-no-properties 0) face)))))) + +(defun muse-colors-title () + "Color #title directives." + (let ((beg (+ 7 (match-beginning 0)))) + (add-text-properties beg (muse-line-end-position) '(muse-directive t)) + ;; colorize <lisp> tags in #title after other <lisp> tags have had a + ;; chance to run, so that we can have behavior that is consistent + ;; with how the document is published + (setq muse-colors-delayed-commands + (cons (list 'muse-colors-title-lisp beg (muse-line-end-position)) + muse-colors-delayed-commands)))) + +(defun muse-colors-title-lisp (beg end) + "Called after other highlighting is done for a region in order to handle +<lisp> tags that exist in #title directives." + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let ((muse-colors-inhibit-tags-in-directives nil) + (muse-colors-tags '(("lisp" t t nil muse-colors-lisp-tag)))) + (while (re-search-forward muse-tag-regexp nil t) + (muse-colors-custom-tags)))) + (add-text-properties beg end '(face muse-header-1))) + +(defun muse-colors-comment () + "Color comments." + (add-text-properties (match-beginning 0) (muse-line-end-position) + (list 'face 'font-lock-comment-face + 'muse-comment t))) + + +(provide 'muse-colors) + +;;; muse-colors.el ends here diff --git a/emacs.d/elisp/muse/muse-context.el b/emacs.d/elisp/muse/muse-context.el new file mode 100644 index 0000000..45968b0 --- /dev/null +++ b/emacs.d/elisp/muse/muse-context.el @@ -0,0 +1,458 @@ +;;; muse-context.el --- publish entries in ConTeXt or PDF format + +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; Author: Jean Magnan de Bornier (jean@bornier.net) +;; Created: 16-Apr-2007 + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; This file when loaded allows you to publish .muse files as ConTeXt +;; files or as pdf files, using respectively the "context" and +;; "context-pdf" styles. It is far from being perfect, so any feedback +;; will be welcome and any mistake hopefully fixed. + +;;; Author: + +;; Jean Magnan de Bornier, who based this file on muse-latex.el and +;; made the context, context-pdf, context-slides, and +;; context-slides-pdf Muse publishing styles. + +;; 16 Avril 2007 + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse ConTeXt Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) + +(defgroup muse-context nil + "Rules for marking up a Muse file as a ConTeXt article." + :group 'muse-publish) + +(defcustom muse-context-extension ".tex" + "Default file extension for publishing ConTeXt files." + :type 'string + :group 'muse-context) + +(defcustom muse-context-pdf-extension ".pdf" + "Default file extension for publishing ConTeXt files to PDF." + :type 'string + :group 'muse-context) + +(defcustom muse-context-pdf-program "texexec --pdf" + "The program that is called to generate PDF content from ConTeXt content." + :type 'string + :group 'muse-context) + +(defcustom muse-context-pdf-cruft '(".pgf" ".tmp" ".tui" ".tuo" ".toc" ".log") + "Extensions of files to remove after generating PDF output successfully." + :type 'string + :group 'muse-context) + +(defcustom muse-context-header + "\\setupinteraction [state=start] +\\usemodule[tikz] +\\usemodule[bib]\n +<lisp>(muse-context-setup-bibliography)</lisp> + \\setuppublications[]\n +\\setuppublicationlist[]\n\\setupcite[]\n +\\starttext +\\startalignment[center] + \\blank[2*big] + {\\tfd <lisp>(muse-publishing-directive \"title\")</lisp>} + \\blank[3*medium] + {\\tfa <lisp>(muse-publishing-directive \"author\")</lisp>} + \\blank[2*medium] + {\\tfa <lisp>(muse-publishing-directive \"date\")</lisp>} + \\blank[3*medium] +\\stopalignment + +<lisp>(and muse-publish-generate-contents + (not muse-context-permit-contents-tag) + \"\\\\placecontent\n\\\\page[yes]\")</lisp>\n\n" + "Header used for publishing ConTeXt files. This may be text or a filename." + :type 'string + :group 'muse-context) + +(defcustom muse-context-footer "<lisp>(muse-context-bibliography)</lisp> +\\stoptext\n" + "Footer used for publishing ConTeXt files. This may be text or a filename." + :type 'string + :group 'muse-context) + +(defcustom muse-context-markup-regexps + `(;; numeric ranges + (10000 "\\([0-9]+\\)-\\([0-9]+\\)" 0 "\\1--\\2") + + ;; be careful of closing quote pairs + (10100 "\"'" 0 "\"\\\\-'")) + "List of markup regexps for identifying regions in a Muse page. +For more on the structure of this list, see `muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-context) + +(defcustom muse-context-markup-functions + '((table . muse-context-markup-table)) + "An alist of style types to custom functions for that kind of text. +For more on the structure of this list, see +`muse-publish-markup-functions'." + :type '(alist :key-type symbol :value-type function) + :group 'muse-context) + +(defcustom muse-context-markup-strings + '((image-with-desc . "\\placefigure[][]{%3%}{\\externalfigure[%1%.%2%]}") + (image . "\\placefigure[][]{}{\\externalfigure[%s.%s]}") + (image-link . "\\useURL[aa][%s][][%1%] \\from[aa]") + (anchor-ref . "\\goto{%2%}{}[%1%]") + (url . "\\useURL[aa][%s][][%s] \\from[aa]") + (url-and-desc . "\\useURL[bb][%s][][%s]\\from[bb]\\footnote{%1%}") + (link . "\\goto{%2%}[program(%1%)]\\footnote{%1%}") + (link-and-anchor . "\\useexternaldocument[%4%][%4%][] \\at{%3%, page}{}[%4%::%2%]\\footnote{%1%}") + (email-addr . "\\useURL[mail][mailto:%s][][%s]\\from[mail]") + (anchor . "\\reference[%s] ") + (emdash . "---") + (comment-begin . "\\doifmode{comment}{") + (comment-end . "}") + (rule . "\\blank[medium]\\hrule\\blank[medium]") + (no-break-space . "~") + (enddots . "\\ldots ") + (dots . "\\dots ") + (part . "\\part{") + (part-end . "}") + (chapter . "\\chapter{") + (chapter-end . "}") + (section . "\\section{") + (section-end . "}") + (subsection . "\\subsection{") + (subsection-end . "}") + (subsubsection . "\\subsubsection{") + (subsubsection-end . "}") + (section-other . "\\subsubsubject{") + (section-other-end . "}") + (footnote . "\\footnote{") + (footnote-end . "}") + (footnotetext . "\\footnotetext[%d]{") + (begin-underline . "\\underbar{") + (end-underline . "}") + (begin-literal . "\\type{") + (end-literal . "}") + (begin-emph . "{\\em ") + (end-emph . "}") + (begin-more-emph . "{\\bf ") + (end-more-emph . "}") + (begin-most-emph . "{\\bf {\\em ") + (end-most-emph . "}}") + (begin-example . "\\starttyping") + (end-example . "\\stoptyping") + (begin-center . "\\startalignment[center]\n") + (end-center . "\n\\stopalignment") + (begin-quote . "\\startquotation\n") + (end-quote . "\n\\stopquotation") + (begin-cite . "\\cite[authoryear][") + (begin-cite-author . "\\cite[author][") + (begin-cite-year . "\\cite[year][") + (end-cite . "]") + (begin-uli . "\\startitemize\n") + (end-uli . "\n\\stopitemize") + (begin-uli-item . "\\item ") + (begin-oli . "\\startitemize[n]\n") + (end-oli . "\n\\stopitemize") + (begin-oli-item . "\\item ") + (begin-dl . "\\startitemize\n") + (end-dl . "\n\\stopitemize") + (begin-ddt . "\\head ") + (end-ddt . "\n") + (begin-verse . "\\blank[big]") + (end-verse-line . "\\par") + (verse-space . "\\fixedspaces ~~") + (end-verse . "\\blank[big]")) + "Strings used for marking up text. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-context) + +(defcustom muse-context-slides-header + "\\usemodule[<lisp>(if (string-equal (muse-publishing-directive \"module\") nil) \"pre-01\" (muse-publishing-directive \"module\"))</lisp>] +\\usemodule[tikz] +\\usemodule[newmat] +\\setupinteraction [state=start] +\\starttext +\\TitlePage { <lisp>(muse-publishing-directive \"title\")</lisp> +\\blank[3*medium] +\\tfa <lisp>(muse-publishing-directive \"author\")</lisp> + \\blank[2*medium] + \\tfa <lisp>(muse-publishing-directive \"date\")</lisp>}" + "Header for publishing a presentation (slides) using ConTeXt. +Any of the predefined modules, which are available in the +tex/context/base directory, can be used by writing a \"module\" +directive at the top of the muse file; if no such directive is +provided, module pre-01 is used. Alternatively, you can use your +own style (\"mystyle\", in this example) by replacing +\"\\usemodule[]\" with \"\\input mystyle\". + +This may be text or a filename." + :type 'string + :group 'muse-context) + +(defcustom muse-context-slides-markup-strings + '((section . "\\Topic {") + (subsection . "\\page \n{\\bf ") + (subsubsection . "{\\em ")) + "Strings used for marking up text in ConTeXt slides." + :type '(alist :key-type symbol :value-type string) + :group 'muse-context) + +(defcustom muse-context-markup-specials-document + '((?\\ . "\\textbackslash{}") + (?\_ . "\\textunderscore{}") + (?\< . "\\switchtobodyfont[small]") + (?\> . "\\switchtobodyfont[big]") + (?^ . "\\^") + (?\~ . "\\~") + (?\@ . "\\@") + (?\$ . "\\$") + (?\% . "\\%") + (?\{ . "\\{") + (?\} . "\\}") + (?\& . "\\&") + (?\# . "\\#")) + "A table of characters which must be represented specially. +These are applied to the entire document, sans already-escaped +regions." + :type '(alist :key-type character :value-type string) + :group 'muse-context) + +(defcustom muse-context-markup-specials-example + '() + "A table of characters which must be represented specially. +These are applied to <example> regions. + +With the default interpretation of <example> regions, no specials +need to be escaped." + :type '(alist :key-type character :value-type string) + :group 'muse-context) + +(defcustom muse-context-markup-specials-literal + '() + "A table of characters which must be represented specially. +This applies to =monospaced text= and <code> regions." + :type '(alist :key-type character :value-type string) + :group 'muse-context) + +(defcustom muse-context-markup-specials-url + '((?\\ . "\\textbackslash") + (?\_ . "\\_") + (?\< . "\\<") + (?\> . "\\>") + (?\$ . "\\$") + (?\% . "\\%") + (?\{ . "\\{") + (?\} . "\\}") + (?\& . "\\&") + (?\# . "\\#")) + "A table of characters which must be represented specially. +These are applied to URLs." + :type '(alist :key-type character :value-type string) + :group 'muse-context) + +(defcustom muse-context-markup-specials-image + '((?\\ . "\\textbackslash") ; cannot find suitable replacement + (?\< . "\\<") + (?\> . "\\>") + (?\$ . "\\$") + (?\% . "\\%") + (?\{ . "\\{") + (?\} . "\\}") + (?\& . "\\&") + (?\# . "\\#") ; cannot find suitable replacement + ) + "A table of characters which must be represented specially. +These are applied to image filenames." + :type '(alist :key-type character :value-type string) + :group 'muse-context) + +(defun muse-context-decide-specials (context) + "Determine the specials to escape, depending on the CONTEXT argument." + (cond ((memq context '(underline emphasis document url-desc verbatim + footnote)) + muse-context-markup-specials-document) + ((eq context 'image) + muse-context-markup-specials-image) + ((memq context '(email url)) + muse-context-markup-specials-url) + ((eq context 'literal) + muse-context-markup-specials-literal) + ((eq context 'example) + muse-context-markup-specials-example) + (t (error "Invalid context argument '%s' in muse-context" context)))) + +(defun muse-context-markup-table () + (let* ((table-info (muse-publish-table-fields (match-beginning 0) + (match-end 0))) + (row-len (car table-info)) + (field-list (cdr table-info))) + (when table-info + (muse-insert-markup "\\starttable[|" + (mapconcat 'symbol-name (make-vector row-len 'l) + "|") "|]\n \\HL\n \\VL ") + (dolist (fields field-list) + (let ((type (car fields))) + (setq fields (cdr fields)) + (when (= type 3) + (muse-insert-markup "")) + (insert (car fields)) + (setq fields (cdr fields)) + (dolist (field fields) + (muse-insert-markup " \\VL ") + (insert field)) + (muse-insert-markup "\\VL\\NR\n \\HL\n \\VL ") + (when (= type 2) + (muse-insert-markup " ")))) + (muse-insert-markup "\\stoptable\n") + (while (search-backward "VL \\stoptable" nil t) + (replace-match "stoptable" nil t))))) + +(defun muse-context-fixup-dquotes () + "Fixup double quotes." + (goto-char (point-min)) + (let ((open t)) + (while (search-forward "\"" nil t) + (unless (get-text-property (match-beginning 0) 'read-only) + (when (or (bobp) + (eq (char-before) ?\n)) + (setq open t)) + (if open + (progn + (replace-match "``") + (setq open nil)) + (replace-match "''") + (setq open t)))))) + +(defcustom muse-context-permit-contents-tag nil + "If nil, ignore <contents> tags. Otherwise, insert table of contents. + +Most of the time, it is best to have a table of contents on the +first page, with a new page immediately following. To make this +work with documents published in both HTML and ConTeXt, we need to +ignore the <contents> tag. + +If you don't agree with this, then set this option to non-nil, +and it will do what you expect." + :type 'boolean + :group 'muse-context) + +(defun muse-context-fixup-citations () + "Replace semicolons in multi-head citations with colons." + (goto-char (point-min)) + (while (re-search-forward "\\\\cite.?\\[" nil t) + (let ((start (point)) + (end (re-search-forward "]"))) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward ";" nil t) + (replace-match ",")))))) + +(defun muse-context-munge-buffer () + (muse-context-fixup-dquotes) + (muse-context-fixup-citations) + (when (and muse-context-permit-contents-tag + muse-publish-generate-contents) + (goto-char (car muse-publish-generate-contents)) + (muse-insert-markup "\\placecontent"))) + +(defun muse-context-bibliography () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "\\\\cite.?\\[" nil t) + "\\completepublications[criterium=all]" + ""))) + +(defun muse-context-setup-bibliography () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "\\\\cite.?\\[" nil t) + (concat + "\\usemodule[bibltx]\n\\setupbibtex [database=" + (muse-publishing-directive "bibsource") "]") + ""))) + +(defun muse-context-pdf-browse-file (file) + (shell-command (concat "open " file))) + +(defun muse-context-pdf-generate (file output-path final-target) + (apply + #'muse-publish-transform-output + file output-path final-target "PDF" + (function + (lambda (file output-path) + (let* ((fnd (file-name-directory output-path)) + (command (format "%s \"%s\"" + muse-context-pdf-program + (file-relative-name file fnd))) + (times 0) + (default-directory fnd) + result) + ;; XEmacs can sometimes return a non-number result. We'll err + ;; on the side of caution by continuing to attempt to generate + ;; the PDF if this happens and treat the final result as + ;; successful. + (while (and (< times 2) + (or (not (numberp result)) + (not (eq result 0)) + ;; table of contents takes 2 passes +;; (file-readable-p +;; (muse-replace-regexp-in-string +;; "\\.tex\\'" ".toc" file t t)) + )) + (setq result (shell-command command) + times (1+ times))) + (if (or (not (numberp result)) + (eq result 0)) + t + nil)))) + muse-context-pdf-cruft)) + +(muse-define-style "context" + :suffix 'muse-context-extension + :regexps 'muse-context-markup-regexps + :functions 'muse-context-markup-functions + :strings 'muse-context-markup-strings + :specials 'muse-context-decide-specials + :after 'muse-context-munge-buffer + :header 'muse-context-header + :footer 'muse-context-footer + :browser 'find-file) + +(muse-derive-style "context-pdf" "context" + :final 'muse-context-pdf-generate + :browser 'muse-context-pdf-browse-file + :link-suffix 'muse-context-pdf-extension + :osuffix 'muse-context-pdf-extension) + +(muse-derive-style "context-slides" "context" + :header 'muse-context-slides-header + :strings 'muse-context-slides-markup-strings) + +(muse-derive-style "context-slides-pdf" "context-pdf" + :header 'muse-context-slides-header + :strings 'muse-context-slides-markup-strings) + +(provide 'muse-context) + +;;; muse-context.el ends here diff --git a/emacs.d/elisp/muse/muse-docbook.el b/emacs.d/elisp/muse/muse-docbook.el new file mode 100644 index 0000000..a54089f --- /dev/null +++ b/emacs.d/elisp/muse/muse-docbook.el @@ -0,0 +1,352 @@ +;;; muse-docbook.el --- publish DocBook files + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;; Dale P. Smith (dpsm AT en DOT com) improved the markup +;; significantly and made many valuable suggestions. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse DocBook XML Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) +(require 'muse-regexps) +(require 'muse-xml-common) + +(defgroup muse-docbook nil + "Options controlling the behavior of Muse DocBook XML publishing. +See `muse-docbook' for more information." + :group 'muse-publish) + +(defcustom muse-docbook-extension ".xml" + "Default file extension for publishing DocBook XML files." + :type 'string + :group 'muse-docbook) + +(defcustom muse-docbook-header + "<?xml version=\"1.0\" encoding=\"<lisp> + (muse-docbook-encoding)</lisp>\"?> +<!DOCTYPE article PUBLIC \"-//OASIS//DTD DocBook V4.2//EN\" + \"http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd\"<lisp>(muse-docbook-entities)</lisp>> +<article> + <articleinfo> + <title><lisp>(muse-publishing-directive \"title\")</lisp></title> + <author><lisp>(muse-docbook-get-author + (muse-publishing-directive \"author\"))</lisp></author> + <pubdate><lisp>(muse-publishing-directive \"date\")</lisp></pubdate> + </articleinfo> + <!-- Page published by Emacs Muse begins here -->\n" + "Header used for publishing DocBook XML files. +This may be text or a filename." + :type 'string + :group 'muse-docbook) + +(defcustom muse-docbook-footer " + <!-- Page published by Emacs Muse ends here --> +<lisp>(muse-docbook-bibliography)</lisp></article>\n" + "Footer used for publishing DocBook XML files. +This may be text or a filename." + :type 'string + :group 'muse-docbook) + +(defcustom muse-docbook-markup-regexps + `(;; Beginning of doc, end of doc, or plain paragraph separator + (10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*" + "\\([" muse-regexp-blank "]*\n\\)\\)" + "\\|\\`\\s-*\\|\\s-*\\'\\)") + 3 muse-docbook-markup-paragraph)) + "List of markup rules for publishing a Muse page to DocBook XML. +For more on the structure of this list, see `muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-docbook) + +(defcustom muse-docbook-markup-functions + '((anchor . muse-xml-markup-anchor) + (table . muse-xml-markup-table)) + "An alist of style types to custom functions for that kind of text. +For more on the structure of this list, see +`muse-publish-markup-functions'." + :type '(alist :key-type symbol :value-type function) + :group 'muse-docbook) + +(defcustom muse-docbook-markup-strings + '((image-with-desc . "<mediaobject> +<imageobject> +<imagedata fileref=\"%1%.%2%\" format=\"%2%\" /> +</imageobject> +<caption><para>%3%</para></caption> +</mediaobject>") + (image . "<inlinemediaobject><imageobject> +<imagedata fileref=\"%1%.%2%\" format=\"%2%\" /> +</imageobject></inlinemediaobject>") + (image-link . "<ulink url=\"%1%\"><inlinemediaobject><imageobject> +<imagedata fileref=\"%2%.%3%\" format=\"%3%\" /> +</imageobject></inlinemediaobject></ulink>") + (anchor-ref . "<link linkend=\"%s\">%s</link>") + (url . "<ulink url=\"%s\">%s</ulink>") + (link . "<ulink url=\"%s\">%s</ulink>") + (link-and-anchor . "<ulink url=\"%s#%s\">%s</ulink>") + (email-addr . "<email>%s</email>") + (anchor . "<anchor id=\"%s\" />\n") + (emdash . "%s—%s") + (comment-begin . "<!-- ") + (comment-end . " -->") + (rule . "") + (no-break-space . " ") + (enddots . "....") + (dots . "...") + (section . "<section><title>") + (section-end . "</title>") + (subsection . "<section><title>") + (subsection-end . "</title>") + (subsubsection . "<section><title>") + (subsubsection-end . "</title>") + (section-other . "<section><title>") + (section-other-end . "</title>") + (section-close . "</section>") + (footnote . "<footnote><para>") + (footnote-end . "</para></footnote>") + (begin-underline . "") + (end-underline . "") + (begin-literal . "<systemitem>") + (end-literal . "</systemitem>") + (begin-emph . "<emphasis>") + (end-emph . "</emphasis>") + (begin-more-emph . "<emphasis role=\"strong\">") + (end-more-emph . "</emphasis>") + (begin-most-emph . "<emphasis role=\"strong\"><emphasis>") + (end-most-emph . "</emphasis></emphasis>") + (begin-verse . "<literallayout>\n") + (verse-space . " ") + (end-verse . "</literallayout>") + (begin-example . "<programlisting>") + (end-example . "</programlisting>") + (begin-center . "<para role=\"centered\">\n") + (end-center . "\n</para>") + (begin-quote . "<blockquote>\n") + (end-quote . "\n</blockquote>") + (begin-cite . "<citation role=\"%s\">") + (begin-cite-author . "<citation role=\"%s\">A:") + (begin-cite-year . "<citation role=\"%s\">Y:") + (end-cite . "</citation>") + (begin-quote-item . "<para>") + (end-quote-item . "</para>") + (begin-uli . "<itemizedlist mark=\"bullet\">\n") + (end-uli . "\n</itemizedlist>") + (begin-uli-item . "<listitem><para>") + (end-uli-item . "</para></listitem>") + (begin-oli . "<orderedlist>\n") + (end-oli . "\n</orderedlist>") + (begin-oli-item . "<listitem><para>") + (end-oli-item . "</para></listitem>") + (begin-dl . "<variablelist>\n") + (end-dl . "\n</variablelist>") + (begin-dl-item . "<varlistentry>\n") + (end-dl-item . "\n</varlistentry>") + (begin-ddt . "<term>") + (end-ddt . "</term>") + (begin-dde . "<listitem><para>") + (end-dde . "</para></listitem>") + (begin-table . "<informaltable>\n") + (end-table . "</informaltable>") + (begin-table-group . " <tgroup cols='%s'>\n") + (end-table-group . " </tgroup>\n") + (begin-table-row . " <row>\n") + (end-table-row . " </row>\n") + (begin-table-entry . " <entry>") + (end-table-entry . "</entry>\n")) + "Strings used for marking up text. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-docbook) + +(defcustom muse-docbook-encoding-default 'utf-8 + "The default Emacs buffer encoding to use in published files. +This will be used if no special characters are found." + :type 'symbol + :group 'muse-docbook) + +(defcustom muse-docbook-charset-default "utf-8" + "The default DocBook XML charset to use if no translation is +found in `muse-docbook-encoding-map'." + :type 'string + :group 'muse-docbook) + +(defun muse-docbook-encoding () + (muse-xml-transform-content-type + (or (and (boundp 'buffer-file-coding-system) + buffer-file-coding-system) + muse-docbook-encoding-default) + muse-docbook-charset-default)) + +(defun muse-docbook-markup-paragraph () + (catch 'bail-out + (let ((end (copy-marker (match-end 0) t))) + (goto-char (match-beginning 0)) + (when (save-excursion + (save-match-data + (and (not (get-text-property (max (point-min) (1- (point))) + 'muse-no-paragraph)) + (re-search-backward + "<\\(/?\\)\\(para\\|footnote\\|literallayout\\)[ >]" + nil t) + (cond ((string= (match-string 2) "literallayout") + (and (not (string= (match-string 1) "/")) + (throw 'bail-out t))) + ((string= (match-string 2) "para") + (and + (not (string= (match-string 1) "/")) + ;; don't mess up nested lists + (not (and (muse-looking-back "<listitem>") + (throw 'bail-out t))))) + ((string= (match-string 2) "footnote") + (string= (match-string 1) "/")) + (t nil))))) + (when (get-text-property (1- (point)) 'muse-end-list) + (goto-char (previous-single-property-change (1- (point)) + 'muse-end-list))) + (muse-insert-markup "</para>")) + (goto-char end)) + (cond + ((eobp) + (unless (bolp) + (insert "\n"))) + ((get-text-property (point) 'muse-no-paragraph) + (forward-char 1) + nil) + ((eq (char-after) ?\<) + (when (looking-at (concat "<\\(emphasis\\|systemitem\\|inlinemediaobject" + "\\|u?link\\|anchor\\|email\\)[ >]")) + (muse-insert-markup "<para>"))) + (t + (muse-insert-markup "<para>"))))) + +(defun muse-docbook-get-author (&optional author) + "Split the AUTHOR directive into separate fields. +AUTHOR should be of the form: \"Firstname Other Names Lastname\", +and anything after `Firstname' is optional." + (setq author (save-match-data (split-string author))) + (let ((num-el (length author))) + (cond ((eq num-el 1) + (concat "<firstname>" (car author) "</firstname>")) + ((eq num-el 2) + (concat "<firstname>" (nth 0 author) "</firstname>" + "<surname>" (nth 1 author) "</surname>")) + ((eq num-el 3) + (concat "<firstname>" (nth 0 author) "</firstname>" + "<othername>" (nth 1 author) "</othername>" + "<surname>" (nth 2 author) "</surname>")) + (t + (let (first last) + (setq first (car author)) + (setq author (nreverse (cdr author))) + (setq last (car author)) + (setq author (nreverse (cdr author))) + (concat "<firstname>" first "</firstname>" + "<othername>" + (mapconcat 'identity author " ") + "</othername>" + "<surname>" last "</surname>")))))) + +(defun muse-docbook-fixup-images () + (goto-char (point-min)) + (while (re-search-forward (concat "<imagedata fileref=\"[^\"]+\"" + " format=\"\\([^\"]+\\)\" />$") + nil t) + (replace-match (upcase (match-string 1)) t t nil 1))) + +(defun muse-docbook-fixup-citations () + ;; remove the role attribute if there is no role + (goto-char (point-min)) + (while (re-search-forward "<\\(citation role=\"nil\"\\)>" nil t) + (replace-match "citation" t t nil 1)) + ;; replace colons in multi-head citations with semicolons + (goto-char (point-min)) + (while (re-search-forward "<citation.*>" nil t) + (let ((start (point)) + (end (re-search-forward "</citation>"))) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "," nil t) + (replace-match ";")))))) + +(defun muse-docbook-munge-buffer () + (muse-docbook-fixup-images) + (muse-docbook-fixup-citations)) + +(defun muse-docbook-entities () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "<citation" nil t) + (concat + " [\n<!ENTITY bibliography SYSTEM \"" + (if (string-match ".short$" (muse-page-name)) + (substring (muse-page-name) 0 -6) + (muse-page-name)) + ".bib.xml\">\n]") + ""))) + +(defun muse-docbook-bibliography () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "<citation" nil t) + "&bibliography;\n" + ""))) + +(defun muse-docbook-finalize-buffer () + (when (boundp 'buffer-file-coding-system) + (when (memq buffer-file-coding-system '(no-conversion undecided-unix)) + ;; make it agree with the default charset + (setq buffer-file-coding-system muse-docbook-encoding-default)))) + +;;; Register the Muse DocBook XML Publisher + +(muse-define-style "docbook" + :suffix 'muse-docbook-extension + :regexps 'muse-docbook-markup-regexps + :functions 'muse-docbook-markup-functions + :strings 'muse-docbook-markup-strings + :specials 'muse-xml-decide-specials + :before-end 'muse-docbook-munge-buffer + :after 'muse-docbook-finalize-buffer + :header 'muse-docbook-header + :footer 'muse-docbook-footer + :browser 'find-file) + +(provide 'muse-docbook) + +;;; muse-docbook.el ends here diff --git a/emacs.d/elisp/muse/muse-groff.el b/emacs.d/elisp/muse/muse-groff.el new file mode 100644 index 0000000..7218652 --- /dev/null +++ b/emacs.d/elisp/muse/muse-groff.el @@ -0,0 +1,274 @@ +;;; muse-groff.el --- publish groff -mom -mwww files + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Andrew J. Korty (ajk AT iu DOT edu) +;; Date: Tue 5-Jul-2005 + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Publishing Using groff -mom -mwww +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) + +(defgroup muse-groff nil + "Rules for marking up a Muse file with groff -mom -mwww macros." + :group 'muse-publish) + +(defcustom muse-groff-extension ".groff" + "Default file extension for publishing groff -mom -mwww files." + :type 'string + :group 'muse-groff) + +(defcustom muse-groff-pdf-extension ".pdf" + "Default file extension for publishing groff -mom -mwww files to PDF." + :type 'string + :group 'muse-groff) + +(defcustom muse-groff-header + ".TITLE \"<lisp>(muse-publishing-directive \"title\")</lisp>\" +.SUBTITLE \"<lisp>(muse-publishing-directive \"date\")</lisp>\" +.AUTHOR \"<lisp>(muse-publishing-directive \"author\")</lisp>\" +.PRINTSTYLE TYPESET +.de list +. LIST \\$1 +. SHIFT_LIST \\$2 +.. +.PARA_INDENT 0 +.START +<lisp>(and muse-publish-generate-contents \".TOC\n\")</lisp>\n" + "Header used for publishing groff -mom -mwww files." + :type '(choice string file) + :group 'muse-groff) + +(defcustom muse-groff-footer " " + "Footer used for publishing groff -mom -mwww files." + :type '(choice string file) + :group 'muse-groff) + +(defcustom muse-groff-markup-regexps + `((10400 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?\n" + "\\([" + muse-regexp-blank + "]*\n\\)+\\(<\\(blockquote\\|center\\)>\n\\)?") + 0 muse-groff-markup-paragraph)) +"List of markup regexps for identifying regions in a Muse page. +For more on the structure of this list, see `muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-groff) + +(defcustom muse-groff-markup-functions + '((table . muse-groff-markup-table)) + "An alist of style types to custom functions for that kind of text. +For more on the structure of this list, see +`muse-publish-markup-functions'." + :type '(alist :key-type symbol :value-type function) + :group 'muse-groff) + +(defcustom muse-groff-markup-tags + '() + "A list of tag specifications, for specially marking up GROFF." + :type '(repeat (list (string :tag "Markup tag") + (boolean :tag "Expect closing tag" :value t) + (boolean :tag "Parse attributes" :value nil) + (boolean :tag "Nestable" :value nil) + function)) + :group 'muse-groff) + +(defcustom muse-groff-markup-strings + `((image-with-desc . "\n.MPIMG -R %s.%s\n") + (image . "\n.MPIMG -R %s.%s\n") + (image-link . "\n.\\\" %s\n.MPIMG -R %s.%s") + (url . "\n.URL %s %s\n\\z") + (link . "\n.URL %s %s\n\\z") + (email-addr . "\f[C]%s\f[]") + (emdash . "\\(em") + (rule . "\n.RULE\n") + (no-break-space . "\\h") + (line-break . "\\p") + (enddots . "....") + (dots . "...") +;; (part . "\\part{") +;; (part-end . "}") +;; (chapter . "\\chapter{") +;; (chapter-end . "}") + (section . ".HEAD \"") + (section-end . "\"") + (subsection . ".SUBHEAD \"") + (subsection-end . "\"") + (subsubsection . ".PARAHEAD \"") + (subsubsection-end . "\"") +;; (footnote . "\\c\n.FOOTNOTE\n") +;; (footnote-end . "\n.FOOTNOTE OFF\n") +;; (footnotemark . "\\footnotemark[%d]") +;; (footnotetext . "\\footnotetext[%d]{") +;; (footnotetext-end . "}") + (begin-underline . "\n.UNDERSCORE \"") + (end-underline . "\"\n") + (begin-literal . "\\fC") + (end-literal . "\\fP") + (begin-emph . "\\fI") + (end-emph . "\\fP") + (begin-more-emph . "\\fB") + (end-more-emph . "\\fP") + (begin-most-emph . "\\f(BI") + (end-most-emph . "\\fP") + (begin-verse . ".QUOTE") + (end-verse . ".QUOTE OFF") + (begin-center . "\n.CENTER\n") + (end-center . "\n.QUAD L\n") + (begin-example . ,(concat + ".QUOTE_FONT CR\n.QUOTE_INDENT 1\n"".QUOTE_SIZE -2\n" + ".UNDERLINE_QUOTES OFF\n.QUOTE")) + (end-example . ".QUOTE OFF") + (begin-quote . ".BLOCKQUOTE") + (end-quote . ".BLOCKQUOTE OFF") + (begin-cite . "") + (begin-cite-author . "") + (begin-cite-year . "") + (end-cite . "") + (begin-uli . ".list BULLET\n.SHIFT_LIST 2m\n.ITEM\n") + (end-uli . "\n.LIST OFF") + (begin-oli . ".list DIGIT\n.SHIFT_LIST 2m\n.ITEM\n") + (end-oli . "\n.LIST OFF") + (begin-ddt . "\\fB") + (begin-dde . "\\fP\n.IR 4P\n") + (end-ddt . ".IRX CLEAR")) + "Strings used for marking up text. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-groff) + +(defcustom muse-groff-markup-specials + '((?\\ . "\\e")) + "A table of characters which must be represented specially." + :type '(alist :key-type character :value-type string) + :group 'muse-groff) + +(defun muse-groff-markup-paragraph () + (let ((end (copy-marker (match-end 0) t))) + (goto-char (1+ (match-beginning 0))) + (delete-region (point) end) + (unless (looking-at "\.\\(\\(\\(SUB\\|PARA\\)?HEAD \\)\\|RULE$\\)") + (muse-insert-markup ".ALD .5v\n.PP\n.ne 2\n")))) + +(defun muse-groff-protect-leading-chars () + "Protect leading periods and apostrophes from being interpreted as +command characters." + (while (re-search-forward "^[.']" nil t) + (replace-match "\\\\&\\&" t))) + +(defun muse-groff-concat-lists () + "Join like lists." + (let ((type "") + arg begin) + (while (re-search-forward "^\.LIST[ \t]+\\(.*\\)\n" nil t) + (setq arg (match-string 1)) + (if (string= arg "OFF") + (setq begin (match-beginning 0)) + (if (and begin (string= type arg)) + (delete-region begin (match-end 0)) + (setq type arg + begin 0)))))) + +(defun muse-groff-fixup-dquotes () + "Fixup double quotes." + (let ((open t)) + (while (search-forward "\"" nil t) + (unless (get-text-property (match-beginning 0) 'read-only) + (if (and (bolp) (eq (char-before) ?\n)) + (setq open t)) + (if open + (progn + (replace-match "``") + (setq open nil)) + (replace-match "''") + (setq open t)))))) + +(defun muse-groff-prepare-buffer () + (goto-char (point-min)) + (muse-groff-protect-leading-chars)) + +(defun muse-groff-munge-buffer () + (goto-char (point-min)) + (muse-groff-concat-lists)) + +(defun muse-groff-pdf-browse-file (file) + (shell-command (concat "open " file))) + +(defun muse-groff-pdf-generate (file output-path final-target) + (muse-publish-transform-output + file output-path final-target "PDF" + (function + (lambda (file output-path) + (let ((command + (format + (concat "file=%s; ext=%s; cd %s && cp $file$ext $file.ref && " + "groff -mom -mwww -t $file$ext > $file.ps && " + "pstopdf $file.ps") + (file-name-sans-extension file) + muse-groff-extension + (file-name-directory output-path)))) + (shell-command command)))) + ".ps")) + +;;; Register the Muse GROFF Publisher + +(muse-define-style "groff" + :suffix 'muse-groff-extension + :regexps 'muse-groff-markup-regexps +;;; :functions 'muse-groff-markup-functions + :strings 'muse-groff-markup-strings + :tags 'muse-groff-markup-tags + :specials 'muse-groff-markup-specials + :before 'muse-groff-prepare-buffer + :before-end 'muse-groff-munge-buffer + :header 'muse-groff-header + :footer 'muse-groff-footer + :browser 'find-file) + +(muse-derive-style "groff-pdf" "groff" + :final 'muse-groff-pdf-generate + :browser 'muse-groff-pdf-browse-file + :osuffix 'muse-groff-pdf-extension) + +(provide 'muse-groff) + +;;; muse-groff.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/emacs.d/elisp/muse/muse-html.el b/emacs.d/elisp/muse/muse-html.el new file mode 100644 index 0000000..6a9356b --- /dev/null +++ b/emacs.d/elisp/muse/muse-html.el @@ -0,0 +1,754 @@ +;;; muse-html.el --- publish to HTML and XHTML + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;; Zhiqiang Ye (yezq AT mail DOT cbi DOT pku DOT edu DOT cn) suggested +;; appending an 'encoding="..."' fragment to the first line of the +;; sample publishing header so that when editing the resulting XHTML +;; file, Emacs would use the proper encoding. + +;; Sun Jiyang (sunyijiang AT gmail DOT com) came up with the idea for +;; the <src> tag and provided an implementation for emacs-wiki. + +;; Charles Wang (wcy123 AT gmail DOT com) provided an initial +;; implementation of the <src> tag for Muse. + +;; Clinton Ebadi (clinton AT unknownlamer DOT org) provided further +;; ideas for the implementation of the <src> tag. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse HTML Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) +(require 'muse-regexps) +(require 'muse-xml-common) + +(defgroup muse-html nil + "Options controlling the behavior of Muse HTML publishing." + :group 'muse-publish) + +(defcustom muse-html-extension ".html" + "Default file extension for publishing HTML files." + :type 'string + :group 'muse-html) + +(defcustom muse-xhtml-extension ".html" + "Default file extension for publishing XHTML files." + :type 'string + :group 'muse-html) + +(defcustom muse-html-style-sheet + "<style type=\"text/css\"> +body { + background: white; color: black; + margin-left: 3%; margin-right: 7%; +} + +p { margin-top: 1% } +p.verse { margin-left: 3% } + +.example { margin-left: 3% } + +h2 { + margin-top: 25px; + margin-bottom: 0px; +} +h3 { margin-bottom: 0px; } + </style>" + "Store your stylesheet definitions here. +This is used in `muse-html-header'. +You can put raw CSS in here or a <link> tag to an external stylesheet. +This text may contain <lisp> markup tags. + +An example of using <link> is as follows. + +<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\">" + :type 'string + :group 'muse-html) + +(defcustom muse-xhtml-style-sheet + "<style type=\"text/css\"> +body { + background: white; color: black; + margin-left: 3%; margin-right: 7%; +} + +p { margin-top: 1% } +p.verse { margin-left: 3% } + +.example { margin-left: 3% } + +h2 { + margin-top: 25px; + margin-bottom: 0px; +} +h3 { margin-bottom: 0px; } + </style>" + "Store your stylesheet definitions here. +This is used in `muse-xhtml-header'. +You can put raw CSS in here or a <link> tag to an external stylesheet. +This text may contain <lisp> markup tags. + +An example of using <link> is as follows. + +<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\" />" + :type 'string + :group 'muse-html) + +(defcustom muse-html-header + "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"> +<html> + <head> + <title><lisp> + (concat (muse-publishing-directive \"title\") + (let ((author (muse-publishing-directive \"author\"))) + (if (not (string= author (user-full-name))) + (concat \" (by \" author \")\"))))</lisp></title> + <meta name=\"generator\" content=\"muse.el\"> + <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\" + content=\"<lisp>muse-html-meta-content-type</lisp>\"> + <lisp> + (let ((maintainer (muse-style-element :maintainer))) + (when maintainer + (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\">\"))) + </lisp><lisp> + (muse-style-element :style-sheet muse-publishing-current-style) + </lisp> + </head> + <body> + <h1><lisp> + (concat (muse-publishing-directive \"title\") + (let ((author (muse-publishing-directive \"author\"))) + (if (not (string= author (user-full-name))) + (concat \" (by \" author \")\"))))</lisp></h1> + <!-- Page published by Emacs Muse begins here -->\n" + "Header used for publishing HTML files. This may be text or a filename." + :type 'string + :group 'muse-html) + +(defcustom muse-html-footer " +<!-- Page published by Emacs Muse ends here --> + </body> +</html>\n" + "Footer used for publishing HTML files. This may be text or a filename." + :type 'string + :group 'muse-html) + +(defcustom muse-xhtml-header + "<?xml version=\"1.0\" encoding=\"<lisp> + (muse-html-encoding)</lisp>\"?> +<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" + \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> +<html xmlns=\"http://www.w3.org/1999/xhtml\"> + <head> + <title><lisp> + (concat (muse-publishing-directive \"title\") + (let ((author (muse-publishing-directive \"author\"))) + (if (not (string= author (user-full-name))) + (concat \" (by \" author \")\"))))</lisp></title> + <meta name=\"generator\" content=\"muse.el\" /> + <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\" + content=\"<lisp>muse-html-meta-content-type</lisp>\" /> + <lisp> + (let ((maintainer (muse-style-element :maintainer))) + (when maintainer + (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\" />\"))) + </lisp><lisp> + (muse-style-element :style-sheet muse-publishing-current-style) + </lisp> + </head> + <body> + <h1><lisp> + (concat (muse-publishing-directive \"title\") + (let ((author (muse-publishing-directive \"author\"))) + (if (not (string= author (user-full-name))) + (concat \" (by \" author \")\"))))</lisp></h1> + <!-- Page published by Emacs Muse begins here -->\n" + "Header used for publishing XHTML files. This may be text or a filename." + :type 'string + :group 'muse-html) + +(defcustom muse-xhtml-footer " +<!-- Page published by Emacs Muse ends here --> + </body> +</html>\n" + "Footer used for publishing XHTML files. This may be text or a filename." + :type 'string + :group 'muse-html) + +(defcustom muse-html-anchor-on-word nil + "When true, anchors surround the closest word. This allows you +to select them in a browser (i.e. for pasting), but has the +side-effect of marking up headers in multiple colors if your +header style is different from your link style." + :type 'boolean + :group 'muse-html) + +(defcustom muse-html-table-attributes + " class=\"muse-table\" border=\"2\" cellpadding=\"5\"" + "The attribute to be used with HTML <table> tags. +Note that Muse supports insertion of raw HTML tags, as long +as you wrap the region in <literal></literal>." + :type 'string + :group 'muse-html) + +(defcustom muse-html-markup-regexps + `(;; Beginning of doc, end of doc, or plain paragraph separator + (10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*" + "\\([" muse-regexp-blank "]*\n\\)\\)" + "\\|\\`\\s-*\\|\\s-*\\'\\)") + ;; this is somewhat repetitive because we only require the + ;; line just before the paragraph beginning to be not + ;; read-only + 3 muse-html-markup-paragraph)) + "List of markup rules for publishing a Muse page to HTML. +For more on the structure of this list, see `muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-html) + +(defcustom muse-html-markup-functions + '((anchor . muse-html-markup-anchor) + (table . muse-html-markup-table) + (footnote . muse-html-markup-footnote)) + "An alist of style types to custom functions for that kind of text. +For more on the structure of this list, see +`muse-publish-markup-functions'." + :type '(alist :key-type symbol :value-type function) + :group 'muse-html) + +(defcustom muse-html-markup-strings + '((image-with-desc . "<table class=\"image\" width=\"100%%\"> + <tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\"></td></tr> + <tr><td align=\"center\" class=\"image-caption\">%3%</td></tr> +</table>") + (image . "<img src=\"%s.%s\" alt=\"\">") + (image-link . "<a class=\"image-link\" href=\"%s\"> +<img src=\"%s.%s\"></a>") + (anchor-ref . "<a href=\"#%s\">%s</a>") + (url . "<a href=\"%s\">%s</a>") + (link . "<a href=\"%s\">%s</a>") + (link-and-anchor . "<a href=\"%s#%s\">%s</a>") + (email-addr . "<a href=\"mailto:%s\">%s</a>") + (anchor . "<a name=\"%1%\" id=\"%1%\">") + (emdash . "%s—%s") + (comment-begin . "<!-- ") + (comment-end . " -->") + (rule . "<hr>") + (fn-sep . "<hr>\n") + (no-break-space . " ") + (line-break . "<br>") + (enddots . "....") + (dots . "...") + (section . "<h2>") + (section-end . "</h2>") + (subsection . "<h3>") + (subsection-end . "</h3>") + (subsubsection . "<h4>") + (subsubsection-end . "</h4>") + (section-other . "<h5>") + (section-other-end . "</h5>") + (begin-underline . "<u>") + (end-underline . "</u>") + (begin-literal . "<code>") + (end-literal . "</code>") + (begin-cite . "<span class=\"citation\">") + (begin-cite-author . "<span class=\"citation-author\">") + (begin-cite-year . "<span class=\"citation-year\">") + (end-cite . "</span>") + (begin-emph . "<em>") + (end-emph . "</em>") + (begin-more-emph . "<strong>") + (end-more-emph . "</strong>") + (begin-most-emph . "<strong><em>") + (end-most-emph . "</em></strong>") + (begin-verse . "<p class=\"verse\">\n") + (verse-space . " ") + (end-verse-line . "<br>") + (end-last-stanza-line . "<br>") + (empty-verse-line . "<br>") + (end-verse . "</p>") + (begin-example . "<pre class=\"example\">") + (end-example . "</pre>") + (begin-center . "<center>\n<p>") + (end-center . "</p>\n</center>") + (begin-quote . "<blockquote>\n") + (end-quote . "\n</blockquote>") + (begin-quote-item . "<p class=\"quoted\">") + (end-quote-item . "</p>") + (begin-uli . "<ul>\n") + (end-uli . "\n</ul>") + (begin-uli-item . "<li>") + (end-uli-item . "</li>") + (begin-oli . "<ol>\n") + (end-oli . "\n</ol>") + (begin-oli-item . "<li>") + (end-oli-item . "</li>") + (begin-dl . "<dl>\n") + (end-dl . "\n</dl>") + (begin-ddt . "<dt><strong>") + (end-ddt . "</strong></dt>") + (begin-dde . "<dd>") + (end-dde . "</dd>") + (begin-table . "<table%s>\n") + (end-table . "</table>") + (begin-table-row . " <tr>\n") + (end-table-row . " </tr>\n") + (begin-table-entry . " <%s>") + (end-table-entry . "</%s>\n")) + "Strings used for marking up text as HTML. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-html) + +(defcustom muse-xhtml-markup-strings + '((image-with-desc . "<table class=\"image\" width=\"100%%\"> + <tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\" /></td></tr> + <tr><td align=\"center\" class=\"image-caption\">%3%</td></tr> +</table>") + (image . "<img src=\"%s.%s\" alt=\"\" />") + (image-link . "<a class=\"image-link\" href=\"%s\"> +<img src=\"%s.%s\" alt=\"\" /></a>") + (rule . "<hr />") + (fn-sep . "<hr />\n") + (line-break . "<br />") + (begin-underline . "<span style=\"text-decoration: underline;\">") + (end-underline . "</span>") + (begin-center . "<p style=\"text-align: center;\">\n") + (end-center . "\n</p>") + (end-verse-line . "<br />") + (end-last-stanza-line . "<br />") + (empty-verse-line . "<br />")) + "Strings used for marking up text as XHTML. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles. + +If a markup rule is not found here, `muse-html-markup-strings' is +searched." + :type '(alist :key-type symbol :value-type string) + :group 'muse-html) + +(defcustom muse-xhtml1.1-markup-strings + '((anchor . "<a id=\"%s\">")) + "Strings used for marking up text as XHTML 1.1. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles. + +If a markup rule is not found here, `muse-xhtml-markup-strings' +and `muse-html-markup-strings' are searched." + :type '(alist :key-type symbol :value-type string) + :group 'muse-html) + +(defcustom muse-html-markup-tags + '(("class" t t t muse-html-class-tag) + ("div" t t t muse-html-div-tag) + ("src" t t nil muse-html-src-tag)) + "A list of tag specifications, for specially marking up HTML." + :type '(repeat (list (string :tag "Markup tag") + (boolean :tag "Expect closing tag" :value t) + (boolean :tag "Parse attributes" :value nil) + (boolean :tag "Nestable" :value nil) + function)) + :group 'muse-html) + +(defcustom muse-html-meta-http-equiv "Content-Type" + "The http-equiv attribute used for the HTML <meta> tag." + :type 'string + :group 'muse-html) + +(defcustom muse-html-meta-content-type "text/html" + "The content type used for the HTML <meta> tag. +If you are striving for XHTML 1.1 compliance, you may want to +change this to \"application/xhtml+xml\"." + :type 'string + :group 'muse-html) + +(defcustom muse-html-meta-content-encoding (if (featurep 'mule) + 'detect + "iso-8859-1") + "The charset to append to the HTML <meta> tag. +If set to the symbol 'detect, use `muse-html-encoding-map' to try +and determine the HTML charset from emacs's coding. If set to a +string, this string will be used to force a particular charset" + :type '(choice string symbol) + :group 'muse-html) + +(defcustom muse-html-encoding-default 'iso-8859-1 + "The default Emacs buffer encoding to use in published files. +This will be used if no special characters are found." + :type 'symbol + :group 'muse-html) + +(defcustom muse-html-charset-default "iso-8859-1" + "The default HTML meta charset to use if no translation is found in +`muse-html-encoding-map'." + :type 'string + :group 'muse-html) + +(defcustom muse-html-src-allowed-modes t + "Modes that we allow the <src> tag to colorize. +If t, permit the <src> tag to colorize any mode. + +If a list of mode names, such as '(\"html\" \"latex\"), and the +lang argument to <src> is not in the list, then use fundamental +mode instead." + :type '(choice (const :tag "Any" t) + (repeat (string :tag "Mode"))) + :group 'muse-html) + +(defun muse-html-insert-anchor (anchor) + "Insert an anchor, either around the word at point, or within a tag." + (skip-chars-forward (concat muse-regexp-blank "\n")) + (if (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>")) + (let ((tag (match-string 1))) + (goto-char (match-end 0)) + (muse-insert-markup (muse-markup-text 'anchor anchor)) + (when muse-html-anchor-on-word + (or (and (search-forward (format "</%s>" tag) + (muse-line-end-position) t) + (goto-char (match-beginning 0))) + (forward-word 1))) + (muse-insert-markup "</a>")) + (muse-insert-markup (muse-markup-text 'anchor anchor)) + (when muse-html-anchor-on-word + (forward-word 1)) + (muse-insert-markup "</a>\n"))) + +(defun muse-html-markup-anchor () + (unless (get-text-property (match-end 1) 'muse-link) + (save-match-data + (muse-html-insert-anchor (match-string 2))) + (match-string 1))) + +(defun muse-html-markup-paragraph () + (let ((end (copy-marker (match-end 0) t))) + (goto-char (match-beginning 0)) + (when (save-excursion + (save-match-data + (and (not (get-text-property (max (point-min) (1- (point))) + 'muse-no-paragraph)) + (re-search-backward "<\\(/?\\)p[ >]" nil t) + (not (string-equal (match-string 1) "/"))))) + (when (get-text-property (1- (point)) 'muse-end-list) + (goto-char (previous-single-property-change (1- (point)) + 'muse-end-list))) + (muse-insert-markup "</p>")) + (goto-char end)) + (cond + ((eobp) + (unless (bolp) + (insert "\n"))) + ((get-text-property (point) 'muse-no-paragraph) + (forward-char 1) + nil) + ((eq (char-after) ?\<) + (cond + ((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]") + (muse-insert-markup "<p>")) + ((looking-at "<a ") + (if (looking-at "<a[^>\n]+><img") + (muse-insert-markup "<p class=\"image-link\">") + (muse-insert-markup "<p>"))) + ((looking-at "<img[ >]") + (muse-insert-markup "<p class=\"image\">")) + (t + (forward-char 1) + nil))) + ((muse-looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n") + (muse-insert-markup "<p class=\"first\">")) + (t + (muse-insert-markup "<p>")))) + +(defun muse-html-markup-footnote () + (cond + ((get-text-property (match-beginning 0) 'muse-link) + nil) + ((= (muse-line-beginning-position) (match-beginning 0)) + (prog1 + (let ((text (match-string 1))) + (muse-insert-markup + (concat "<p class=\"footnote\">" + "<a class=\"footnum\" name=\"fn." text + "\" href=\"#fnr." text "\">" + text ".</a>"))) + (save-excursion + (save-match-data + (let* ((beg (goto-char (match-end 0))) + (end (and (search-forward "\n\n" nil t) + (prog1 + (copy-marker (match-beginning 0)) + (goto-char beg))))) + (while (re-search-forward (concat "^[" + muse-regexp-blank + "]+\\([^\n]\\)") + end t) + (replace-match "\\1" t))))) + (replace-match ""))) + (t (let ((text (match-string 1))) + (muse-insert-markup + (concat "<sup><a class=\"footref\" name=\"fnr." text + "\" href=\"#fn." text "\">" + text "</a></sup>"))) + (replace-match "")))) + +(defun muse-html-markup-table () + (muse-xml-markup-table muse-html-table-attributes)) + +;; Handling of tags for HTML + +(defun muse-html-strip-links (string) + "Remove all HTML links from STRING." + (muse-replace-regexp-in-string "\\(<a .*?>\\|</a>\\)" "" string nil t)) + +(defun muse-html-insert-contents (depth) + "Scan the current document and generate a table of contents at point. +DEPTH indicates how many levels of headings to include. The default is 2." + (let ((max-depth (or depth 2)) + (index 1) + base contents l end) + (save-excursion + (goto-char (point-min)) + (search-forward "Page published by Emacs Muse begins here" nil t) + (catch 'done + (while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t) + (unless (and (get-text-property (point) 'read-only) + (not (get-text-property (match-beginning 0) + 'muse-contents))) + (remove-text-properties (match-beginning 0) (match-end 0) + '(muse-contents nil)) + (setq l (1- (string-to-number (match-string 1)))) + (if (null base) + (setq base l) + (if (< l base) + (throw 'done t))) + (when (<= l max-depth) + ;; escape specials now before copying the text, so that we + ;; can deal sanely with both emphasis in titles and + ;; special characters + (goto-char (match-end 2)) + (setq end (point-marker)) + (muse-publish-escape-specials (match-beginning 2) end + nil 'document) + (muse-publish-mark-read-only (match-beginning 2) end) + (setq contents (cons (cons l (buffer-substring-no-properties + (match-beginning 2) end)) + contents)) + (set-marker end nil) + (goto-char (match-beginning 2)) + (muse-html-insert-anchor (concat "sec" (int-to-string index))) + (setq index (1+ index))))))) + (setq index 1 contents (nreverse contents)) + (let ((depth 1) (sub-open 0) (p (point))) + (muse-insert-markup "<div class=\"contents\">\n<dl>\n") + (while contents + (muse-insert-markup "<dt>\n" + "<a href=\"#sec" (int-to-string index) "\">" + (muse-html-strip-links (cdar contents)) + "</a>\n" + "</dt>\n") + (setq index (1+ index) + depth (caar contents) + contents (cdr contents)) + (when contents + (cond + ((< (caar contents) depth) + (let ((idx (caar contents))) + (while (< idx depth) + (muse-insert-markup "</dl>\n</dd>\n") + (setq sub-open (1- sub-open) + idx (1+ idx))))) + ((> (caar contents) depth) ; can't jump more than one ahead + (muse-insert-markup "<dd>\n<dl>\n") + (setq sub-open (1+ sub-open)))))) + (while (> sub-open 0) + (muse-insert-markup "</dl>\n</dd>\n") + (setq sub-open (1- sub-open))) + (muse-insert-markup "</dl>\n</div>\n") + (muse-publish-mark-read-only p (point))))) + +(defun muse-html-denote-headings () + "Place a text property on any headings in the current buffer. +This allows the headings to be picked up later on if publishing a +table of contents." + (save-excursion + (goto-char (point-min)) + (search-forward "Page published by Emacs Muse begins here" nil t) + (while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t) + (unless (get-text-property (point) 'read-only) + (add-text-properties (match-beginning 0) (match-end 0) + '(muse-contents t)))))) + +(defun muse-html-class-tag (beg end attrs) + (let ((name (cdr (assoc "name" attrs)))) + (when name + (goto-char beg) + (muse-insert-markup "<span class=\"" name "\">") + (save-excursion + (goto-char end) + (muse-insert-markup "</span>"))))) + +(defun muse-html-div-tag (beg end attrs) + "Publish a <div> tag for HTML." + (let ((id (cdr (assoc "id" attrs))) + (style (cdr (assoc "style" attrs)))) + (when (or id style) + (goto-char beg) + (if (null id) + (muse-insert-markup "<div style=\"" style "\">") + (muse-insert-markup "<div id=\"" id "\">")) + (save-excursion + (goto-char end) + (muse-insert-markup "</div>"))))) + +(defun muse-html-src-tag (beg end attrs) + "Publish the region using htmlize. +The language to use may be specified by the \"lang\" attribute. + +Muse will look for a function named LANG-mode, where LANG is the +value of the \"lang\" attribute. + +This tag requires htmlize 1.34 or later in order to work." + (if (condition-case nil + (progn + (require 'htmlize) + (if (fboundp 'htmlize-region-for-paste) + nil + (muse-display-warning + (concat "The `htmlize-region-for-paste' function was not" + " found.\nThis is available in htmlize.el 1.34" + " or later.")) + t)) + (error nil t)) + ;; if htmlize.el was not found, treat this like an example tag + (muse-publish-example-tag beg end) + (muse-publish-ensure-block beg end) + (let* ((lang (cdr (assoc "lang" attrs))) + (mode (or (and (not (eq muse-html-src-allowed-modes t)) + (not (member lang muse-html-src-allowed-modes)) + 'fundamental-mode) + (intern-soft (concat lang "-mode")))) + (text (muse-delete-and-extract-region beg end)) + (htmltext + (with-temp-buffer + (insert text) + (if (functionp mode) + (funcall mode) + (fundamental-mode)) + (font-lock-fontify-buffer) + ;; silence the byte-compiler + (when (fboundp 'htmlize-region-for-paste) + ;; transform the region to HTML + (htmlize-region-for-paste (point-min) (point-max)))))) + (save-restriction + (narrow-to-region (point) (point)) + (insert htmltext) + (goto-char (point-min)) + (re-search-forward "<pre\\([^>]*\\)>\n?" nil t) + (replace-match "<pre class=\"src\">") + (goto-char (point-max)) + (muse-publish-mark-read-only (point-min) (point-max)))))) + +;; Register the Muse HTML Publisher + +(defun muse-html-browse-file (file) + (browse-url (concat "file:" file))) + +(defun muse-html-encoding () + (if (stringp muse-html-meta-content-encoding) + muse-html-meta-content-encoding + (muse-xml-transform-content-type + (or (and (boundp 'buffer-file-coding-system) + buffer-file-coding-system) + muse-html-encoding-default) + muse-html-charset-default))) + +(defun muse-html-prepare-buffer () + (make-local-variable 'muse-html-meta-http-equiv) + (set (make-local-variable 'muse-html-meta-content-type) + (if (save-match-data + (string-match "charset=" muse-html-meta-content-type)) + muse-html-meta-content-type + (concat muse-html-meta-content-type "; charset=" + (muse-html-encoding))))) + +(defun muse-html-munge-buffer () + (if muse-publish-generate-contents + (progn + (goto-char (car muse-publish-generate-contents)) + (muse-html-insert-contents (cdr muse-publish-generate-contents)) + (setq muse-publish-generate-contents nil)) + (muse-html-denote-headings))) + +(defun muse-html-finalize-buffer () + (when (and (boundp 'buffer-file-coding-system) + (memq buffer-file-coding-system '(no-conversion undecided-unix))) + ;; make it agree with the default charset + (setq buffer-file-coding-system muse-html-encoding-default))) + +;;; Register the Muse HTML and XHTML Publishers + +(muse-define-style "html" + :suffix 'muse-html-extension + :regexps 'muse-html-markup-regexps + :functions 'muse-html-markup-functions + :strings 'muse-html-markup-strings + :tags 'muse-html-markup-tags + :specials 'muse-xml-decide-specials + :before 'muse-html-prepare-buffer + :before-end 'muse-html-munge-buffer + :after 'muse-html-finalize-buffer + :header 'muse-html-header + :footer 'muse-html-footer + :style-sheet 'muse-html-style-sheet + :browser 'muse-html-browse-file) + +(muse-derive-style "xhtml" "html" + :suffix 'muse-xhtml-extension + :strings 'muse-xhtml-markup-strings + :header 'muse-xhtml-header + :footer 'muse-xhtml-footer + :style-sheet 'muse-xhtml-style-sheet) + +;; xhtml1.0 is an alias for xhtml +(muse-derive-style "xhtml1.0" "xhtml") + +;; xhtml1.1 has some quirks that need attention from us +(muse-derive-style "xhtml1.1" "xhtml" + :strings 'muse-xhtml1.1-markup-strings) + +(provide 'muse-html) + +;;; muse-html.el ends here diff --git a/emacs.d/elisp/muse/muse-http.el b/emacs.d/elisp/muse/muse-http.el new file mode 100644 index 0000000..40bd1cb --- /dev/null +++ b/emacs.d/elisp/muse/muse-http.el @@ -0,0 +1,239 @@ +;;; muse-http.el --- publish HTML files over HTTP + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Publishing HTML over HTTP (using httpd.el) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-html) +(require 'muse-project) +(require 'httpd) +(require 'cgi) + +(defgroup muse-http nil + "Options controlling the behavior of Emacs Muse over HTTP." + :group 'press) + +(defcustom muse-http-maintainer (concat "webmaster@" (system-name)) + "The maintainer address to use for the HTTP 'From' field." + :type 'string + :group 'muse-http) + +(defcustom muse-http-publishing-style "html" + "The style to use when publishing projects over http." + :type 'string + :group 'muse-http) + +(defcustom muse-http-max-cache-size 64 + "The number of pages to cache when serving over HTTP. +This only applies if set while running the persisted invocation +server. See main documentation for the `muse-http' +customization group." + :type 'integer + :group 'muse-http) + +(defvar muse-buffer-mtime nil) +(make-variable-buffer-local 'muse-buffer-mtime) + +(defun muse-sort-buffers (l r) + (let ((l-mtime (with-current-buffer l muse-buffer-mtime)) + (r-mtime (with-current-buffer r muse-buffer-mtime))) + (cond + ((and (null l-mtime) (null r-mtime)) l) + ((null l-mtime) r) + ((null r-mtime) l) + (t (muse-time-less-p r-mtime l-mtime))))) + +(defun muse-winnow-list (entries &optional predicate) + "Return only those ENTRIES for which PREDICATE returns non-nil." + (let ((flist (list t))) + (let ((entry entries)) + (while entry + (if (funcall predicate (car entry)) + (nconc flist (list (car entry)))) + (setq entry (cdr entry)))) + (cdr flist))) + +(defun muse-http-prune-cache () + "If the page cache has become too large, prune it." + (let* ((buflist + (sort (muse-winnow-list (buffer-list) + (function + (lambda (buf) + (with-current-buffer buf + muse-buffer-mtime)))) + 'muse-sort-buffers)) + (len (length buflist))) + (while (> len muse-http-max-cache-size) + (kill-buffer (car buflist)) + (setq len (1- len))))) + +(defvar muse-http-serving-p nil) + +(defun muse-http-send-buffer (&optional modified code msg) + "Markup and send the contents of the current buffer via HTTP." + (httpd-send (or code 200) (or msg "OK") + "Server: muse.el/" muse-version httpd-endl + "Connection: close" httpd-endl + "MIME-Version: 1.0" httpd-endl + "Date: " (format-time-string "%a, %e %b %Y %T %Z") + httpd-endl + "From: " muse-http-maintainer httpd-endl) + (when modified + (httpd-send-data "Last-Modified: " + (format-time-string "%a, %e %b %Y %T %Z" modified) + httpd-endl)) + (httpd-send-data "Content-Type: text/html; charset=iso-8859-1" httpd-endl + "Content-Length: " (number-to-string (1- (point-max))) + httpd-endl httpd-endl + (buffer-string)) + (httpd-send-eof)) + +(defun muse-http-reject (title msg &optional annotation) + (muse-with-temp-buffer + (insert msg ".\n") + (if annotation + (insert annotation "\n")) + (muse-publish-markup-buffer title muse-http-publishing-style) + (muse-http-send-buffer nil 404 msg))) + +(defun muse-http-prepare-url (target explicit) + (save-match-data + (unless (or (not explicit) + (string-match muse-url-regexp target) + (string-match muse-image-regexp target) + (string-match muse-file-regexp target)) + (setq target (concat "page?" target + "&project=" muse-http-serving-p)))) + (muse-publish-read-only target)) + +(defun muse-http-render-page (name) + "Render the Muse page identified by NAME. +When serving from a dedicated Emacs process (see the httpd-serve +script), a maximum of `muse-http-max-cache-size' pages will be +cached in memory to speed up serving time." + (let ((file (muse-project-page-file name muse-http-serving-p)) + (muse-publish-url-transforms + (cons 'muse-http-prepare-url muse-publish-url-transforms)) + (inhibit-read-only t)) + (when file + (with-current-buffer (get-buffer-create file) + (let ((modified-time (nth 5 (file-attributes file))) + (muse-publishing-current-file file) + muse-publishing-current-style) + (when (or (null muse-buffer-mtime) + (muse-time-less-p muse-buffer-mtime modified-time)) + (erase-buffer) + (setq muse-buffer-mtime modified-time)) + (goto-char (point-max)) + (when (bobp) + (muse-insert-file-contents file t) + (let ((styles (cddr (muse-project muse-http-serving-p))) + style) + (while (and styles (null style)) + (let ((include-regexp + (muse-style-element :include (car styles))) + (exclude-regexp + (muse-style-element :exclude (car styles)))) + (when (and (or (and (null include-regexp) + (null exclude-regexp)) + (if include-regexp + (string-match include-regexp file) + (not (string-match exclude-regexp file)))) + (not (muse-project-private-p file))) + (setq style (car styles)) + (while (muse-style-element :base style) + (setq style + (muse-style (muse-style-element :base style)))) + (if (string= (car style) muse-http-publishing-style) + (setq style (car styles)) + (setq style nil)))) + (setq styles (cdr styles))) + (muse-publish-markup-buffer + name (or style muse-http-publishing-style)))) + (set-buffer-modified-p nil) + (muse-http-prune-cache) + (current-buffer)))))) + +(defun muse-http-transmit-page (name) + "Render the Muse page identified by NAME. +When serving from a dedicated Emacs process (see the httpd-serve +script), a maximum of `muse-http-max-cache-size' pages will be +cached in memory to speed up serving time." + (let ((inhibit-read-only t) + (buffer (muse-http-render-page name))) + (if buffer + (with-current-buffer buffer + (muse-http-send-buffer muse-buffer-mtime))))) + +(defvar httpd-vars nil) + +(defsubst httpd-var (var) + "Return value of VAR as a URL variable. If VAR doesn't exist, nil." + (cdr (assoc var httpd-vars))) + +(defsubst httpd-var-p (var) + "Return non-nil if VAR was passed as a URL variable." + (not (null (assoc var httpd-vars)))) + +(defun muse-http-serve (page &optional content) + "Serve the given PAGE from this press server." + ;; index.html is really a reference to the project home page + (if (and muse-project-alist + (string-match "\\`index.html?\\'" page)) + (setq page (concat "page?" + (muse-get-keyword :default + (cadr (car muse-project-alist)))))) + ;; handle the actual request + (let ((vc-follow-symlinks t) + (muse-publish-report-threshhold nil) + muse-http-serving-p + httpd-vars) + (save-excursion + ;; process any CGI variables, if cgi.el is available + (if (string-match "\\`\\([^&]+\\)&" page) + (setq httpd-vars (cgi-decode (substring page (match-end 0))) + page (match-string 1 page))) + (unless (setq muse-http-serving-p (httpd-var "project")) + (let ((project (car muse-project-alist))) + (setq muse-http-serving-p (car project)) + (setq httpd-vars (cons (cons "project" (car project)) + httpd-vars)))) + (if (and muse-http-serving-p + (string-match "\\`page\\?\\(.+\\)" page)) + (muse-http-transmit-page (match-string 1 page)))))) + +(if (featurep 'httpd) + (httpd-add-handler "\\`\\(index\\.html?\\|page\\(\\?\\|\\'\\)\\)" + 'muse-http-serve)) + +(provide 'muse-http) + +;;; muse-http.el ends here diff --git a/emacs.d/elisp/muse/muse-ikiwiki.el b/emacs.d/elisp/muse/muse-ikiwiki.el new file mode 100644 index 0000000..a664880 --- /dev/null +++ b/emacs.d/elisp/muse/muse-ikiwiki.el @@ -0,0 +1,219 @@ +;;; muse-ikiwiki.el --- integrate with Ikiwiki + +;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Ikiwiki Integration +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse) +(require 'muse-html) +(require 'muse-ipc) +(require 'muse-publish) + +(eval-when-compile + (require 'muse-colors)) + +(defgroup muse-ikiwiki nil + "Options controlling the behavior of Muse integration with Ikiwiki." + :group 'muse-publish) + +(defcustom muse-ikiwiki-header "" + "Header used for publishing Ikiwiki output files. +This may be text or a filename." + :type 'string + :group 'muse-ikiwiki) + +(defcustom muse-ikiwiki-footer "" + "Footer used for publishing Ikiwiki output files. +This may be text or a filename." + :type 'string + :group 'muse-ikiwiki) + +(defcustom muse-ikiwiki-markup-regexps + `(;; Ikiwiki directives + (1350 ,(concat "\\(\\\\?\\)\\[\\[!""\\(?:-\\|\\w\\)+" + "\\([" muse-regexp-blank "\n]+" + "\\(?:\\(?:\\(?:-\\|\\w\\)+=\\)?" + "\\(?:\"\"\".*?\"\"\"\\|\"[^\"]+\"" + "\\|[^]" muse-regexp-blank "\n]+\\)" + "[" muse-regexp-blank "\n]*\\)*\\)?\\]\\]") + 0 muse-ikiwiki-markup-directive)) + "List of markup rules for publishing Ikiwiki markup on Muse pages. +For more on the structure of this list, see `muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-ikiwiki) + +;;; Publishing + +(defun muse-ikiwiki-markup-directive () + "Handle publishing of an Ikiwiki directive." + (unless (get-text-property (match-beginning 0) 'read-only) + (add-text-properties (match-beginning 0) (match-end 0) + '(muse-no-paragraph t)) + (muse-publish-mark-read-only (match-beginning 0) (match-end 0)))) + +(defun muse-ikiwiki-publish-buffer (name title &optional style) + "Publish a buffer for Ikiwki. +The name of the corresponding file is NAME. +The name of the style is given by STYLE. It defaults to \"ikiwiki\"." + (unless style (setq style "ikiwiki")) + (unless title (setq title (muse-page-name name))) + (let ((muse-batch-publishing-p t) + (muse-publishing-current-file name) + (muse-publishing-current-output-path name) + (muse-publishing-current-style style) + (font-lock-verbose nil) + (vc-handled-backends nil)) ; don't activate VC when publishing files + (run-hooks 'muse-before-publish-hook) + (let ((muse-inhibit-before-publish-hook t)) + (muse-publish-markup-buffer title style)))) + +(defun muse-ikiwiki-publish-file (file name &optional style) + "Publish a single file for Ikiwiki. +The name of the real file is NAME, and the name of the temporary +file containing the content is FILE. +The name of the style is given by STYLE. It defaults to \"ikiwiki\"." + (if (not (stringp file)) + (message "Error: No file given to publish") + (unless style + (setq style "ikiwiki")) + (let ((output-path file) + (target file) + (vc-handled-backends nil) ; don't activate VC when publishing files + auto-mode-alist + muse-current-output-style) + (setq auto-mode-alist + (delete (cons (concat "\\." muse-file-extension "\\'") + 'muse-mode-choose-mode) + auto-mode-alist)) + (setq muse-current-output-style (list :base style :path file)) + (muse-with-temp-buffer + (muse-insert-file-contents file) + (muse-ikiwiki-publish-buffer name nil style) + (when (muse-write-file output-path t) + (muse-style-run-hooks :final style file output-path target)))))) + +(defun muse-ikiwiki-start-server (port) + "Start Muse IPC server, initializing with the client on PORT." + (muse-ipc-start "foo" #'muse-ikiwiki-publish-buffer port)) + +;;; Colors + +(defface muse-ikiwiki-directive + '((((class color) (background light)) + (:foreground "dark green")) + (((class color) (background dark)) + (:foreground "green"))) + "Face for Ikiwiki directives." + :group 'muse-ikiwiki) + +(defun muse-colors-ikiwiki-directive () + "Color ikiwiki directives." + (let ((start (match-beginning 0))) + (unless (or (eq (get-text-property start 'invisible) 'muse) + (get-text-property start 'muse-comment) + (get-text-property start 'muse-directive)) + ;; beginning of line or space or symbol + (save-excursion + (and + (catch 'valid + (while t + (skip-chars-forward "^\"]" muse-colors-region-end) + (cond ((eq (point) (point-max)) + (throw 'valid nil)) + ((> (point) muse-colors-region-end) + (throw 'valid nil)) + ((eq (char-after) ?\") + (if (and (< (1+ (point)) muse-colors-region-end) + (eq (char-after (1+ (point))) ?\")) + (if (and (< (+ 2 (point)) muse-colors-region-end) + (eq (char-after (+ 2 (point))) ?\")) + ;; triple-quote + (progn + (forward-char 3) + (or (and (looking-at "\"\"\"") + (goto-char (match-end 0))) + (re-search-forward + "\"\"\"" muse-colors-region-end t) + (throw 'valid nil))) + ;; empty quotes (""), which are invalid + (throw 'valid nil)) + ;; quote with content + (forward-char 1) + (skip-chars-forward "^\"" muse-colors-region-end) + (when (eq (char-after) ?\") + (forward-char 1)))) + ((eq (char-after) ?\]) + (forward-char 1) + (when (and (< (point) muse-colors-region-end) + (eq (char-after (point)) ?\])) + (forward-char 1) + (throw 'valid t))) + (t (throw 'valid nil))))) + ;; found a valid directive + (let ((end (point))) + ;; remove flyspell overlays + (when (fboundp 'flyspell-unhighlight-at) + (let ((cur start)) + (while (> end cur) + (flyspell-unhighlight-at cur) + (setq cur (1+ cur))))) + (add-text-properties start end + '(face muse-ikiwiki-directive + muse-directive t muse-no-flyspell t)) + (when (progn + (goto-char start) + (skip-chars-forward "^\n" end) + (and (eq (char-after) ?\n) + (not (= (point) end)))) + (add-text-properties start end + '(font-lock-multiline t))))))))) + +(defun muse-ikiwiki-insinuate-colors () + (add-to-list 'muse-colors-markup + '("\\[\\[!" ?\[ muse-colors-ikiwiki-directive) + nil)) + +(eval-after-load "muse-colors" '(muse-ikiwiki-insinuate-colors)) + +;; Styles +(muse-derive-style "ikiwiki" "xhtml" + :header 'muse-ikiwiki-header + :footer 'muse-ikiwiki-footer + :regexps 'muse-ikiwiki-markup-regexps) + +(provide 'muse-ikiwiki) + +;;; muse-ikiwiki.el ends here diff --git a/emacs.d/elisp/muse/muse-import-docbook.el b/emacs.d/elisp/muse/muse-import-docbook.el new file mode 100644 index 0000000..ed1b22b --- /dev/null +++ b/emacs.d/elisp/muse/muse-import-docbook.el @@ -0,0 +1,137 @@ +;;; muse-import-docbook.el --- convert Docbook XML into Muse format + +;; Copyright (C) 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Elena Pomohaci <e.pomohaci@gmail.com> + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; It works only for article type docbook docs and recognize +;; followings elements: article, sect1, sect2, sect3, title, + +;;; Contributors: + +;;; Code: + +(require 'muse-import-xml) + +(defvar muse-import-docbook-prefix "muse-import-docbook-" + "The name prefix for tag functions") + +(defvar muse-import-docbook-para-indent "\n\n" + "Para elements indentation (0, less than 6 spaces, more than 6 spaces)") + +(defun muse-import-docbook-reset-para-indent () + (setq muse-import-docbook-para-indent "\n\n")) + + +;;;###autoload +(defun muse-import-docbook (src dest) + "Convert the Docbook buffer SRC to Muse, writing output in the DEST buffer." + (interactive "bDocbook buffer:\nBMuse buffer:") + (setq muse-import-xml-prefix muse-import-docbook-prefix) + (setq muse-import-xml-generic-function-name "muse-import-xml-node") + (muse-import-xml src dest)) + +;;;###autoload +(defun muse-import-docbook-files (src dest) + "Convert the Docbook file SRC to Muse, writing output to the DEST file." + (interactive "fDocbook file:\nFMuse file:") + (with-temp-file dest + (muse-import-docbook (find-file-noselect src) (current-buffer)))) + + +;;; element specific functions + +(defun muse-import-docbook-get-title (node) + (let ((tit (car (xml-get-children node 'title)))) + (insert (car (cddr tit)) ?\n ?\n) + (muse-import-xml-parse-tree (xml-node-children (remove tit node))))) + + +(defun muse-import-docbook-article (node) + "Article conversion function" + (muse-import-xml-node node)) + +(defun muse-import-docbook-articleinfo (node) + "Article conversion function" + (insert "#title ") + (muse-import-docbook-get-title node) + (insert ?\n)) + + +(defalias 'muse-import-docbook-appendix 'muse-import-docbook-article) + +(defalias 'muse-import-docbook-appendixinfo 'muse-import-docbook-articleinfo) + + +(defun muse-import-docbook-sect1 (node) + "Section 1 conversion function" + (insert ?\n "* ") + (muse-import-docbook-get-title node)) + +(defun muse-import-docbook-sect2 (node) + "Section 2 conversion function" + (insert ?\n "** ") + (muse-import-docbook-get-title node)) + +(defun muse-import-docbook-sect3 (node) + "Section 3 conversion function" + (insert ?\n "*** ") + (muse-import-docbook-get-title node)) + + +(defun muse-import-docbook-graphic (node) + "Graphic conversion function. Image format is forced to PNG" + (let ((name (xml-get-attribute node 'fileref))) + (insert "\n[[img/" name ".png][" name "]]"))) + +(defun muse-import-docbook-para (node) + (insert muse-import-docbook-para-indent) + (muse-import-xml-node node)) + + +(defun muse-import-docbook-emphasis (node) + (insert "*") + (muse-import-xml-node node) + (insert "*")) + +(defun muse-import-docbook-quote (node) + (insert "\"") + (muse-import-xml-node node) + (insert "\"")) + +(defun muse-import-docbook-blockquote (node) + (setq muse-import-docbook-para-indent "\n\n ") + (muse-import-xml-node node) + (muse-import-docbook-reset-para-indent)) + +(defun muse-import-docbook-member (node) + (insert "\n> ") + (muse-import-xml-node node)) + +(defun muse-import-docbook-bridgehead (node) + (insert "\n* ") + (muse-import-xml-node node)) + +(provide 'muse-import-docbook) + +;;; muse-import-docbook.el ends here diff --git a/emacs.d/elisp/muse/muse-import-latex.el b/emacs.d/elisp/muse/muse-import-latex.el new file mode 100644 index 0000000..5297131 --- /dev/null +++ b/emacs.d/elisp/muse/muse-import-latex.el @@ -0,0 +1,149 @@ +;;; muse-import-latex.el --- convert a LaTex file into a Muse file + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Helper commands for converting a LaTeX file into a Muse file. + +;;; Contributors: + +;;; Code: + +(require 'muse) +(require 'muse-regexps) + +(defun muse-i-l-write-citation (note author citation pages) + (save-excursion + (goto-char (point-max)) + (if (= note 1) + (insert "\nFootnotes:\n\n")) + (let ((beg (point))) + (insert "\n[" (number-to-string note) "] " author) + (if (and citation pages) + (insert ", " citation ", " pages)) + (insert "\n") + (goto-char beg) + (while (re-search-forward (concat "p.\\\\[" muse-regexp-blank "\n]+") + nil t) + (replace-match "p.")) + (goto-char beg) + (while (re-search-forward "--" nil t) + (replace-match "-"))))) + +(defun muse-i-l-write-footnote (note text) + (save-excursion + (goto-char (point-max)) + (if (= note 1) + (insert "\nFootnotes:\n\n")) + (insert "\n[" (number-to-string note) "] " text ?\n))) + +;;;###autoload +(defun muse-import-latex () + (interactive) + (goto-char (point-min)) + (while (not (eobp)) + (cond + ((or (looking-at "^\\\\documentclass") + (looking-at "^\\\\input") + (looking-at "^\\\\begin{document}") + (looking-at "^\\\\end{document}") + (looking-at "^\\\\author") + (looking-at "^\\\\\\(med\\|big\\|small\\)skip") + (looking-at "^\\\\maketitle")) + (delete-region (point) (muse-line-end-position))) + ((looking-at "^\\\\title{\\(.+\\)}") + (delete-region (match-end 1) (muse-line-end-position)) + (delete-region (point) (match-beginning 1)) + (insert "#title "))) + (forward-line)) + (goto-char (point-min)) + (while (re-search-forward "\\\\\\(l\\)?dots{}" nil t) + (replace-match (concat (and (string= (match-string 1) "l") ".") + "..."))) + (goto-char (point-min)) + (while (re-search-forward "\\(``\\|''\\)" nil t) + (replace-match "\"")) + (goto-char (point-min)) + (while (re-search-forward "---" nil t) + (replace-match " -- ")) + (goto-char (point-min)) + (while (re-search-forward "\\\\tableofcontents" nil t) + (replace-match "<contents>")) + (goto-char (point-min)) + (while (re-search-forward "\\\\\\\\" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "\\\\\\(sub\\)?section{\\([^}]+\\)}" nil t) + (replace-match (concat (if (string= (match-string 1) "sub") + "**" "*") + " " (match-string 2)))) + (goto-char (point-min)) + (while (re-search-forward "\\\\\\(begin\\|end\\){verse}" nil t) + (replace-match (concat "<" (if (string= (match-string 1) "end") "/") + "verse>"))) + (goto-char (point-min)) + (while (re-search-forward "\\\\\\(begin\\|end\\){quote}\n" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward + "\\\\\\(emph\\|textbf\\){\\([^}]+?\\)\\(\\\\/\\)?}" nil t) + (replace-match + (if (string= (match-string 1) "emph") "*\\2*" "**\\2**"))) + (let ((footnote-index 1)) + (goto-char (point-min)) + (while (re-search-forward + (concat "\\\\\\(q\\)?\\(footnote\\|excerpt\\)\\(np\\)?" + "\\({\\([^}]+\\)}\\)?" + "\\({\\([^}]+\\)}{\\([^}]+\\)}\\)?{\\([^}]+\\)}") nil t) + (let ((beg (match-beginning 0)) + (end (match-end 0))) + (unless (string= (match-string 2) "footnote") + (if (null (match-string 1)) + (insert " " (match-string 9)) + (let ((b (point)) e) + (insert "\"" (match-string 9) "\"") + (setq e (point-marker)) + (save-match-data + (save-excursion + (goto-char b) + (while (< (point) e) + (if (looking-at "\\s-+") + (delete-region (match-beginning 0) + (match-end 0))) + (forward-line)))) + (set-marker e nil)))) + (insert "[" (number-to-string footnote-index) "]") + (if (string= (match-string 2) "footnote") + (muse-i-l-write-footnote footnote-index (match-string 9)) + (muse-i-l-write-citation footnote-index (match-string 5) + (match-string 7) (match-string 8))) + (setq footnote-index (1+ footnote-index)) + (delete-region beg end)))) + (goto-char (point-min)) + (while (looking-at "\n") (delete-char 1)) + (goto-char (point-min)) + (while (re-search-forward "\n\n+" nil t) + (replace-match "\n\n"))) + +(provide 'muse-import-latex) + +;;; muse-import-latex.el ends here diff --git a/emacs.d/elisp/muse/muse-import-xml.el b/emacs.d/elisp/muse/muse-import-xml.el new file mode 100644 index 0000000..2579ce8 --- /dev/null +++ b/emacs.d/elisp/muse/muse-import-xml.el @@ -0,0 +1,88 @@ +;;; muse-import-xml.el --- common to all from-xml converters + +;; Copyright (C) 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Elena Pomohaci <e.pomohaci@gmail.com> + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;;; Code: + +(provide 'muse-import-xml) + +(require 'xml) +(require 'muse) + +(defvar muse-import-xml-prefix "" + "The name prefix for tag functions") + +(defvar muse-import-xml-generic-function-name "muse-import-xml-generic" + "The generic function name") + +(defun muse-import-xml-convert-to-list (buf) + "Convert xml BUF in a xml-list" + (with-temp-buffer + (insert-buffer-substring buf) + (goto-char (point-min)) + (while (re-search-forward ">[ \n\t]*<" nil t) + (replace-match "><" nil nil)) ; clean all superfluous blank characters + (xml-parse-region (point-min) + (point-max) + (current-buffer)))) + + +(defun muse-import-xml-generic (node) + "The generic function called when there is no node specific function." + (let ((name (xml-node-name node))) + (insert "<" (symbol-name name) ">") + (muse-import-xml-node node) + (insert "</" (symbol-name name) ">"))) + +(defun muse-import-xml-parse-tree (lst) + "Parse an xml tree list" + (mapc #'muse-import-xml-parse-node lst)) + +(defun muse-import-xml-parse-node (node) + "Parse a xml tree node" + (if (stringp node) + (insert (muse-replace-regexp-in-string "^[ \t]+" "" node)) + (let ((fname (intern-soft (concat muse-import-xml-prefix + (symbol-name (xml-node-name node)))))) + (if (functionp fname) + (funcall fname node) + (funcall (intern muse-import-xml-generic-function-name) node))))) + + +(defun muse-import-xml-node (node) + "Default node function" + (muse-import-xml-parse-tree (xml-node-children node))) + + +(defun muse-import-xml (src dest) + "Convert the xml SRC buffer in a muse DEST buffer" + (set-buffer (get-buffer-create dest)) + (when (fboundp 'muse-mode) + (muse-mode)) + (muse-import-xml-parse-tree (muse-import-xml-convert-to-list src))) + +;;; muse-import-xml.el ends here diff --git a/emacs.d/elisp/muse/muse-ipc.el b/emacs.d/elisp/muse/muse-ipc.el new file mode 100644 index 0000000..9ce8eb1 --- /dev/null +++ b/emacs.d/elisp/muse/muse-ipc.el @@ -0,0 +1,194 @@ +;;; muse-ipc.el --- publish Muse documents from other processes + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file is still in alpha state. Not for production use! + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Inter-Process Communication +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(eval-when-compile (require 'cl)) + +(require 'muse) +(require 'muse-publish) + +(defgroup muse-ipc nil + "Options controlling the behavior of Muse's IPC module." + :group 'muse-publish) + +(defcustom muse-ipc-timeout 60 + "Maximum time to wait for a client to respond." + :group 'muse-ipc + :type 'number) + +(defcustom muse-ipc-ignore-done nil + "If non-nil, ignore any 'done' messages that we get from clients." + :group 'muse-ipc + :type 'boolean) + +(defvar muse-ipc-server-port nil + "Port of the Emacs server.") + +(defvar muse-ipc-server-process nil + "Process of the Emacs server.") + +(defvar muse-ipc-server-registered nil + "Whether we have successfully registered our port with the client.") + +(defun muse-ipc-init-filter (proc string) + "Handle data from client while initiating a connection." + (unless muse-ipc-server-registered + (when (string-match "\\`ok$" string) + (setq muse-ipc-server-registered t)))) + +(defun muse-ipc-delete-client (proc) + "Delete a client." + (let ((buffer (process-get proc :buffer))) + (when (and buffer (buffer-live-p buffer)) + (with-current-buffer buffer + (set-buffer-modified-p nil)) + (kill-buffer buffer))) + (when (eq (process-status proc) 'open) + (delete-process proc))) + +(defun* muse-ipc-server-filter (proc string) + "Handle data from a client after it connects." + ;; Authenticate + (unless (process-get proc :authenticated) + (if (and (string-match "\\`begin \\(.+\\)$" string) + (equal (match-string 1 string) + (process-get proc :shared-secret))) + (progn + (setq string (substring string (match-end 0))) + (process-put proc :authenticated t) + (process-send-string proc "ok\n")) + (process-send-string proc "nok\n") + (delete-process proc)) + (return-from muse-ipc-server-filter)) + + ;; Handle case where the client is sending data to be published + (when (process-get proc :sending-data) + (with-current-buffer (process-get proc :buffer) + (insert string) + (let ((buf-len (1- (point))) + (expected-len (process-get proc :data-bytes))) + (cond ((= buf-len expected-len) + (process-put proc :sending-data nil)) + ((> buf-len expected-len) + (process-send-string proc "nok\n") + (muse-ipc-delete-client proc))))) + (return-from muse-ipc-server-filter)) + + ;; Dispatch commands + (cond + ((string-match "\\`done$" string) + ;; done, close the server + (unless muse-ipc-ignore-done + (muse-ipc-stop-server))) + + ((string-match "\\`name \\(.+\\)$" string) + ;; set name + (process-put proc :file-name (match-string 1 string)) + (process-send-string proc "ok\n")) + + ((string-match "\\`title \\(.+\\)$" string) + ;; set title + (process-put proc :title (match-string 1 string)) + (process-send-string proc "ok\n")) + + (t + ;; unrecognized command + (process-send-string proc "nok\n")))) + +(defun muse-ipc-stop-server () + "Stop Muse IPC server and reset connection data." + (stop-process muse-ipc-server-process) + (delete-process muse-ipc-server-process) + (setq muse-ipc-server-port nil) + (setq muse-ipc-server-process nil)) + +(defun muse-ipc-start (shared-secret publish-fn client-port &optional server-port) + "Start an IPC connection and send a response to CLIENT-PORT. +If SERVER-PORT is provided, start the IPC server on that port, otherwise +choose a random port. + +SHARED-SECRET is used as a very minimal security measure to +authenticate the Muse IPC server during initialization, and also +any incoming clients once the server is started. + +PUBLISH-FN is the function which should be called in buffer of +the received contents. It should transform the buffer into a +published state. It must take at least two arguments. The first +argument is the full path of the file that the contents +correspond with. The second argument is the title to use when +publishing the file." + (when (stringp client-port) + (setq client-port (string-to-number client-port))) + (when (stringp server-port) + (setq server-port (string-to-number server-port))) + (setq muse-ipc-server-process + (make-network-process + :name "muse-ipc" + :buffer nil + :host 'local :service (or server-port t) + :server t :noquery t :nowait t + :plist (list :authenticated nil :shared-secret shared-secret + :publish-fn publish-fn) + :filter 'muse-ipc-server-filter)) + (unless muse-ipc-server-process + (error "Error: Could not start Muse IPC Server process")) + (set-process-coding-system muse-ipc-server-process + 'raw-text-unix 'raw-text-unix) + (setq muse-ipc-server-port + (number-to-string + (cadr (process-contact muse-ipc-server-process)))) + (let ((client-proc + (make-network-process + :name "muse-ipc-client" + :buffer nil + :host 'local :service client-port + :noquery t + :filter 'muse-ipc-init-filter))) + (setq muse-ipc-server-registered nil) + (process-send-string client-proc + (concat "begin " shared-secret "\n")) + (accept-process-output client-proc muse-ipc-timeout nil t) + (unless muse-ipc-server-registered + (error "Error: Did not register listener")) + (process-send-string client-proc + (concat "port " muse-ipc-server-port "\n")) + (stop-process client-proc) + (delete-process client-proc)) + + ;; Accept process output until the server dies + (while muse-ipc-server-process (accept-process-output nil 1))) + +(provide 'muse-ipc) + +;;; muse-ipc.el ends here diff --git a/emacs.d/elisp/muse/muse-journal.el b/emacs.d/elisp/muse/muse-journal.el new file mode 100644 index 0000000..e523b4c --- /dev/null +++ b/emacs.d/elisp/muse/muse-journal.el @@ -0,0 +1,774 @@ +;;; muse-journal.el --- keep and publish a journal + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; The module facilitates the keeping and publication of a journal. +;; When publishing to HTML, it assumes the form of a web log, or blog. +;; +;; The input format for each entry is as follows: +;; +;; * 20040317: Title of entry +;; +;; Text for the entry. +;; +;; <qotd> +;; "You know who you are. It comes down to a simple gut check: You +;; either love what you do or you don't. Period." -- P. Bronson +;; </qotd> +;; +;; The "qotd", or Quote of the Day, is entirely optional. When +;; generated to HTML, this entry is rendered as: +;; +;; <div class="entry"> +;; <div class="entry-qotd"> +;; <h3>Quote of the Day:</h3> +;; <p>"You know who you are. It comes down to a simple gut +;; check: You either love what you do or you don't. Period." +;; -- P. Bronson</p> +;; </div> +;; <div class="entry-body"> +;; <div class="entry-head"> +;; <div class="entry-date"> +;; <span class="date">March 17, 2004</span> +;; </div> +;; <div class="entry-title"> +;; <h2>Title of entry</h2> +;; </div> +;; </div> +;; <div class="entry-text"> +;; <p>Text for the entry.</p> +;; </div> +;; </div> +;; </div> +;; +;; The plurality of "div" tags makes it possible to display the +;; entries in any form you wish, using a CSS style. +;; +;; Also, an .RDF file can be generated from your journal by publishing +;; it with the "rdf" style. It uses the first two sentences of the +;; first paragraph of each entry as its "description", and +;; autogenerates tags for linking to the various entries. + +;;; Contributors: + +;; René Stadler (mail AT renestadler DOT de) provided a patch that +;; causes dates in RSS feeds to be generated in a format that RSS +;; readers can parse. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Journal Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) +(require 'muse-html) +(require 'muse-latex) +(require 'muse-book) + +(defgroup muse-journal nil + "Rules for transforming a journal into its final form." + :group 'muse-publish) + +(defcustom muse-journal-heading-regexp + "\\(?:\\([0-9]+\\)\\(?:: \\)?\\)?\\(.+?\\)?" + "A regexp that matches a journal heading. +Paren group 1 is the ISO date, group 2 is the optional category, +and group 3 is the optional heading for the entry." + :type 'regexp + :group 'muse-journal) + +(defcustom muse-journal-date-format "%a, %e %b %Y" + "Date format to use for journal entries." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-html-heading-regexp + (concat "^<h2[^>\n]*>" muse-journal-heading-regexp "</h2>$") + "A regexp that matches a journal heading from an HTML document. +Paren group 1 is the ISO date, group 2 is the optional category, +and group 3 is the optional heading for the entry." + :type 'regexp + :group 'muse-journal) + +(defcustom muse-journal-rss-heading-regexp + (concat "^\\* " muse-journal-heading-regexp "$") + "A regexp that matches a journal heading from an HTML document. +Paren group 1 is the ISO date, group 2 is the optional category, +and group 3 is the optional heading for the entry." + :type 'regexp + :group 'muse-journal) + +(defcustom muse-journal-html-entry-template + "<div class=\"entry\"> + <a name=\"%anchor%\" style=\"text-decoration: none\"> </a> + <div class=\"entry-body\"> + <div class=\"entry-head\"> + <div class=\"entry-date\"> + <span class=\"date\">%date%</span> + </div> + <div class=\"entry-title\"> + <h2>%title%</h2> + </div> + </div> + <div class=\"entry-text\"> + <div class=\"entry-qotd\"> + <p>%qotd%</p> + </div> +%text% + </div> + </div> +</div>\n\n" + "Template used to publish individual journal entries as HTML. +This may be text or a filename." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-latex-section + "\\section*{%title% \\hfill {\\normalsize %date%}} +\\addcontentsline{toc}{chapter}{%title%}" + "Template used to publish a LaTeX section." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-latex-subsection + "\\subsection*{%title%} +\\addcontentsline{toc}{section}{%title%}" + "Template used to publish a LaTeX subsection." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-markup-tags + '(("qotd" t nil nil muse-journal-qotd-tag)) + "A list of tag specifications, for specially marking up Journal entries. +See `muse-publish-markup-tags' for more info. + +This is used by journal-latex and its related styles, as well as +the journal-rss-entry style, which both journal-rdf and +journal-rss use." + :type '(repeat (list (string :tag "Markup tag") + (boolean :tag "Expect closing tag" :value t) + (boolean :tag "Parse attributes" :value nil) + (boolean :tag "Nestable" :value nil) + function)) + :group 'muse-journal) + +;; FIXME: This doesn't appear to be used. +(defun muse-journal-generate-pages () + (let ((output-dir (muse-style-element :path))) + (goto-char (point-min)) + (while (re-search-forward muse-journal-heading-regexp nil t) + (let* ((date (match-string 1)) + (category (match-string 1)) + (category-file (concat output-dir category "/index.html")) + (heading (match-string 1))) + t)))) + +(defcustom muse-journal-rdf-extension ".rdf" + "Default file extension for publishing RDF (RSS 1.0) files." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rdf-base-url "" + "The base URL of the website referenced by the RDF file." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rdf-header + "<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\" + xmlns=\"http://purl.org/rss/1.0/\" + xmlns:dc=\"http://purl.org/dc/elements/1.1/\"> + <channel rdf:about=\"<lisp>(concat (muse-style-element :base-url) + (muse-publish-link-name))</lisp>\"> + <title><lisp>(muse-publishing-directive \"title\")</lisp></title> + <link><lisp>(concat (muse-style-element :base-url) + (concat (muse-page-name) + muse-html-extension))</lisp></link> + <description><lisp>(muse-publishing-directive \"desc\")</lisp></description> + <items> + <rdf:Seq> + <rdf:li resource=\"<lisp> + (concat (muse-style-element :base-url) + (concat (muse-page-name) + muse-html-extension))</lisp>\"/> + </rdf:Seq> + </items> + </channel>\n" + "Header used for publishing RDF (RSS 1.0) files. +This may be text or a filename." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rdf-footer + "</rdf:RDF>\n" + "Footer used for publishing RDF (RSS 1.0) files. +This may be text or a filename." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rdf-date-format + "%Y-%m-%dT%H:%M:%S" + "Date format to use for RDF entries." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rdf-entry-template + "\n <item rdf:about=\"%link%#%anchor%\"> + <title>%title%</title> + <description> + %desc% + </description> + <link>%link%#%anchor%</link> + <dc:date>%date%</dc:date> + <dc:creator>%maintainer%</dc:creator> + </item>\n" + "Template used to publish individual journal entries as RDF. +This may be text or a filename." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rdf-summarize-entries nil + "If non-nil, include only summaries in the RDF file, not the full data. + +The default is nil, because this annoys some subscribers." + :type 'boolean + :group 'muse-journal) + +(defcustom muse-journal-rss-extension ".xml" + "Default file extension for publishing RSS 2.0 files." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rss-base-url "" + "The base URL of the website referenced by the RSS file." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rss-header + "<\?xml version=\"1.0\" encoding=\"<lisp> + (muse-html-encoding)</lisp>\"?> +<rss version=\"2.0\"> + <channel> + <title><lisp>(muse-publishing-directive \"title\")</lisp></title> + <link><lisp>(concat (muse-style-element :base-url) + (concat (muse-page-name) + muse-html-extension))</lisp></link> + <description><lisp>(muse-publishing-directive \"desc\")</lisp></description> + <language>en-us</language> + <generator>Emacs Muse</generator>\n\n" + "Header used for publishing RSS 2.0 files. This may be text or a filename." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rss-footer + "\n\n </channel> +</rss>\n" + "Footer used for publishing RSS 2.0 files. This may be text or a filename." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rss-date-format + "%a, %d %b %Y %H:%M:%S %Z" + "Date format to use for RSS 2.0 entries." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rss-entry-template + "\n <item> + <title>%title%</title> + <link>%link%#%anchor%</link> + <description>%desc%</description> + <author><lisp>(muse-publishing-directive \"author\")</lisp></author> + <pubDate>%date%</pubDate> + <guid>%link%#%anchor%</guid> + %enclosure% + </item>\n" + "Template used to publish individual journal entries as RSS 2.0. +This may be text or a filename." + :type 'string + :group 'muse-journal) + +(defcustom muse-journal-rss-enclosure-types-alist + '(("mp3" . "audio/mpeg")) + "File types that are accepted as RSS enclosures. +This is an alist that maps file extension to content type. +Useful for podcasting." + :type '(alist :key-type string :value-type string) + :group 'muse-journal) + +(defcustom muse-journal-rss-summarize-entries nil + "If non-nil, include only summaries in the RSS file, not the full data. + +The default is nil, because this annoys some subscribers." + :type 'boolean + :group 'muse-journal) + +(defcustom muse-journal-rss-markup-regexps + '((10000 muse-explicit-link-regexp 0 "\\2")) + "List of markup rules for publishing a Muse journal page to RSS 2.0. +For more information on the structure of this list, see +`muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-journal) + +(defcustom muse-journal-rss-markup-functions + '((email . ignore) + (link . ignore) + (url . ignore)) + "An alist of style types to custom functions for that kind of text. +For more on the structure of this list, see +`muse-publish-markup-functions'." + :type '(alist :key-type symbol :value-type function) + :group 'muse-journal) + +(defun muse-journal-anchorize-title (title) + "This strips tags from TITLE, truncates TITLE at begin parenthesis, +and escapes any remaining non-alphanumeric characters." + (save-match-data + (if (string-match "(" title) + (setq title (substring title 0 (match-beginning 0)))) + (if (string-match "<[^>]+>" title) + (setq title (replace-match "" nil nil title))) + (let (pos code len ch) + (while (setq pos (string-match (concat "[^" muse-regexp-alnum "_]") + title pos)) + (setq ch (aref title pos) + code (format "%%%02X" (cond ((fboundp 'char-to-ucs) + (char-to-ucs ch)) + ((fboundp 'char-to-int) + (char-to-int ch)) + (t ch))) + len (length code) + title (concat (substring title 0 pos) + code + (when (< pos (length title)) + (substring title (1+ pos) nil))) + pos (+ len pos))) + title))) + +(defun muse-journal-sort-entries (&optional direction) + (interactive "P") + (sort-subr + direction + (function + (lambda () + (if (re-search-forward "^\\* [0-9]+" nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max))))) + (function + (lambda () + (if (re-search-forward "^\\* [0-9]+" nil t) + (goto-char (1- (match-beginning 0))) + (goto-char (point-max))))) + (function + (lambda () + (forward-char 2))) + (function + (lambda () + (end-of-line))))) + +(defun muse-journal-qotd-tag (beg end) + (muse-publish-ensure-block beg end) + (muse-insert-markup (muse-markup-text 'begin-quote)) + (muse-insert-markup (muse-markup-text 'begin-quote-item)) + (goto-char end) + (muse-insert-markup (muse-markup-text 'end-quote-item)) + (muse-insert-markup (muse-markup-text 'end-quote))) + +(defun muse-journal-html-munge-buffer () + (goto-char (point-min)) + (let ((heading-regexp muse-journal-html-heading-regexp) + (inhibit-read-only t)) + (while (re-search-forward heading-regexp nil t) + (let* ((date (match-string 1)) + (orig-date date) + (title (match-string 2)) + (clean-title title) + datestamp qotd text) + (delete-region (match-beginning 0) (match-end 0)) + (if clean-title + (save-match-data + (while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title) + (setq clean-title (replace-match "" nil nil clean-title))))) + (save-match-data + (when (and date + (string-match + (concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?" + "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date)) + (setq datestamp + (encode-time + 0 0 0 + (string-to-number (match-string 3 date)) + (string-to-number (match-string 2 date)) + (string-to-number (match-string 1 date)) + nil) + date (concat (format-time-string + muse-journal-date-format datestamp) + (substring date (match-end 0)))))) + (save-restriction + (narrow-to-region + (point) (if (re-search-forward + (concat "\\(^<hr>$\\|" + heading-regexp "\\)") nil t) + (match-beginning 0) + (point-max))) + (goto-char (point-max)) + (while (and (not (bobp)) + (eq ?\ (char-syntax (char-before)))) + (delete-char -1)) + (goto-char (point-min)) + (while (and (not (eobp)) + (eq ?\ (char-syntax (char-after)))) + (delete-char 1)) + (save-excursion + (when (search-forward "<qotd>" nil t) + (let ((tag-beg (match-beginning 0)) + (beg (match-end 0)) + end) + (re-search-forward "</qotd>\n*") + (setq end (point-marker)) + (save-restriction + (narrow-to-region beg (match-beginning 0)) + (muse-publish-escape-specials (point-min) (point-max) + nil 'document) + (setq qotd (buffer-substring-no-properties + (point-min) (point-max)))) + (delete-region tag-beg end) + (set-marker end nil)))) + (setq text (buffer-string)) + (delete-region (point-min) (point-max)) + (let ((entry muse-journal-html-entry-template)) + (muse-insert-file-or-string entry) + (muse-publish-mark-read-only (point-min) (point-max)) + (goto-char (point-min)) + (while (search-forward "%date%" nil t) + (remove-text-properties (match-beginning 0) (match-end 0) + '(read-only nil rear-nonsticky nil)) + (replace-match (or date "") nil t)) + (goto-char (point-min)) + (while (search-forward "%title%" nil t) + (remove-text-properties (match-beginning 0) (match-end 0) + '(read-only nil rear-nonsticky nil)) + (replace-match (or title " ") nil t)) + (goto-char (point-min)) + (while (search-forward "%anchor%" nil t) + (replace-match (muse-journal-anchorize-title + (or clean-title orig-date)) + nil t)) + (goto-char (point-min)) + (while (search-forward "%qotd%" nil t) + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + (delete-region (point-min) (point-max)) + (when qotd (muse-insert-markup qotd)))) + (goto-char (point-min)) + (while (search-forward "%text%" nil t) + (remove-text-properties (match-beginning 0) (match-end 0) + '(read-only nil rear-nonsticky nil)) + (replace-match text nil t)) + (when (null qotd) + (goto-char (point-min)) + (when (search-forward "<div class=\"entry-qotd\">" nil t) + (let ((beg (match-beginning 0))) + (re-search-forward "</div>\n*" nil t) + (delete-region beg (point)))))))))) + ;; indicate that we are to continue the :before-end processing + nil) + +(defun muse-journal-latex-munge-buffer () + (goto-char (point-min)) + (let ((heading-regexp + (concat "^" (regexp-quote (muse-markup-text 'section)) + muse-journal-heading-regexp + (regexp-quote (muse-markup-text 'section-end)) "$")) + (inhibit-read-only t)) + (when (re-search-forward heading-regexp nil t) + (goto-char (match-beginning 0)) + (sort-subr nil + (function + (lambda () + (if (re-search-forward heading-regexp nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max))))) + (function + (lambda () + (if (re-search-forward heading-regexp nil t) + (goto-char (1- (match-beginning 0))) + (goto-char (point-max))))) + (function + (lambda () + (forward-char 2))) + (function + (lambda () + (end-of-line))))) + (while (re-search-forward heading-regexp nil t) + (let ((date (match-string 1)) + (title (match-string 2)) + ;; FIXME: Nothing is done with qotd + qotd section) + (save-match-data + (when (and date + (string-match + (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?" + "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date)) + (setq date (encode-time + 0 0 0 + (string-to-number (match-string 3 date)) + (string-to-number (match-string 2 date)) + (string-to-number (match-string 1 date)) + nil) + date (format-time-string + muse-journal-date-format date)))) + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + (delete-region (point-min) (point-max)) + (muse-insert-markup muse-journal-latex-section) + (goto-char (point-min)) + (while (search-forward "%title%" nil t) + (replace-match (or title "Untitled") nil t)) + (goto-char (point-min)) + (while (search-forward "%date%" nil t) + (replace-match (or date "") nil t)))))) + (goto-char (point-min)) + (let ((subheading-regexp + (concat "^" (regexp-quote (muse-markup-text 'subsection)) + "\\([^\n}]+\\)" + (regexp-quote (muse-markup-text 'subsection-end)) "$")) + (inhibit-read-only t)) + (while (re-search-forward subheading-regexp nil t) + (let ((title (match-string 1))) + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + (delete-region (point-min) (point-max)) + (muse-insert-markup muse-journal-latex-subsection) + (goto-char (point-min)) + (while (search-forward "%title%" nil t) + (replace-match title nil t)))))) + ;; indicate that we are to continue the :before-end processing + nil) + +(defun muse-journal-rss-munge-buffer () + (goto-char (point-min)) + (let ((heading-regexp muse-journal-rss-heading-regexp) + (inhibit-read-only t)) + (while (re-search-forward heading-regexp nil t) + (let* ((date (match-string 1)) + (orig-date date) + (title (match-string 2)) + ;; FIXME: Nothing is done with qotd + enclosure qotd desc) + (if title + (save-match-data + (if (string-match muse-explicit-link-regexp title) + (setq enclosure (muse-get-link title) + title (muse-get-link-desc title))))) + (save-match-data + (when (and date + (string-match + (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?" + "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date)) + (setq date (encode-time 0 0 0 + (string-to-number (match-string 3 date)) + (string-to-number (match-string 2 date)) + (string-to-number (match-string 1 date)) + nil) + ;; make sure that date is in a format that RSS + ;; readers can handle + date (let ((system-time-locale "C")) + (format-time-string + (muse-style-element :date-format) date))))) + (save-restriction + (narrow-to-region + (match-beginning 0) + (if (re-search-forward heading-regexp nil t) + (match-beginning 0) + (if (re-search-forward "^Footnotes:" nil t) + (match-beginning 0) + (point-max)))) + (goto-char (point-min)) + (delete-region (point) (muse-line-end-position)) + (re-search-forward "</qotd>\n+" nil t) + (while (and (char-after) + (eq ?\ (char-syntax (char-after)))) + (delete-char 1)) + (let ((beg (point))) + (if (muse-style-element :summarize) + (progn + (forward-sentence 2) + (setq desc (concat (buffer-substring beg (point)) "..."))) + (save-restriction + (muse-publish-markup-buffer "rss-entry" "journal-rss-entry") + (goto-char (point-min)) + (if (re-search-forward "Page published by Emacs Muse" nil t) + (goto-char (muse-line-end-position)) + (muse-display-warning + (concat + "Cannot find 'Page published by Emacs Muse begins here'.\n" + "You will probably need this text in your header.")) + (goto-char (point-min))) + (setq beg (point)) + (if (re-search-forward "Page published by Emacs Muse" nil t) + (goto-char (muse-line-beginning-position)) + (muse-display-warning + (concat + "Cannot find 'Page published by Emacs Muse ends here'.\n" + "You will probably need this text in your footer.")) + (goto-char (point-max))) + (setq desc (buffer-substring beg (point)))))) + (unless (string= desc "") + (setq desc (concat "<![CDATA[" desc "]]>"))) + (delete-region (point-min) (point-max)) + (let ((entry (muse-style-element :entry-template))) + (muse-insert-file-or-string entry) + (goto-char (point-min)) + (while (search-forward "%date%" nil t) + (replace-match (or date "") nil t)) + (goto-char (point-min)) + (while (search-forward "%title%" nil t) + (replace-match "") + (save-restriction + (narrow-to-region (point) (point)) + (insert (or title "Untitled")) + (remove-text-properties (match-beginning 0) (match-end 0) + '(read-only nil rear-nonsticky nil)) + (let ((muse-publishing-current-style (muse-style "html"))) + (muse-publish-escape-specials (point-min) (point-max) + nil 'document)))) + (goto-char (point-min)) + (while (search-forward "%desc%" nil t) + (replace-match desc nil t)) + (goto-char (point-min)) + (while (search-forward "%enclosure%" nil t) + (replace-match + (if (null enclosure) + "" + (save-match-data + (format + "<enclosure url=\"%s\" %stype=\"%s\"/>" + (if (string-match "//" enclosure) + enclosure + (concat (muse-style-element :base-url) + enclosure)) + (let ((file + (expand-file-name enclosure + (muse-style-element :path)))) + (if (file-readable-p file) + (format "length=\"%d\" " + (nth 7 (file-attributes file))) + "")) + (if (string-match "\\.\\([^.]+\\)$" enclosure) + (let* ((ext (match-string 1 enclosure)) + (type + (assoc + ext muse-journal-rss-enclosure-types-alist))) + (if type + (cdr type) + "application/octet-stream")))))) + nil t)) + (goto-char (point-min)) + (while (search-forward "%link%" nil t) + (replace-match + (concat (muse-style-element :base-url) + (concat (muse-page-name) + muse-html-extension)) + nil t)) + (goto-char (point-min)) + (while (search-forward "%anchor%" nil t) + (replace-match + (muse-journal-anchorize-title (or title orig-date)) + nil t)) + (goto-char (point-min)) + (while (search-forward "%maintainer%" nil t) + (replace-match + (or (muse-style-element :maintainer) + (concat "webmaster@" (system-name))) + nil t))))))) + ;; indicate that we are to continue the :before-end processing + nil) + + +;;; Register the Muse Journal Publishers + +(muse-derive-style "journal-html" "html" + :before-end 'muse-journal-html-munge-buffer) + +(muse-derive-style "journal-xhtml" "xhtml" + :before-end 'muse-journal-html-munge-buffer) + +(muse-derive-style "journal-latex" "latex" + :tags 'muse-journal-markup-tags + :before-end 'muse-journal-latex-munge-buffer) + +(muse-derive-style "journal-pdf" "pdf" + :tags 'muse-journal-markup-tags + :before-end 'muse-journal-latex-munge-buffer) + +(muse-derive-style "journal-book-latex" "book-latex" + ;;:nochapters + :tags 'muse-journal-markup-tags + :before-end 'muse-journal-latex-munge-buffer) + +(muse-derive-style "journal-book-pdf" "book-pdf" + ;;:nochapters + :tags 'muse-journal-markup-tags + :before-end 'muse-journal-latex-munge-buffer) + +(muse-define-style "journal-rdf" + :suffix 'muse-journal-rdf-extension + :regexps 'muse-journal-rss-markup-regexps + :functions 'muse-journal-rss-markup-functions + :before 'muse-journal-rss-munge-buffer + :header 'muse-journal-rdf-header + :footer 'muse-journal-rdf-footer + :date-format 'muse-journal-rdf-date-format + :entry-template 'muse-journal-rdf-entry-template + :base-url 'muse-journal-rdf-base-url + :summarize 'muse-journal-rdf-summarize-entries) + +(muse-define-style "journal-rss" + :suffix 'muse-journal-rss-extension + :regexps 'muse-journal-rss-markup-regexps + :functions 'muse-journal-rss-markup-functions + :before 'muse-journal-rss-munge-buffer + :header 'muse-journal-rss-header + :footer 'muse-journal-rss-footer + :date-format 'muse-journal-rss-date-format + :entry-template 'muse-journal-rss-entry-template + :base-url 'muse-journal-rss-base-url + :summarize 'muse-journal-rss-summarize-entries) + +;; Used by `muse-journal-rss-munge-buffer' to mark up individual entries +(muse-derive-style "journal-rss-entry" "html" + :tags 'muse-journal-markup-tags) + +(provide 'muse-journal) + +;;; muse-journal.el ends here diff --git a/emacs.d/elisp/muse/muse-latex.el b/emacs.d/elisp/muse/muse-latex.el new file mode 100644 index 0000000..e416367 --- /dev/null +++ b/emacs.d/elisp/muse/muse-latex.el @@ -0,0 +1,669 @@ +;;; muse-latex.el --- publish entries in LaTex or PDF format + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;; Li Daobing (lidaobing AT gmail DOT com) provided CJK support. + +;; Trent Buck (trentbuck AT gmail DOT com) gave valuable advice for +;; how to treat LaTeX specials and the like. + +;; Matthias Kegelmann (mathias DOT kegelmann AT sdm DOT de) provided a +;; scenario where we would need to respect the <contents> tag. + +;; Jean Magnan de Bornier (jean AT bornier DOT net) provided the +;; markup string for link-and-anchor. + +;; Jim Ottaway (j DOT ottaway AT lse DOT ac DOT uk) implemented slides +;; and lecture notes. + +;; Karl Berry (karl AT freefriends DOT org) suggested how to escape +;; additional special characters in image filenames. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse LaTeX Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) + +(defgroup muse-latex nil + "Rules for marking up a Muse file as a LaTeX article." + :group 'muse-publish) + +(defcustom muse-latex-extension ".tex" + "Default file extension for publishing LaTeX files." + :type 'string + :group 'muse-latex) + +(defcustom muse-latex-pdf-extension ".pdf" + "Default file extension for publishing LaTeX files to PDF." + :type 'string + :group 'muse-latex) + +(defcustom muse-latex-pdf-browser "open %s" + "The program to use when browsing a published PDF file. +This should be a format string." + :type 'string + :group 'muse-latex) + +(defcustom muse-latex-pdf-program "pdflatex" + "The program that is called to generate PDF content from LaTeX content." + :type 'string + :group 'muse-latex) + +(defcustom muse-latex-pdf-cruft + '(".aux" ".log" ".nav" ".out" ".snm" ".toc" ".vrb") + "Extensions of files to remove after generating PDF output successfully." + :type 'string + :group 'muse-latex) + +(defcustom muse-latex-header + "\\documentclass{article} + +\\usepackage[english]{babel} +\\usepackage{ucs} +\\usepackage[utf8x]{inputenc} +\\usepackage[T1]{fontenc} +\\usepackage{hyperref} +\\usepackage[pdftex]{graphicx} + +\\def\\museincludegraphics{% + \\begingroup + \\catcode`\\|=0 + \\catcode`\\\\=12 + \\catcode`\\#=12 + \\includegraphics[width=0.75\\textwidth] +} + +\\begin{document} + +\\title{<lisp>(muse-publish-escape-specials-in-string + (muse-publishing-directive \"title\") 'document)</lisp>} +\\author{<lisp>(muse-publishing-directive \"author\")</lisp>} +\\date{<lisp>(muse-publishing-directive \"date\")</lisp>} + +\\maketitle + +<lisp>(and muse-publish-generate-contents + (not muse-latex-permit-contents-tag) + \"\\\\tableofcontents\n\\\\newpage\")</lisp>\n\n" + "Header used for publishing LaTeX files. This may be text or a filename." + :type 'string + :group 'muse-latex) + +(defcustom muse-latex-footer "<lisp>(muse-latex-bibliography)</lisp> +\\end{document}\n" + "Footer used for publishing LaTeX files. This may be text or a filename." + :type 'string + :group 'muse-latex) + +(defcustom muse-latexcjk-header + "\\documentclass{article} + +\\usepackage{CJK} +\\usepackage{indentfirst} +\\usepackage[CJKbookmarks=true]{hyperref} +\\usepackage[pdftex]{graphicx} + +\\begin{document} +\\begin{CJK*}<lisp>(muse-latexcjk-encoding)</lisp> + +\\title{<lisp>(muse-publish-escape-specials-in-string + (muse-publishing-directive \"title\") 'document)</lisp>} +\\author{<lisp>(muse-publishing-directive \"author\")</lisp>} +\\date{<lisp>(muse-publishing-directive \"date\")</lisp>} + +\\maketitle + +<lisp>(and muse-publish-generate-contents + (not muse-latex-permit-contents-tag) + \"\\\\tableofcontents\n\\\\newpage\")</lisp>\n\n" + "Header used for publishing LaTeX files (CJK). This may be text or a +filename." + :type 'string + :group 'muse-latex) + +(defcustom muse-latexcjk-footer + "\n\\end{CJK*} +\\end{document}\n" + "Footer used for publishing LaTeX files (CJK). This may be text or a +filename." + :type 'string + :group 'muse-latex) + +(defcustom muse-latex-slides-header + "\\documentclass[ignorenonframetext]{beamer} + +\\usepackage[english]{babel} +\\usepackage{ucs} +\\usepackage[utf8x]{inputenc} +\\usepackage[T1]{fontenc} +\\usepackage{hyperref} + +\\def\\museincludegraphics{% + \\begingroup + \\catcode`\\|=0 + \\catcode`\\\\=12 + \\catcode`\\#=12 + \\includegraphics[width=0.50\\textwidth] +} + +\\title{<lisp>(muse-publish-escape-specials-in-string + (muse-publishing-directive \"title\") 'document)</lisp>} +\\author{<lisp>(muse-publishing-directive \"author\")</lisp>} +\\date{<lisp>(muse-publishing-directive \"date\")</lisp>} + +\\begin{document} + +\\frame{\\titlepage} + +<lisp>(and muse-publish-generate-contents + \"\\\\frame{\\\\tableofcontents}\")</lisp>\n\n" + "Header for publishing of slides using LaTeX. +This may be text or a filename. + +You must have the Beamer extension for LaTeX installed for this to work." + :type 'string + :group 'muse-latex) + +(defcustom muse-latex-lecture-notes-header + "\\documentclass{article} +\\usepackage{beamerarticle} + +\\usepackage[english]{babel} +\\usepackage{ucs} +\\usepackage[utf8x]{inputenc} +\\usepackage[T1]{fontenc} +\\usepackage{hyperref} +\\usepackage[pdftex]{graphicx} + +\\def\\museincludegraphics{% + \\begingroup + \\catcode`\\|=0 + \\catcode`\\\\=12 + \\catcode`\\#=12 + \\includegraphics[width=0.50\\textwidth] +} + +\\title{<lisp>(muse-publish-escape-specials-in-string + (muse-publishing-directive \"title\") 'document)</lisp>} +\\author{<lisp>(muse-publishing-directive \"author\")</lisp>} +\\date{<lisp>(muse-publishing-directive \"date\")</lisp>} + +\\begin{document} + +\\frame{\\titlepage} + +<lisp>(and muse-publish-generate-contents + \"\\\\frame{\\\\tableofcontents}\")</lisp>\n\n" + "Header for publishing of lecture notes using LaTeX. +This may be text or a filename. + +You must have the Beamer extension for LaTeX installed for this to work." + :type 'string + :group 'muse-latex) + +(defcustom muse-latex-markup-regexps + `(;; numeric ranges + (10000 "\\([0-9]+\\)-\\([0-9]+\\)" 0 "\\1--\\2") + + ;; be careful of closing quote pairs + (10100 "\"'" 0 "\"\\\\-'")) + "List of markup regexps for identifying regions in a Muse page. +For more on the structure of this list, see `muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-latex) + +(defcustom muse-latex-markup-functions + '((table . muse-latex-markup-table)) + "An alist of style types to custom functions for that kind of text. +For more on the structure of this list, see +`muse-publish-markup-functions'." + :type '(alist :key-type symbol :value-type function) + :group 'muse-latex) + +(defcustom muse-latex-markup-strings + '((image-with-desc . "\\begin{figure}[h] +\\centering\\museincludegraphics{%s.%s}|endgroup +\\caption{%s} +\\end{figure}") + (image . "\\begin{figure}[h] +\\centering\\museincludegraphics{%s.%s}|endgroup +\\end{figure}") + (image-link . "%% %s +\\museincludegraphics{%s.%s}|endgroup") + (anchor-ref . "\\ref{%s}") + (url . "\\url{%s}") + (url-and-desc . "\\href{%s}{%s}\\footnote{%1%}") + (link . "\\href{%s}{%s}\\footnote{%1%}") + (link-and-anchor . "\\href{%1%}{%3%}\\footnote{%1%}") + (email-addr . "\\verb|%s|") + (anchor . "\\label{%s}") + (emdash . "---") + (comment-begin . "% ") + (rule . "\\vspace{.5cm}\\hrule\\vspace{.5cm}") + (no-break-space . "~") + (line-break . "\\\\") + (enddots . "\\ldots{}") + (dots . "\\dots{}") + (part . "\\part{") + (part-end . "}") + (chapter . "\\chapter{") + (chapter-end . "}") + (section . "\\section{") + (section-end . "}") + (subsection . "\\subsection{") + (subsection-end . "}") + (subsubsection . "\\subsubsection{") + (subsubsection-end . "}") + (section-other . "\\paragraph{") + (section-other-end . "}") + (footnote . "\\footnote{") + (footnote-end . "}") + (footnotetext . "\\footnotetext[%d]{") + (begin-underline . "\\underline{") + (end-underline . "}") + (begin-literal . "\\texttt{") + (end-literal . "}") + (begin-emph . "\\emph{") + (end-emph . "}") + (begin-more-emph . "\\textbf{") + (end-more-emph . "}") + (begin-most-emph . "\\textbf{\\emph{") + (end-most-emph . "}}") + (begin-verse . "\\begin{verse}\n") + (end-verse-line . " \\\\") + (verse-space . "~~~~") + (end-verse . "\n\\end{verse}") + (begin-example . "\\begin{quote}\n\\begin{verbatim}") + (end-example . "\\end{verbatim}\n\\end{quote}") + (begin-center . "\\begin{center}\n") + (end-center . "\n\\end{center}") + (begin-quote . "\\begin{quote}\n") + (end-quote . "\n\\end{quote}") + (begin-cite . "\\cite{") + (begin-cite-author . "\\citet{") + (begin-cite-year . "\\citet{") + (end-cite . "}") + (begin-uli . "\\begin{itemize}\n") + (end-uli . "\n\\end{itemize}") + (begin-uli-item . "\\item ") + (begin-oli . "\\begin{enumerate}\n") + (end-oli . "\n\\end{enumerate}") + (begin-oli-item . "\\item ") + (begin-dl . "\\begin{description}\n") + (end-dl . "\n\\end{description}") + (begin-ddt . "\\item[") + (end-ddt . "] \\mbox{}\n")) + "Strings used for marking up text. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-latex) + +(defcustom muse-latex-slides-markup-tags + '(("slide" t t nil muse-latex-slide-tag)) + "A list of tag specifications, for specially marking up LaTeX slides." + :type '(repeat (list (string :tag "Markup tag") + (boolean :tag "Expect closing tag" :value t) + (boolean :tag "Parse attributes" :value nil) + (boolean :tag "Nestable" :value nil) + function)) + :group 'muse-latex) + +(defcustom muse-latexcjk-encoding-map + '((utf-8 . "{UTF8}{song}") + (japanese-iso-8bit . "[dnp]{JIS}{min}") + (chinese-big5 . "{Bg5}{bsmi}") + (mule-utf-8 . "{UTF8}{song}") + (chinese-iso-8bit . "{GB}{song}") + (chinese-gbk . "{GBK}{song}")) + "An alist mapping emacs coding systems to appropriate CJK codings. +Use the base name of the coding system (ie, without the -unix)." + :type '(alist :key-type coding-system :value-type string) + :group 'muse-latex) + +(defcustom muse-latexcjk-encoding-default "{GB}{song}" + "The default Emacs buffer encoding to use in published files. +This will be used if no special characters are found." + :type 'string + :group 'muse-latex) + +(defun muse-latexcjk-encoding () + (when (boundp 'buffer-file-coding-system) + (muse-latexcjk-transform-content-type buffer-file-coding-system))) + +(defun muse-latexcjk-transform-content-type (content-type) + "Using `muse-cjklatex-encoding-map', try and resolve an emacs coding +system to an associated CJK coding system." + (let ((match (and (fboundp 'coding-system-base) + (assoc (coding-system-base content-type) + muse-latexcjk-encoding-map)))) + (if match + (cdr match) + muse-latexcjk-encoding-default))) + +(defcustom muse-latex-markup-specials-document + '((?\\ . "\\textbackslash{}") + (?\_ . "\\textunderscore{}") + (?\< . "\\textless{}") + (?\> . "\\textgreater{}") + (?^ . "\\^{}") + (?\~ . "\\~{}") + (?\@ . "\\@") + (?\$ . "\\$") + (?\% . "\\%") + (?\{ . "\\{") + (?\} . "\\}") + (?\& . "\\&") + (?\# . "\\#")) + "A table of characters which must be represented specially. +These are applied to the entire document, sans already-escaped +regions." + :type '(alist :key-type character :value-type string) + :group 'muse-latex) + +(defcustom muse-latex-markup-specials-example + '() + "A table of characters which must be represented specially. +These are applied to <example> regions. + +With the default interpretation of <example> regions, no specials +need to be escaped." + :type '(alist :key-type character :value-type string) + :group 'muse-latex) + +(defcustom muse-latex-markup-specials-literal + '((?\n . "\\\n") + (?\\ . "\\textbackslash{}") + (?_ . "\\textunderscore{}") + (?\< . "\\textless{}") + (?\> . "\\textgreater{}") + (?^ . "\\^{}") + (?\~ . "\\~{}") + (?\$ . "\\$") + (?\% . "\\%") + (?\{ . "\\{") + (?\} . "\\}") + (?\& . "\\&") + (?\# . "\\#")) + "A table of characters which must be represented specially. +This applies to =monospaced text= and <code> regions." + :type '(alist :key-type character :value-type string) + :group 'muse-latex) + +(defcustom muse-latex-markup-specials-url + '((?\\ . "\\textbackslash{}") + (?\_ . "\\_") + (?\< . "\\<") + (?\> . "\\>") + (?\$ . "\\$") + (?\% . "\\%") + (?\{ . "\\{") + (?\} . "\\}") + (?\& . "\\&") + (?\# . "\\#")) + "A table of characters which must be represented specially. +These are applied to URLs." + :type '(alist :key-type character :value-type string) + :group 'muse-latex) + +(defcustom muse-latex-markup-specials-image + '((?\\ . "\\\\") + (?\< . "\\<") + (?\> . "\\>") + (?\$ . "\\$") + (?\% . "\\%") + (?\{ . "\\{") + (?\} . "\\}") + (?\& . "\\&") + (?\# . "\\#") + (?\| . "\\|")) + "A table of characters which must be represented specially. +These are applied to image filenames." + :type '(alist :key-type character :value-type string) + :group 'muse-latex) + +(defun muse-latex-decide-specials (context) + "Determine the specials to escape, depending on CONTEXT." + (cond ((memq context '(underline emphasis document url-desc verbatim + footnote)) + muse-latex-markup-specials-document) + ((eq context 'image) + muse-latex-markup-specials-image) + ((memq context '(email url)) + muse-latex-markup-specials-url) + ((eq context 'literal) + muse-latex-markup-specials-literal) + ((eq context 'example) + muse-latex-markup-specials-example) + (t (error "Invalid context '%s' in muse-latex" context)))) + +(defcustom muse-latex-permit-contents-tag nil + "If nil, ignore <contents> tags. Otherwise, insert table of contents. + +Most of the time, it is best to have a table of contents on the +first page, with a new page immediately following. To make this +work with documents published in both HTML and LaTeX, we need to +ignore the <contents> tag. + +If you don't agree with this, then set this option to non-nil, +and it will do what you expect." + :type 'boolean + :group 'muse-latex) + +(defun muse-latex-markup-table () + (let* ((table-info (muse-publish-table-fields (match-beginning 0) + (match-end 0))) + (row-len (car table-info)) + (field-list (cdr table-info))) + (when table-info + (muse-insert-markup "\\begin{tabular}{" (make-string row-len ?l) "}\n") + (dolist (fields field-list) + (let ((type (car fields))) + (setq fields (cdr fields)) + (if (eq type 'hline) + (muse-insert-markup "\\hline\n") + (when (= type 3) + (muse-insert-markup "\\hline\n")) + (insert (car fields)) + (setq fields (cdr fields)) + (dolist (field fields) + (muse-insert-markup " & ") + (insert field)) + (muse-insert-markup " \\\\\n") + (when (= type 2) + (muse-insert-markup "\\hline\n"))))) + (muse-insert-markup "\\end{tabular}")))) + +;;; Tags for LaTeX + +(defun muse-latex-slide-tag (beg end attrs) + "Publish the <slide> tag in LaTeX. +This is used by the slides and lecture-notes publishing styles." + (let ((title (cdr (assoc "title" attrs)))) + (goto-char beg) + (muse-insert-markup "\\begin{frame}[fragile]\n") + (when title + (muse-insert-markup "\\frametitle{") + (insert title) + (muse-insert-markup "}\n")) + (save-excursion + (goto-char end) + (muse-insert-markup "\n\\end{frame}")))) + +;;; Post-publishing functions + +(defun muse-latex-fixup-dquotes () + "Fixup double quotes." + (goto-char (point-min)) + (let ((open t)) + (while (search-forward "\"" nil t) + (unless (get-text-property (match-beginning 0) 'read-only) + (when (or (bobp) + (eq (char-before) ?\n)) + (setq open t)) + (if open + (progn + (replace-match "``") + (setq open nil)) + (replace-match "''") + (setq open t)))))) + +(defun muse-latex-fixup-citations () + "Replace semicolons in multi-head citations with colons." + (goto-char (point-min)) + (while (re-search-forward "\\\\cite.?{" nil t) + (let ((start (point)) + (end (re-search-forward "}"))) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward ";" nil t) + (replace-match ",")))))) + +(defun muse-latex-fixup-headings () + "Remove footnotes in headings, since LaTeX does not permit them to exist. + +This can happen if there is a link in a heading, because by +default Muse will add a footnote for each link." + (goto-char (point-min)) + (while (re-search-forward "^\\\\section.?{" nil t) + (save-restriction + (narrow-to-region (match-beginning 0) (muse-line-end-position)) + (goto-char (point-min)) + (while (re-search-forward "\\\\footnote{[^}\n]+}" nil t) + (replace-match "")) + (forward-line 1)))) + +(defun muse-latex-munge-buffer () + (muse-latex-fixup-dquotes) + (muse-latex-fixup-citations) + (muse-latex-fixup-headings) + (when (and muse-latex-permit-contents-tag + muse-publish-generate-contents) + (goto-char (car muse-publish-generate-contents)) + (muse-insert-markup "\\tableofcontents"))) + +(defun muse-latex-bibliography () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "\\\\cite.?{" nil t) + (concat + "\\bibliography{" + (muse-publishing-directive "bibsource") + "}\n") + ""))) + +(defun muse-latex-pdf-browse-file (file) + (shell-command (format muse-latex-pdf-browser file))) + +(defun muse-latex-pdf-generate (file output-path final-target) + (apply + #'muse-publish-transform-output + file output-path final-target "PDF" + (function + (lambda (file output-path) + (let* ((fnd (file-name-directory output-path)) + (command (format "%s \"%s\"" + muse-latex-pdf-program + (file-relative-name file fnd))) + (times 0) + (default-directory fnd) + result) + ;; XEmacs can sometimes return a non-number result. We'll err + ;; on the side of caution by continuing to attempt to generate + ;; the PDF if this happens and treat the final result as + ;; successful. + (while (and (< times 2) + (or (not (numberp result)) + (not (eq result 0)) + ;; table of contents takes 2 passes + (file-readable-p + (muse-replace-regexp-in-string + "\\.tex\\'" ".toc" file t t)))) + (setq result (shell-command command) + times (1+ times))) + (if (or (not (numberp result)) + (eq result 0)) + t + nil)))) + muse-latex-pdf-cruft)) + +;;; Register the Muse LATEX Publishers + +(muse-define-style "latex" + :suffix 'muse-latex-extension + :regexps 'muse-latex-markup-regexps + :functions 'muse-latex-markup-functions + :strings 'muse-latex-markup-strings + :specials 'muse-latex-decide-specials + :before-end 'muse-latex-munge-buffer + :header 'muse-latex-header + :footer 'muse-latex-footer + :browser 'find-file) + +(muse-derive-style "pdf" "latex" + :final 'muse-latex-pdf-generate + :browser 'muse-latex-pdf-browse-file + :link-suffix 'muse-latex-pdf-extension + :osuffix 'muse-latex-pdf-extension) + +(muse-derive-style "latexcjk" "latex" + :header 'muse-latexcjk-header + :footer 'muse-latexcjk-footer) + +(muse-derive-style "pdfcjk" "latexcjk" + :final 'muse-latex-pdf-generate + :browser 'muse-latex-pdf-browse-file + :link-suffix 'muse-latex-pdf-extension + :osuffix 'muse-latex-pdf-extension) + +(muse-derive-style "slides" "latex" + :header 'muse-latex-slides-header + :tags 'muse-latex-slides-markup-tags) + +(muse-derive-style "slides-pdf" "pdf" + :header 'muse-latex-slides-header + :tags 'muse-latex-slides-markup-tags) + +(muse-derive-style "lecture-notes" "slides" + :header 'muse-latex-lecture-notes-header) + +(muse-derive-style "lecture-notes-pdf" "slides-pdf" + :header 'muse-latex-lecture-notes-header) + +(provide 'muse-latex) + +;;; muse-latex.el ends here diff --git a/emacs.d/elisp/muse/muse-latex2png.el b/emacs.d/elisp/muse/muse-latex2png.el new file mode 100644 index 0000000..2b4373d --- /dev/null +++ b/emacs.d/elisp/muse/muse-latex2png.el @@ -0,0 +1,277 @@ +;; muse-latex2png.el --- generate PNG images from inline LaTeX code + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Michael Olson <mwolson@gnu.org> +;; Created: 12-Oct-2005 + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This was taken from latex2png.el, by Ganesh Swami <ganesh AT +;; iamganesh DOT com>, which was made for emacs-wiki. It has since +;; been extensively rewritten for Muse. + +;;; To do + +;; Remove stale image files. This could be done by making a function +;; for `muse-before-publish-hook' that deletes according to +;; (muse-page-name). + +;;; Code + +(require 'muse-publish) + +(defgroup muse-latex2png nil + "Publishing LaTeX formulas as PNG files." + :group 'muse-publish) + +(defcustom muse-latex2png-img-dest "./latex" + "The folder where the generated images will be placed. +This is relative to the current publishing directory." + :type 'string + :group 'muse-latex2png) + +(defcustom muse-latex2png-scale-factor 2.5 + "The scale factor to be used for sizing the resulting LaTeX output." + :type 'number + :group 'muse-latex2png) + +(defcustom muse-latex2png-fg "Black" + "The foreground color." + :type 'string + :group 'muse-latex2png) + +(defcustom muse-latex2png-bg "Transparent" + "The background color." + :type 'string + :group 'muse-latex2png) + +(defcustom muse-latex2png-template + "\\documentclass{article} +\\usepackage{fullpage} +\\usepackage{amssymb} +\\usepackage[usenames]{color} +\\usepackage{amsmath} +\\usepackage{latexsym} +\\usepackage[mathscr]{eucal} +%preamble% +\\pagestyle{empty} +\\begin{document} +{%code%} +\\end{document}\n" + "The LaTeX template to use." + :type 'string + :group 'muse-latex2png) + +(defun muse-latex2png-move2pubdir (file prefix pubdir) + "Move FILE to the PUBDIR folder. + +This is done so that the resulting images do not clutter your +main publishing directory. + +Old files with PREFIX in the name are deleted." + (when file + (if (file-exists-p file) + (progn + (unless (file-directory-p pubdir) + (message "Creating latex directory %s" pubdir) + (make-directory pubdir)) + (copy-file file (expand-file-name (file-name-nondirectory file) + pubdir) + t) + (delete-file file) + (concat muse-latex2png-img-dest "/" (file-name-nondirectory file))) + (message "Cannot find %s!" file)))) + +(defun muse-latex2png (code prefix preamble) + "Convert the LaTeX CODE into a png file beginning with PREFIX. +PREAMBLE indicates extra packages and definitions to include." + (unless preamble + (setq preamble "")) + (unless prefix + (setq prefix "muse-latex2png")) + (let* ((tmpdir (cond ((boundp 'temporary-file-directory) + temporary-file-directory) + ((fboundp 'temp-directory) + (temp-directory)) + (t "/tmp"))) + (texfile (expand-file-name + (concat prefix "__" (format "%d" (abs (sxhash code)))) + tmpdir)) + (defalt-directory default-directory)) + (with-temp-file (concat texfile ".tex") + (insert muse-latex2png-template) + (goto-char (point-min)) + (while (search-forward "%preamble%" nil t) + (replace-match preamble nil t)) + (goto-char (point-min)) + (while (search-forward "%code%" nil t) + (replace-match code nil t))) + (setq default-directory tmpdir) + (call-process "latex" nil nil nil texfile) + (if (file-exists-p (concat texfile ".dvi")) + (progn + (call-process + "dvipng" nil nil nil + "-E" + "-fg" muse-latex2png-fg + "-bg" muse-latex2png-bg + "-T" "tight" + "-x" (format "%s" (* muse-latex2png-scale-factor 1000)) + "-y" (format "%s" (* muse-latex2png-scale-factor 1000)) + "-o" (concat texfile ".png") + (concat texfile ".dvi")) + (if (file-exists-p (concat texfile ".png")) + (progn + (delete-file (concat texfile ".dvi")) + (delete-file (concat texfile ".tex")) + (delete-file (concat texfile ".aux")) + (delete-file (concat texfile ".log")) + (concat texfile ".png")) + (message "Failed to create png file") + nil)) + (message (concat "Failed to create dvi file " texfile)) + nil))) + +(defun muse-latex2png-region (beg end attrs) + "Generate an image for the Latex code between BEG and END. +If a Muse page is currently being published, replace the given +region with the appropriate markup that displays the image. +Otherwise, just return the path of the generated image. + +Valid keys for the ATTRS alist are as follows. + +prefix: The prefix given to the image file. +preamble: Extra text to add to the Latex preamble. +inline: Display image as inline, instead of a block." + (let ((end-marker (set-marker (make-marker) (1+ end))) + (pubdir (expand-file-name + muse-latex2png-img-dest + (file-name-directory muse-publishing-current-output-path)))) + (save-restriction + (narrow-to-region beg end) + (let* ((text (buffer-substring-no-properties beg end)) + ;; the prefix given to the image file. + (prefix (cdr (assoc "prefix" attrs))) + ;; preamble (for extra options) + (preamble (cdr (assoc "preamble" attrs))) + ;; display inline or as a block + (display (car (assoc "inline" attrs)))) + (when muse-publishing-p + (delete-region beg end) + (goto-char (point-min))) + (unless (file-directory-p pubdir) + (make-directory pubdir)) + (let ((path (muse-latex2png-move2pubdir + (muse-latex2png text prefix preamble) + prefix pubdir))) + (when path + (when muse-publishing-p + (muse-insert-markup + (if (muse-style-derived-p "html") + (concat "<img src=\"" path + "\" alt=\"latex2png equation\" " + (if display (concat "class=\"latex-inline\"") + (concat "class=\"latex-display\"")) + (if (muse-style-derived-p "xhtml") + " />" + ">") + (muse-insert-markup "<!-- " text "-->")) + (let ((ext (or (file-name-extension path) "")) + (path (muse-path-sans-extension path))) + (muse-markup-text 'image path ext)))) + (goto-char (point-max))) + path)))))) + +(defun muse-publish-latex-tag (beg end attrs) + "If the current style is not Latex-based, generate an image for the +given Latex code. Otherwise, don't do anything to the region. +See `muse-latex2png-region' for valid keys for ATTRS." + (unless (assoc "prefix" attrs) + (setq attrs (cons (cons "prefix" + (concat "latex2png-" (muse-page-name))) + attrs))) + (if (or (muse-style-derived-p "latex") (muse-style-derived-p "context")) + (muse-publish-mark-read-only beg end) + (muse-latex2png-region beg end attrs))) + +(put 'muse-publish-latex-tag 'muse-dangerous-tag t) + +(defun muse-publish-math-tag (beg end) + "Surround the given region with \"$\" characters. Then, if the +current style is not Latex-based, generate an image for the given +Latex math code. + +If 6 or more spaces come before the tag, and the end of the tag +is at the end of a line, then surround the region with the +equivalent of \"$$\" instead. This causes the region to be +centered in the published output, among other things." + (let* ((centered (and (re-search-backward + (concat "^[" muse-regexp-blank "]\\{6,\\}\\=") + nil t) + (save-excursion + (save-match-data + (goto-char end) + (looking-at (concat "[" muse-regexp-blank "]*$")))) + (prog1 t + (replace-match "") + (when (and (or (muse-style-derived-p "latex") + (muse-style-derived-p "context")) + (not (bobp))) + (backward-char 1) + (if (bolp) + (delete-char 1) + (forward-char 1))) + (setq beg (point))))) + (tag-beg (if centered + (if (muse-style-derived-p "context") + "\\startformula " "\\[ ") + "$")) + (tag-end (if centered + (if (muse-style-derived-p "context") + " \\stopformula" " \\]") + "$")) + (attrs (nconc (list (cons "prefix" + (concat "latex2png-" (muse-page-name)))) + (if centered nil + '(("inline" . t)))))) + (goto-char beg) + (muse-insert-markup tag-beg) + (goto-char end) + (muse-insert-markup tag-end) + (if (or (muse-style-derived-p "latex") (muse-style-derived-p "context")) + (muse-publish-mark-read-only beg (point)) + (muse-latex2png-region beg (point) attrs)))) + +(put 'muse-publish-math-tag 'muse-dangerous-tag t) + +;;; Insinuate with muse-publish + +(add-to-list 'muse-publish-markup-tags + '("latex" t t nil muse-publish-latex-tag) + t) + +(add-to-list 'muse-publish-markup-tags + '("math" t nil nil muse-publish-math-tag) + t) + +(provide 'muse-latex2png) +;;; muse-latex2png.el ends here diff --git a/emacs.d/elisp/muse/muse-mode.el b/emacs.d/elisp/muse/muse-mode.el new file mode 100644 index 0000000..9659843 --- /dev/null +++ b/emacs.d/elisp/muse/muse-mode.el @@ -0,0 +1,1013 @@ +;;; muse-mode.el --- mode for editing Muse files; has font-lock support + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; The Emacs Muse major mode is basically a hyped-up text-mode which +;; knows a lot more about the apparent structure of the document. + +;;; Contributors: + +;; Andrea Riciputi (ariciputi AT pito DOT com) gave an initial +;; implementation for tag completion by means of the `muse-insert-tag' +;; function. + +;; Per B. Sederberg (per AT med DOT upenn DOT edu) contributed the +;; insertion of relative links and list items, backlink searching, and +;; other things as well. + +;; Stefan Schlee (stefan_schlee AT yahoo DOT com) fixed a bug in +;; muse-next-reference and muse-previous-reference involving links +;; that begin at point 1. + +;; Gregory Collins (greg AT gregorycollins DOT net) fixed a bug with +;; paragraph separation and headings when filling. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Emacs Muse Major Mode +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(provide 'muse-mode) + +(require 'muse) +(require 'muse-regexps) +(require 'muse-project) + +(autoload 'muse-use-font-lock "muse-colors") +(autoload 'muse-publish-this-file "muse-publish") +(autoload 'muse-publish-get-style "muse-publish") +(autoload 'muse-publish-output-file "muse-publish") + +(require 'derived) +(eval-when-compile + (condition-case nil + (require 'pcomplete) ; load if available + (error nil))) + +;;; Options: + +(defgroup muse-mode nil + "Options controlling the behavior of the Muse editing Mode." + :group 'muse) + +(defcustom muse-mode-highlight-p t + "If non-nil, highlight the content of Muse buffers." + :type 'boolean + :require 'muse-colors + :group 'muse-mode) + +(defcustom muse-mode-auto-p nil + "If non-nil, automagically determine when Muse mode should be activated." + :type 'boolean + :set (function + (lambda (sym value) + (if value + (add-hook 'find-file-hooks 'muse-mode-maybe) + (remove-hook 'find-file-hooks 'muse-mode-maybe)) + (set sym value))) + :group 'muse-mode) + +(defun muse-mode-maybe-after-init () + (when muse-mode-auto-p + (add-hook 'find-file-hooks 'muse-mode-maybe))) + +;; If the user sets this value in their init file, make sure that +;; it takes effect +(add-hook 'after-init-hook 'muse-mode-maybe-after-init) + +(defcustom muse-mode-intangible-links nil + "If non-nil, use the intangible property on links. +This can cause problems with flyspell (and potentially fill-mode), +so only enable this if you don't use either of these." + :type 'boolean + :group 'muse-mode) + +(defcustom muse-mode-hook nil + "A hook that is run when Muse mode is entered." + :type 'hook + :options '(flyspell-mode footnote-mode turn-on-auto-fill + highlight-changes-mode) + :group 'muse-mode) + +(defcustom muse-grep-command + "find %D -type f ! -name '*~' | xargs -I {} echo \\\"{}\\\" | xargs egrep -n -e \"%W\"" + "The command to use when grepping for backlinks and other +searches through the muse projects. The string %D is replaced by +the directories from muse-project-alist, space-separated. The +string %W is replaced with the name of the muse page or whatever +else you are searching for. This command has been modified to +handle spaces in filenames, which were giving egrep a problem. + +Note: We highly recommend using glimpse to search large projects. +To use glimpse, install and edit a file called .glimpse_exclude +in your home directory. Put a list of glob patterns in that file +to exclude Emacs backup files, etc. Then, run the indexer using: + + glimpseindex -o <list of Wiki directories> + +Once that's completed, customize this variable to have the +following value: + + glimpse -nyi \"%W\" + +Your searches will go much, much faster, especially for very +large projects. Don't forget to add a user cronjob to update the +index at intervals." + :type 'string + :group 'muse-mode) + +(defvar muse-insert-map + (let ((map (make-sparse-keymap))) + (define-key map "l" 'muse-insert-relative-link-to-file) + (define-key map "t" 'muse-insert-tag) + (define-key map "u" 'muse-insert-url) + + map)) + +;;; Muse mode + +(defvar muse-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [(control ?c) (control ?a)] 'muse-index) + (define-key map [(control ?c) (control ?e)] 'muse-edit-link-at-point) + (define-key map [(control ?c) (control ?l)] 'font-lock-mode) + (define-key map [(control ?c) (control ?t)] + 'muse-project-publish-this-file) + (define-key map [(control ?c) (control ?T)] 'muse-publish-this-file) + (define-key map [(control ?c) (meta control ?t)] 'muse-publish-this-file) + (define-key map [(control ?c) (control ?v)] 'muse-browse-result) + + (define-key map [(control ?c) ?=] 'muse-what-changed) + + (define-key map [tab] 'muse-next-reference) + (define-key map [(control ?i)] 'muse-next-reference) + + (if (featurep 'xemacs) + (progn + (define-key map [(button2)] 'muse-follow-name-at-mouse) + (define-key map [(shift button2)] + 'muse-follow-name-at-mouse-other-window)) + (define-key map [(shift control ?m)] + 'muse-follow-name-at-point-other-window) + (define-key map [mouse-2] 'muse-follow-name-at-mouse) + (define-key map [(shift mouse-2)] + 'muse-follow-name-at-mouse-other-window)) + + (define-key map [(shift tab)] 'muse-previous-reference) + (unless (featurep 'xemacs) + (define-key map [(shift iso-lefttab)] 'muse-previous-reference) + (define-key map [(shift control ?i)] 'muse-previous-reference)) + + (define-key map [(control ?c) (control ?f)] 'muse-project-find-file) + (define-key map [(control ?c) (control ?p)] 'muse-project-publish) + + (define-key map [(control ?c) (control ?i)] 'muse-insert-thing) + (define-key map [(control ?c) tab] 'muse-insert-thing) + + ;; Searching functions + (define-key map [(control ?c) (control ?b)] 'muse-find-backlinks) + (define-key map [(control ?c) (control ?s)] 'muse-search) + + ;; Enhanced list functions + (define-key map [(meta return)] 'muse-insert-list-item) + (define-key map [(control ?>)] 'muse-increase-list-item-indentation) + (define-key map [(control ?<)] 'muse-decrease-list-item-indentation) + + (when (featurep 'pcomplete) + (define-key map [(meta tab)] 'pcomplete) + (define-key map [(meta control ?i)] 'pcomplete)) + + map) + "Keymap used by Emacs Muse mode.") + +;;;###autoload +(define-derived-mode muse-mode text-mode "Muse" + "Muse is an Emacs mode for authoring and publishing documents. +\\{muse-mode-map}" + ;; Since we're not inheriting from normal-mode, we need to + ;; explicitly run file variables. + (condition-case err + (hack-local-variables) + (error (message "File local-variables error: %s" + (prin1-to-string err)))) + ;; Avoid lock-up caused by use of the 'intangible' text property + ;; with flyspell. + (unless muse-mode-intangible-links + (set (make-local-variable 'inhibit-point-motion-hooks) t)) + (setq muse-current-project (muse-project-of-file)) + (muse-project-set-variables) + ;; Make fill not split up links + (when (boundp 'fill-nobreak-predicate) + (make-local-variable 'fill-nobreak-predicate) + ;; Work around annoying inconsistency in fill handling between + ;; Emacs 21 and 22. + (if (< emacs-major-version 22) + (setq fill-nobreak-predicate 'muse-mode-fill-nobreak-p) + (add-to-list 'fill-nobreak-predicate + 'muse-mode-fill-nobreak-p))) + ;; Make fill work nicely with item lists + (let ((regexp (concat "\\s-+\\(-\\|[0-9]+\\.\\)\\s-+" + "\\|\\[[0-9]+\\]\\s-*" + "\\|.*\\s-*::\\s-+" + "\\|\\*+\\s-+"))) + (set (make-local-variable 'adaptive-fill-regexp) + (concat regexp "\\|\\s-*")) + (set (make-local-variable 'paragraph-start) + (concat paragraph-start "\\|" regexp)) + (set (make-local-variable 'paragraph-separate) + (concat paragraph-separate "\\|\\*+\\s-+"))) + (set (make-local-variable 'fill-paragraph-function) + 'muse-mode-fill-paragraph) + + ;; Comment syntax is `; comment' + (set (make-local-variable 'comment-start) + "; ") + (set (make-local-variable 'comment-start-skip) + "^;\\s-+") + (set (make-local-variable 'indent-line-function) + #'ignore) + ;; If we're using Emacs21, this makes flyspell work like it should + (when (boundp 'flyspell-generic-check-word-p) + (set (make-local-variable 'flyspell-generic-check-word-p) + 'muse-mode-flyspell-p)) + ;; If pcomplete is available, set it up + (when (featurep 'pcomplete) + (set (make-local-variable 'pcomplete-default-completion-function) + 'muse-mode-completions) + (set (make-local-variable 'pcomplete-command-completion-function) + 'muse-mode-completions) + (set (make-local-variable 'pcomplete-parse-arguments-function) + 'muse-mode-current-word)) + ;; Initialize any auto-generated variables + (run-hooks 'muse-update-values-hook) + (when muse-mode-highlight-p + (muse-use-font-lock))) + +(put 'muse-mode + 'flyspell-mode-predicate + 'muse-mode-flyspell-p) + +(defun muse-mode-fill-nobreak-p () + "Return nil if we should allow a fill to occur at point. +Otherwise return non-nil. + +This is used to keep long explicit links from being mangled by +fill mode." + (save-excursion + (save-match-data + (and (re-search-backward "\\[\\[\\|\\]\\]" + (line-beginning-position) t) + (string= (or (match-string 0) "") + "[["))))) + +(defun muse-mode-fill-paragraph (arg) + "If a definition list is at point, use special filling rules for it. +Otherwise return nil to let the normal filling function take care +of things. + +ARG is passed to `fill-paragraph'." + (let ((count 2)) + (and (not (muse-mode-fill-nobreak-p)) + (save-excursion + (beginning-of-line) + (and (looking-at muse-dl-term-regexp) + (prog1 t + ;; Take initial whitespace into account + (when (looking-at (concat "[" muse-regexp-blank "]+")) + (setq count (+ count (length (match-string 0)))))))) + (let ((fill-prefix (make-string count ?\ )) + (fill-paragraph-function nil)) + (prog1 t + (fill-paragraph arg)))))) + +(defun muse-mode-flyspell-p () + "Return non-nil if we should allow spell-checking to occur at point. +Otherwise return nil. + +This is used to keep links from being improperly colorized by flyspell." + (let ((pos (if (bobp) (point) (1- (point))))) + (and (not (get-text-property pos 'muse-no-flyspell)) + (not (get-text-property pos 'muse-link)) + (save-match-data + (null (muse-link-at-point)))))) + +;;;###autoload +(defun muse-mode-choose-mode () + "Turn the proper Emacs Muse related mode on for this file." + (let ((project (muse-project-of-file))) + (funcall (or (and project (muse-get-keyword :major-mode (cadr project) t)) + 'muse-mode)))) + +(defun muse-mode-maybe () + "Maybe turn Emacs Muse mode on for this file." + (let ((project (muse-project-of-file))) + (and project + (funcall (or (muse-get-keyword :major-mode (cadr project) t) + 'muse-mode))))) + +;;; Enhanced list editing + +(defun muse-on-blank-line () + "See if point is on a blank line" + (save-excursion + (beginning-of-line) + (looking-at (concat "[" muse-regexp-blank "]*$")))) + +(defun muse-get-paragraph-start () + "Return the start of the current paragraph. This function will +return nil if there are no prior paragraphs and the beginning of +the line if point is on a blank line." + (let ((para-start (concat "^[" muse-regexp-blank "]*$"))) + ;; search back to start of paragraph + (save-excursion + (save-match-data + (if (not (muse-on-blank-line)) + (re-search-backward para-start nil t) + (line-beginning-position)))))) + +(defun muse-insert-thing () + "Prompt for something to insert into the current buffer." + (interactive) + (message "Insert:\nl link\nt Muse tag\nu URL") + (let (key cmd) + (let ((overriding-local-map muse-insert-map)) + (setq key (read-key-sequence nil))) + (if (commandp (setq cmd (lookup-key muse-insert-map key))) + (progn (message "") + (call-interactively cmd)) + (message "Not inserting anything")))) + +;;;###autoload +(defun muse-insert-list-item () + "Insert a list item at the current point, taking into account +your current list type and indentation level." + (interactive) + (let ((newitem " - ") + (itemno nil) + (pstart (muse-get-paragraph-start)) + (list-item (format muse-list-item-regexp + (concat "[" muse-regexp-blank "]*")))) + ;; search backwards for start of current item + (save-excursion + (when (re-search-backward list-item pstart t) + ;; save the matching item + (setq newitem (match-string 0)) + ;; see what type it is + (if (string-match "::" (match-string 0)) + ;; is a definition, replace the term + (setq newitem (concat " " + (read-string "Term: ") + " :: ")) + ;; see if it's a numbered list + (when (string-match "[0-9]+" newitem) + ;; is numbered, so increment + (setq itemno (1+ + (string-to-number + (match-string 0 newitem)))) + (setq newitem (replace-match + (number-to-string itemno) + nil nil newitem)))))) + ;; insert the new item + (insert (concat "\n" newitem)))) + +(defun muse-alter-list-item-indentation (operation) + "Alter the indentation of the current list item. +Valid values of OPERATION are 'increase and 'decrease." + (let ((pstart (muse-get-paragraph-start)) + (list-item (format muse-list-item-regexp + (concat "[" muse-regexp-blank "]*"))) + beg move-func indent) + ;; search backwards until start of paragraph to see if we are on a + ;; current item + (save-excursion + (if (or (progn (goto-char (muse-line-beginning-position)) + ;; we are on an item + (looking-at list-item)) + ;; not on item, so search backwards + (re-search-backward list-item pstart t)) + (let ((beg (point))) + ;; we are on an item + (setq indent (buffer-substring (match-beginning 0) + (match-beginning 1))) + (muse-forward-list-item (muse-list-item-type (match-string 1)) + (concat "[" muse-regexp-blank "]*") + t) + (save-restriction + (narrow-to-region beg (point)) + (goto-char (point-min)) + (let ((halt nil)) + (while (< (point) (point-max)) + ;; increase or decrease the indentation + (unless halt + (cond ((eq operation 'increase) + (insert " ")) + ((eq operation 'decrease) + (if (looking-at " ") + ;; we have enough space, so delete it + (delete-region (match-beginning 0) + (match-end 0)) + (setq halt t))))) + (forward-line 1))))) + ;; we are not on an item, so warn + (message "You are not on a list item."))))) + +;;;###autoload +(defun muse-increase-list-item-indentation () + "Increase the indentation of the current list item." + (interactive) + (muse-alter-list-item-indentation 'increase)) + +;;;###autoload +(defun muse-decrease-list-item-indentation () + "Decrease the indentation of the current list item." + (interactive) + (muse-alter-list-item-indentation 'decrease)) + +;;; Support page name completion using pcomplete + +(defun muse-mode-completions () + "Return a list of possible completions names for this buffer." + (let ((project (muse-project-of-file))) + (if project + (while (pcomplete-here + (mapcar 'car (muse-project-file-alist project))))))) + +(defun muse-mode-current-word () + (let ((end (point))) + (save-excursion + (save-restriction + (skip-chars-backward (concat "^\\[\n" muse-regexp-blank)) + (narrow-to-region (point) end)) + (pcomplete-parse-buffer-arguments)))) + +;;; Navigate/visit links or URLs. Use TAB, S-TAB and RET (or mouse-2). + +(defun muse-link-at-point (&optional pos) + "Return link text if a URL or link is at point." + (let ((case-fold-search nil) + (inhibit-point-motion-hooks t) + (here (or pos (point)))) + ;; if we are using muse-colors, we can just use link properties to + ;; determine whether we are on a link + (if (featurep 'muse-colors) + (when (get-text-property here 'muse-link) + (save-excursion + (when (and (not (bobp)) + (get-text-property (1- here) 'muse-link)) + (goto-char (or (previous-single-property-change here 'muse-link) + (point-min)))) + (if (looking-at muse-explicit-link-regexp) + (progn + (goto-char (match-beginning 1)) + (muse-handle-explicit-link)) + (muse-handle-implicit-link)))) + ;; use fallback method to find a link + (when (or (null pos) + (and (char-after pos) + (not (eq (char-syntax (char-after pos)) ?\ )))) + (save-excursion + (goto-char here) + ;; check for explicit link here or before point + (if (or (looking-at muse-explicit-link-regexp) + (and + (re-search-backward "\\[\\[\\|\\]\\]" + (muse-line-beginning-position) + t) + (string= (or (match-string 0) "") "[[") + (looking-at muse-explicit-link-regexp))) + (progn + (goto-char (match-beginning 1)) + (muse-handle-explicit-link)) + (goto-char here) + ;; check for bare URL or other link type + (skip-chars-backward (concat "^'\"<>{}(\n" muse-regexp-blank)) + (and (looking-at muse-implicit-link-regexp) + (muse-handle-implicit-link)))))))) + +(defun muse-make-link (link &optional desc) + "Return a link to LINK with DESC as the description." + (when (string-match muse-explicit-link-regexp link) + (unless desc (setq desc (muse-get-link-desc link))) + (setq link (muse-get-link link))) + (if (and desc + link + (not (string= desc "")) + (not (string= link desc))) + (concat "[[" (muse-link-escape link) "][" (muse-link-escape desc) "]]") + (concat "[[" (or (muse-link-escape link) "") "]]"))) + +;;;###autoload +(defun muse-insert-relative-link-to-file () + "Insert a relative link to a file, with optional description, at point." + ;; Perhaps the relative location should be configurable, so that the + ;; file search would start in the publishing directory and then + ;; insert the link relative to the publishing directory + (interactive) + (insert + (muse-make-link (file-relative-name (read-file-name "Link: ")) + (read-string "Text: ")))) + +(defcustom muse-insert-url-initial-input "http://" + "The string to insert before reading a URL interactively. +This is used by the `muse-insert-url' command." + :type 'string + :group 'muse-mode) + +(defun muse-insert-url () + "Insert a URL, with optional description, at point." + (interactive) + (insert + (muse-make-link (read-string "URL: " muse-insert-url-initial-input) + (read-string "Text: ")))) + +;;;###autoload +(defun muse-edit-link-at-point () + "Edit the current link. +Do not rename the page originally referred to." + (interactive) + (if (muse-link-at-point) + (let ((link (muse-link-unescape (muse-get-link))) + (desc (muse-link-unescape (muse-get-link-desc)))) + (replace-match + (save-match-data + (muse-make-link + (read-string "Link: " link) + (read-string "Text: " desc))) + t t)) + (error "There is no valid link at point"))) + +(defun muse-visit-link-default (link &optional other-window) + "Visit the URL or link named by LINK. +If ANCHOR is specified, search for it after opening LINK. + +This is the default function to call when visiting links; it is +used by `muse-visit-link' if you have not specified :visit-link +in `muse-project-alist'." + (if (string-match muse-url-regexp link) + (muse-browse-url link) + (let (anchor + base-buffer) + (when (string-match "#" link) + (setq anchor (substring link (match-beginning 0)) + link (if (= (match-beginning 0) 0) + ;; If there is an anchor but no link, default + ;; to the current page. + nil + (substring link 0 (match-beginning 0))))) + (when link + (setq base-buffer (get-buffer link)) + (if (and base-buffer (not (buffer-file-name base-buffer))) + ;; If file is temporary (no associated file), just switch to + ;; the buffer + (if other-window + (switch-to-buffer-other-window base-buffer) + (switch-to-buffer base-buffer)) + (let ((project (muse-project-of-file))) + (if project + (muse-project-find-file link project + (and other-window + 'find-file-other-window)) + (if other-window + (find-file-other-window link) + (find-file link)))))) + (when anchor + (let ((pos (point)) + (regexp (concat "^\\W*" (regexp-quote anchor) "\\b")) + last) + (goto-char (point-min)) + (while (and (setq last (re-search-forward regexp nil t)) + (muse-link-at-point))) + (unless last + (goto-char pos) + (message "Could not find anchor `%s'" anchor))))))) + +(defun muse-visit-link (link &optional other-window) + "Visit the URL or link named by LINK." + (let ((visit-link-function + (muse-get-keyword :visit-link (cadr (muse-project-of-file)) t))) + (if visit-link-function + (funcall visit-link-function link other-window) + (muse-visit-link-default link other-window)))) + +;;;###autoload +(defun muse-browse-result (style &optional other-window) + "Visit the current page's published result." + (interactive + (list (muse-project-get-applicable-style buffer-file-name + (cddr muse-current-project)) + current-prefix-arg)) + (setq style (muse-style style)) + (muse-project-publish-this-file nil style) + (let* ((output-dir (muse-style-element :path style)) + (output-suffix (muse-style-element :osuffix style)) + (output-path (muse-publish-output-file buffer-file-name output-dir + style)) + (target (if output-suffix + (concat (muse-path-sans-extension output-path) + output-suffix) + output-path)) + (muse-current-output-style (list :base (car style) + :path output-dir))) + (if (not (file-readable-p target)) + (error "Cannot open output file '%s'" target) + (if other-window + (find-file-other-window target) + (let ((func (muse-style-element :browser style t))) + (if func + (funcall func target) + (message "The %s publishing style does not support browsing." + style))))))) + +;;;###autoload +(defun muse-follow-name-at-point (&optional other-window) + "Visit the link at point." + (interactive "P") + (let ((link (muse-link-at-point))) + (if link + (muse-visit-link link other-window) + (error "There is no valid link at point")))) + +;;;###autoload +(defun muse-follow-name-at-point-other-window () + "Visit the link at point in other window." + (interactive) + (muse-follow-name-at-point t)) + +(defun muse-follow-name-at-mouse (event &optional other-window) + "Visit the link at point, or yank text if none is found." + (interactive "eN") + (unless + (save-excursion + (cond ((fboundp 'event-window) ; XEmacs + (set-buffer (window-buffer (event-window event))) + (and (funcall (symbol-function 'event-point) event) + (goto-char (funcall (symbol-function 'event-point) + event)))) + ((fboundp 'posn-window) ; Emacs + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))))) + (let ((link (muse-link-at-point))) + (when link + (muse-visit-link link other-window) + t))) + ;; Fall back to normal binding for this event + (call-interactively + (lookup-key (current-global-map) (this-command-keys))))) + +(defun muse-follow-name-at-mouse-other-window (event) + "Visit the link at point" + (interactive "e") + ;; throw away the old window position, since other-window will + ;; change it anyway + (select-window (car (cadr event))) + (muse-follow-name-at-mouse event t)) + +;;;###autoload +(defun muse-next-reference () + "Move forward to next Muse link or URL, cycling if necessary." + (interactive) + (let ((pos)) + (save-excursion + (when (get-text-property (point) 'muse-link) + (goto-char (or (next-single-property-change (point) 'muse-link) + (point-max)))) + + (setq pos (next-single-property-change (point) 'muse-link)) + + (when (not pos) + (if (get-text-property (point-min) 'muse-link) + (setq pos (point-min)) + (setq pos (next-single-property-change (point-min) 'muse-link))))) + + (when pos + (goto-char pos)))) + +;;;###autoload +(defun muse-previous-reference () + "Move backward to the next Muse link or URL, cycling if necessary. +In case of Emacs x <= 21 and ignoring of intangible properties (see +`muse-mode-intangible-links'). + +This function is not entirely accurate, but it's close enough." + (interactive) + (let ((pos)) + (save-excursion + + ;; Hack: The user perceives the two cases of point ("|") + ;; position (1) "|[[" and (2) "[[|" or "][|" as "point is at + ;; start of link". But in the sense of the function + ;; "previous-single-property-change" these two cases are + ;; different. The following code aligns these two cases. Emacs + ;; 21: If the intangible property is ignored case (2) is more + ;; complicate and this hack only solves the problem partially. + ;; + (when (and (get-text-property (point) 'muse-link) + (muse-looking-back "\\[\\|\\]")) + (goto-char (or (previous-single-property-change (point) 'muse-link) + (point-min)))) + + (when (eq (point) (point-min)) + (goto-char (point-max))) + + (setq pos (previous-single-property-change (point) 'muse-link)) + + (when (not pos) + (if (get-text-property (point-min) 'muse-link) + (setq pos (point-min)) + (setq pos (previous-single-property-change (point-max) + 'muse-link))))) + + (when pos + (if (get-text-property pos 'muse-link) + (goto-char pos) + (goto-char (or (previous-single-property-change pos 'muse-link) + (point-min))))))) + +;;;###autoload +(defun muse-what-changed () + "Show the unsaved changes that have been made to the current file." + (interactive) + (diff-backup buffer-file-name)) + + +;;; Find text in project pages, or pages referring to the current page + +(defvar muse-search-history nil) + +(defun muse-grep (string &optional grep-command-no-shadow) + "Grep for STRING in the project directories. +GREP-COMMAND if passed will supplant `muse-grep-command'." + ;; careful - grep-command leaks into compile, so we call it + ;; -no-shadow instead + (require 'compile) + (let* ((str (or grep-command-no-shadow muse-grep-command)) + (muse-directories (mapcar + (lambda (thing) + (car (cadr thing))) + muse-project-alist)) + (dirs (mapconcat (lambda (dir) + (shell-quote-argument + (expand-file-name dir))) + muse-directories " "))) + (if (string= dirs "") + (muse-display-warning + "No directories were found in the current project; aborting search") + (while (string-match "%W" str) + (setq str (replace-match string t t str))) + (while (string-match "%D" str) + (setq str (replace-match dirs t t str))) + (if (fboundp 'compilation-start) + (compilation-start str nil (lambda (&rest args) "*search*") + grep-regexp-alist) + (and (fboundp 'compile-internal) + (compile-internal str "No more search hits" "search" + nil grep-regexp-alist)))))) + +;;;###autoload +(defun muse-search-with-command (text) + "Search for the given TEXT string in the project directories +using the specified command." + (interactive + (list (let ((str (concat muse-grep-command)) pos) + (when (string-match "%W" str) + (setq pos (match-beginning 0)) + (unless (featurep 'xemacs) + (setq pos (1+ pos))) + (setq str (replace-match "" t t str))) + (read-from-minibuffer "Search command: " + (cons str pos) nil nil + 'muse-search-history)))) + (muse-grep nil text)) + +;;;###autoload +(defun muse-search () + "Search for the given TEXT using the default grep command." + (interactive) + (muse-grep (read-string "Search: "))) + +;;;###autoload +(defun muse-find-backlinks () + "Grep for the current pagename in all the project directories." + (interactive) + (muse-grep (muse-page-name))) + + +;;; Generate an index of all known Muse pages + +(defun muse-generate-index (&optional as-list exclude-private) + "Generate an index of all Muse pages." + (let ((index (muse-index-as-string as-list exclude-private))) + (with-current-buffer (get-buffer-create "*Muse Index*") + (erase-buffer) + (insert index) + (current-buffer)))) + +;;;###autoload +(defun muse-index () + "Display an index of all known Muse pages." + (interactive) + (message "Generating Muse index...") + (let ((project (muse-project))) + (with-current-buffer (muse-generate-index) + (goto-char (point-min)) + (muse-mode) + (setq muse-current-project project) + (pop-to-buffer (current-buffer)))) + (message "Generating Muse index...done")) + +(defun muse-index-as-string (&optional as-list exclude-private exclude-current) + "Generate an index of all Muse pages. +If AS-LIST is non-nil, insert a dash and spaces before each item. +If EXCLUDE-PRIVATE is non-nil, exclude files that have private permissions. +If EXCLUDE-CURRENT is non-nil, exclude the current file from the output." + (let ((files (sort (copy-alist (muse-project-file-alist)) + (function + (lambda (l r) + (string-lessp (car l) (car r))))))) + (when (and exclude-current (muse-page-name)) + (setq files (delete (assoc (muse-page-name) files) files))) + (with-temp-buffer + (while files + (unless (and exclude-private + (muse-project-private-p (cdar files))) + (insert (if as-list " - " "") "[[" (caar files) "]]\n")) + (setq files (cdr files))) + (buffer-string)))) + +;;; Insert tags interactively on C-c TAB t + +(defvar muse-tag-history nil + "List of recently-entered tags; used by `muse-insert-tag'. +If you want a tag to start as the default, you may manually set +this variable to a list.") + +(defvar muse-custom-tags nil + "Keep track of any new tags entered in `muse-insert-tag'. +If there are (X)HTML tags that you use frequently with that +function, you might want to set this manually.") + +;;;###autoload +(defun muse-insert-tag (tag) + "Insert a tag interactively with a blank line after it." + (interactive + (list + (funcall + muse-completing-read-function + (concat "Tag: " + (when muse-tag-history + (concat "(default: " (car muse-tag-history) ") "))) + (progn + (require 'muse-publish) + (mapcar 'list (nconc (mapcar 'car muse-publish-markup-tags) + muse-custom-tags))) + nil nil nil 'muse-tag-history + (car muse-tag-history)))) + (when (equal tag "") + (setq tag (car muse-tag-history))) + (unless (interactive-p) + (require 'muse-publish)) + (let ((tag-entry (assoc tag muse-publish-markup-tags)) + (options "")) + ;; Add to custom list if no entry exists + (unless tag-entry + (add-to-list 'muse-custom-tags tag)) + ;; Get option + (when (nth 2 tag-entry) + (setq options (read-string "Option: "))) + (unless (equal options "") + (setq options (concat " " options))) + ;; Insert the tag, closing if necessary + (when tag (insert (concat "<" tag options ">"))) + (when (nth 1 tag-entry) + (insert (concat "\n\n</" tag ">\n")) + (forward-line -2)))) + +;;; Muse list edit minor mode + +(defvar muse-list-edit-minor-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [(meta return)] 'muse-l-e-m-m-insert-list-item) + (define-key map [(control ?>)] 'muse-l-e-m-m-increase-list-item-indent) + (define-key map [(control ?<)] 'muse-l-e-m-m-decrease-list-item-indent) + + map) + "Keymap used by Muse list edit minor mode.") + +(defvar muse-l-e-m-m-list-item-regexp + (concat "^%s\\(\\([^\n" muse-regexp-blank "].*?\\)?::" + "\\(?:[" muse-regexp-blank "]+\\|$\\)" + "\\|[" muse-regexp-blank "]?[-*+][" muse-regexp-blank "]*" + "\\|[" muse-regexp-blank "][0-9]+\\.[" muse-regexp-blank "]*\\)") + "Regexp used to match the beginning of a list item. +This is used by `muse-list-edit-minor-mode'. +The '%s' will be replaced with a whitespace regexp when publishing.") + +(defun muse-l-e-m-m-insert-list-item () + "Insert a list item at the current point, taking into account +your current list type and indentation level." + (interactive) + (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp)) + (call-interactively 'muse-insert-list-item))) + +(defun muse-l-e-m-m-increase-list-item-indent () + "Increase the indentation of the current list item." + (interactive) + (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp)) + (call-interactively 'muse-increase-list-item-indentation))) + +(defun muse-l-e-m-m-decrease-list-item-indent () + "Decrease the indentation of the current list item." + (interactive) + (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp)) + (call-interactively 'muse-decrease-list-item-indentation))) + +(defvar muse-l-e-m-m-data nil + "A list of data that was changed by Muse list edit minor mode.") +(make-variable-buffer-local 'muse-l-e-m-m-data) + +;;;###autoload +(define-minor-mode muse-list-edit-minor-mode + "This is a global minor mode for editing files with lists. +It is meant to be used with other major modes, and not with Muse mode. + +Interactively, with no prefix argument, toggle the mode. +With universal prefix ARG turn mode on. +With zero or negative ARG turn mode off. + +This minor mode provides the Muse keybindings for editing lists, +and support for filling lists properly. + +It recognizes not only Muse-style lists, which use the \"-\" +character or numbers, but also lists that use asterisks or plus +signs. This should make the minor mode generally useful. + +Definition lists and footnotes are also recognized. + +Note that list items may omit leading spaces, for compatibility +with modes that set `left-margin', such as +`debian-changelog-mode'. + +\\{muse-list-edit-minor-mode-map}" + :init-value nil + :lighter "" + :keymap muse-list-edit-minor-mode-map + :global nil + :group 'muse-mode + (if (not muse-list-edit-minor-mode) + ;; deactivate + (when muse-l-e-m-m-data + (setq adaptive-fill-regexp (cdr (assoc "a-f-r" muse-l-e-m-m-data)) + paragraph-start (cdr (assoc "p-s" muse-l-e-m-m-data)) + fill-prefix (cdr (assoc "f-p" muse-l-e-m-m-data))) + (setq muse-l-e-m-m-data nil)) + ;; activate + (unless muse-l-e-m-m-data + ;; save previous fill-related data so we can restore it later + (setq muse-l-e-m-m-data + (list (cons "a-f-r" adaptive-fill-regexp) + (cons "p-s" paragraph-start) + (cons "f-p" fill-prefix)))) + ;; make fill work nicely with item lists + (let ((regexp (concat "\\s-*\\([-*+]\\|[0-9]+\\.\\)\\s-+" + "\\|\\[[0-9]+\\]\\s-*" + "\\|.*\\s-*::\\s-+"))) + (set (make-local-variable 'adaptive-fill-regexp) + (concat regexp "\\|\\s-*")) + (set (make-local-variable 'paragraph-start) + (concat paragraph-start "\\|" regexp))) + ;; force fill-prefix to be nil, because if it is a string that has + ;; initial spaces, it messes up fill-paragraph's algorithm + (set (make-local-variable 'fill-prefix) nil))) + +(defun turn-on-muse-list-edit-minor-mode () + "Unconditionally turn on Muse list edit minor mode." + (muse-list-edit-minor-mode 1)) + +(defun turn-off-muse-list-edit-minor-mode () + "Unconditionally turn off Muse list edit minor mode." + (muse-list-edit-minor-mode -1)) + +;;; muse-mode.el ends here diff --git a/emacs.d/elisp/muse/muse-poem.el b/emacs.d/elisp/muse/muse-poem.el new file mode 100644 index 0000000..bd08b7e --- /dev/null +++ b/emacs.d/elisp/muse/muse-poem.el @@ -0,0 +1,263 @@ +;;; muse-poem.el --- publish a poem to LaTex or PDF + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file specifies a form for recording poetry. It is as follows. +;; +;; Title +;; +;; +;; Body of poem +;; +;; +;; Annotations, history, notes, etc. +;; +;; The `muse-poem' module makes it easy to attractively publish and +;; reference poems in this format, using the "memoir" module for LaTeX +;; publishing. It will also markup poems for every other output +;; style, though none are nearly as pretty. +;; +;; Once a poem is written in this format, just publish it to PDF using +;; the "poem-pdf" style. To make an inlined reference to a poem that +;; you've written -- for example, from a blog page -- there is a +;; "poem" tag defined by this module: +;; +;; <poem title="name.of.poem.page"> +;; +;; Let's assume the template above was called "name.of.poem.page"; +;; then the above tag would result in this inclusion: +;; +;; ** Title +;; +;; > Body of poem +;; +;; I use this module for publishing all of the poems on my website, +;; which are at: http://www.newartisans.com/johnw/poems.html. + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Poem Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-latex) +(require 'muse-project) + +(defgroup muse-poem nil + "Rules for marking up a Muse file as a LaTeX article." + :group 'muse-latex) + +(defcustom muse-poem-latex-header + "\\documentclass[14pt,oneside]{memoir} + +\\usepackage[english]{babel} +\\usepackage[latin1]{inputenc} +\\usepackage[T1]{fontenc} + +\\setlength{\\beforepoemtitleskip}{-5.0ex} + +\\begin{document} + +\\pagestyle{empty} + +\\renewcommand{\\poemtoc}{section} +\\settocdepth{section} + +\\mbox{} +\\vfill + +\\poemtitle{<lisp>(muse-publishing-directive \"title\")</lisp>} + +\\settowidth{\\versewidth}{<lisp>muse-poem-longest-line</lisp>}\n\n" + "Header used for publishing LaTeX poems. This may be text or a filename." + :type 'string + :group 'muse-poem) + +(defcustom muse-poem-latex-footer "\n\\vfill +\\mbox{} + +\\end{document}" + "Footer used for publishing LaTeX files. This may be text or a filename." + :type 'string + :group 'muse-poem) + +(defcustom muse-poem-markup-strings + '((begin-verse . "\\begin{verse}[\\versewidth]\n") + (verse-space . "\\vin ")) + "Strings used for marking up poems. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-poem) + +(defcustom muse-chapbook-latex-header + "\\documentclass{book} + +\\usepackage[english]{babel} +\\usepackage[latin1]{inputenc} +\\usepackage[T1]{fontenc} + +\\setlength{\\beforepoemtitleskip}{-5.0ex} + +\\begin{document} + +\\title{<lisp>(muse-publishing-directive \"title\")</lisp>} +\\author{<lisp>(muse-publishing-directive \"author\")</lisp>} +\\date{<lisp>(muse-publishing-directive \"date\")</lisp>} + +\\maketitle + +\\tableofcontents + +\\renewcommand{\\poemtoc}{section} +\\settocdepth{section}\n" + "Header used for publishing a book of poems in LaTeX form. +This may be text or a filename." + :type 'string + :group 'muse-poem) + +(defcustom muse-chapbook-latex-footer "\n\\end{document}" + "Footer used for publishing a book of poems in LaTeX form. +This may be text or a filename." + :type 'string + :group 'muse-poem) + +(defvar muse-poem-longest-line "") + +(defcustom muse-poem-chapbook-strings + '((begin-verse . "\\newpage +\\mbox{} +\\vfill + +\\poemtitle{<lisp>(muse-publishing-directive \"title\")</lisp>} + +\\settowidth{\\versewidth}{<lisp>muse-poem-longest-line</lisp>} + +\\begin{verse}[\\versewidth]\n") + (end-verse . "\n\\end{verse}\n\\vfill\n\\mbox{}") + (verse-space . "\\vin ")) + "Strings used for marking up books of poems. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-poem) + +(defun muse-poem-prepare-buffer () + (goto-char (point-min)) + (insert "#title ") + (forward-line 1) + (delete-region (point) (1+ (muse-line-end-position))) + (insert "\n<verse>") + (let ((beg (point)) end line) + (if (search-forward "\n\n\n" nil t) + (progn + (setq end (copy-marker (match-beginning 0) t)) + (replace-match "\n</verse>\n") + (delete-region (point) (point-max))) + (goto-char (point-max)) + (setq end (point)) + (insert "</verse>\n")) + (goto-char (1+ beg)) + (set (make-local-variable 'muse-poem-longest-line) "") + (while (< (point) end) + (setq line (buffer-substring-no-properties (point) + (muse-line-end-position))) + (if (> (length line) (length muse-poem-longest-line)) + (setq muse-poem-longest-line line)) + (forward-line 1)) + nil)) + +(defvar muse-poem-tag '("poem" nil t nil muse-poem-markup-tag)) + +(defun muse-poem-markup-tag (beg end attrs) + "This markup tag allows a poem to be included from another project page. +The form of usage is: + <poem title=\"page.name\">" + (let ((page (cdr (assoc (cdr (assoc "title" attrs)) + (muse-project-file-alist)))) + beg end) + (if (null page) + (insert " *Reference to\n unknown poem \"" + (cdr (assoc "title" attrs)) "\".*\n") + (setq beg (point)) + (insert + (muse-with-temp-buffer + (muse-insert-file-contents page) + (goto-char (point-min)) + (if (assoc "nohead" attrs) + (progn + (forward-line 3) + (delete-region (point-min) (point))) + (insert "** ") + (search-forward "\n\n\n") + (replace-match "\n\n")) + (if (search-forward "\n\n\n" nil t) + (setq end (match-beginning 0)) + (setq end (point-max))) + (buffer-substring-no-properties (point-min) end))) + (setq end (point-marker)) + (goto-char beg) + (unless (assoc "nohead" attrs) + (forward-line 2)) + (while (< (point) end) + (insert "> ") + (forward-line 1)) + (set-marker end nil)))) + +(put 'muse-poem-markup-tag 'muse-dangerous-tag t) + +(add-to-list 'muse-publish-markup-tags muse-poem-tag) + +;;; Register the Muse POEM Publishers + +(muse-derive-style "poem-latex" "latex" + :before 'muse-poem-prepare-buffer + :strings 'muse-poem-markup-strings + :header 'muse-poem-latex-header + :footer 'muse-poem-latex-footer) + +(muse-derive-style "poem-pdf" "pdf" + :before 'muse-poem-prepare-buffer + :strings 'muse-poem-markup-strings + :header 'muse-poem-latex-header + :footer 'muse-poem-latex-footer) + +(muse-derive-style "chapbook-latex" "latex" + :before 'muse-poem-prepare-buffer + :strings 'muse-poem-chapbook-strings + :header 'muse-chapbook-latex-header + :footer 'muse-chapbook-latex-footer) + +(muse-derive-style "chapbook-pdf" "pdf" + :before 'muse-poem-prepare-buffer + :strings 'muse-poem-chapbook-strings + :header 'muse-chapbook-latex-header + :footer 'muse-chapbook-latex-footer) + +(provide 'muse-poem) + +;;; muse-poem.el ends here diff --git a/emacs.d/elisp/muse/muse-project.el b/emacs.d/elisp/muse/muse-project.el new file mode 100644 index 0000000..7489706 --- /dev/null +++ b/emacs.d/elisp/muse/muse-project.el @@ -0,0 +1,973 @@ +;;; muse-project.el --- handle Muse projects + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Project Maintainance +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(provide 'muse-project) + +(require 'muse) +(require 'muse-publish) +(require 'cus-edit) + +(defgroup muse-project nil + "Options controlling the behavior of Muse project handling." + :group 'muse) + +(defcustom muse-before-project-publish-hook nil + "A hook run before a project is published. +Each function is passed the project object, a cons with the format + (PROJNAME . SETTINGS)" + :type 'hook + :group 'muse-project) + +(defcustom muse-after-project-publish-hook nil + "A hook run after a project is published. +Each function is passed the project object, a cons with the format + (PROJNAME . SETTINGS)" + :type 'hook + :group 'muse-project) + +(defvar muse-project-alist-using-customize nil + "Used internally by Muse to indicate whether `muse-project-alist' +has been modified via the customize interface.") +(make-variable-buffer-local 'muse-project-alist-using-customize) + +(defmacro with-muse-project (project &rest body) + `(progn + (unless (muse-project ,project) + (error "Can't find project %s" ,project)) + (with-temp-buffer + (muse-mode) + (setq muse-current-project (muse-project ,project)) + (muse-project-set-variables) + ,@body))) + +(put 'with-muse-project 'lisp-indent-function 0) +(put 'with-muse-project 'edebug-form-spec '(sexp body)) + +(defun muse-project-alist-get (sym) + "Turn `muse-project-alist' into something we can customize easily." + (when (boundp sym) + (setq muse-project-alist-using-customize t) + (let* ((val (copy-alist (symbol-value sym))) + (head val)) + (while val + (let ((head (car (cdar val))) + res) + ;; Turn settings of first part into cons cells, symbol->string + (while head + (cond ((stringp (car head)) + (add-to-list 'res (car head) t) + (setq head (cdr head))) + ((symbolp (car head)) + (add-to-list 'res (list (symbol-name (car head)) + (cadr head)) t) + (setq head (cddr head))) + (t + (setq head (cdr head))))) + (setcdr (car val) (cons res (cdr (cdar val))))) + (let ((styles (cdar val))) + ;; Symbol->string in every style + (while (cdr styles) + (let ((head (cadr styles)) + res) + (while (consp head) + (setq res (plist-put res (symbol-name (car head)) + (cadr head))) + (setq head (cddr head))) + (setcdr styles (cons res (cddr styles)))) + (setq styles (cdr styles)))) + (setq val (cdr val))) + head))) + +(defun muse-project-alist-set (sym val) + "Turn customized version of `muse-project-alist' into something +Muse can make use of." + (set sym val) + (when muse-project-alist-using-customize + ;; Make sure the unescaped version is written to .emacs + (put sym 'saved-value (list (custom-quote val))) + ;; Perform unescaping + (while val + (let ((head (car (cdar val))) + res) + ;; Turn cons cells into flat list, string->symbol + (while head + (cond ((stringp (car head)) + (add-to-list 'res (car head) t)) + ((consp (car head)) + (add-to-list 'res (intern (caar head)) t) + (add-to-list 'res (car (cdar head)) t))) + (setq head (cdr head))) + (setcdr (car val) (cons res (cdr (cdar val))))) + (let ((styles (cdar val))) + ;; String->symbol in every style + (while (cdr styles) + (let ((head (cadr styles)) + res) + (while (consp head) + (setq res (plist-put res (intern (car head)) + (cadr head))) + (setq head (cddr head))) + (setcdr styles (cons res (cddr styles)))) + (setq styles (cdr styles)))) + (setq val (cdr val))))) + +(define-widget 'muse-project 'default + "A widget that defines a Muse project." + :format "\n%v" + :value-create 'muse-widget-type-value-create + :value-get 'muse-widget-child-value-get + :value-delete 'ignore + :match 'muse-widget-type-match + :type '(cons :format " %v" + (repeat :tag "Settings" :format "%{%t%}:\n%v%i\n\n" + (choice + (string :tag "Directory") + (list :tag "Book function" + (const :tag ":book-funcall" ":book-funcall") + (choice (function) + (sexp :tag "Unknown"))) + (list :tag "Book part" + (const :tag ":book-part" ":book-part") + (string :tag "Name")) + (list :tag "Book style" + (const :tag ":book-style" ":book-style") + (string :tag "Style")) + (list :tag "Default file" + (const :tag ":default" ":default") + (string :tag "File")) + (list :tag "End of book" + (const :tag ":book-end" ":book-end") + (const t)) + (list :tag "Force publishing" + (const :tag ":force-publish" ":force-publish") + (repeat (string :tag "File"))) + (list :tag "Major mode" + (const :tag ":major-mode" ":major-mode") + (choice (function :tag "Mode") + (sexp :tag "Unknown"))) + (list :tag "New chapter" + (const :tag ":book-chapter" ":book-chapter") + (string :tag "Name")) + (list :tag "No chapters" + (const :tag ":nochapters" ":nochapters") + (const t)) + (list :tag "Project-level publishing function" + (const :tag ":publish-project" + ":publish-project") + (choice (function :tag "Function") + (sexp :tag "Unknown"))) + (list :tag "Set variables" + (const :tag ":set" ":set") + (repeat (list :inline t + (symbol :tag "Variable") + (sexp :tag "Setting")))) + (list :tag "Visit links using" + (const :tag ":visit-link" ":visit-link") + (choice (function) + (sexp :tag "Unknown"))))) + (repeat :tag "Output styles" :format "%{%t%}:\n%v%i\n\n" + (set :tag "Style" + (list :inline t + :tag "Publishing style" + (const :tag ":base" ":base") + (string :tag "Style")) + (list :inline t + :tag "Base URL" + (const :tag ":base-url" ":base-url") + (string :tag "URL")) + (list :inline t + :tag "Exclude matching" + (const :tag ":exclude" ":exclude") + (regexp)) + (list :inline t + :tag "Include matching" + (const :tag ":include" ":include") + (regexp)) + (list :inline t + :tag "Timestamps file" + (const :tag ":timestamps" ":timestamps") + (file)) + (list :inline t + :tag "Path" + (const :tag ":path" ":path") + (string :tag "Path")))))) + +(defcustom muse-project-alist nil + "An alist of Muse projects. +A project defines a fileset, and a list of custom attributes for use +when publishing files in that project." + :type '(choice (const :tag "No projects defined." nil) + (repeat (cons :format "%{%t%}:\n\n%v" + :tag "Project" :indent 4 + (string :tag "Project name") + muse-project)) + (sexp :tag "Cannot parse expression")) + :get 'muse-project-alist-get + :set 'muse-project-alist-set + :group 'muse-project) + +;; Make it easier to specify a muse-project-alist entry + +(defcustom muse-project-ignore-regexp + (concat "\\`\\(#.*#\\|.*,v\\|.*~\\|\\.\\.?\\|\\.#.*\\|,.*\\)\\'\\|" + "/\\(CVS\\|RCS\\|\\.arch-ids\\|{arch}\\|,.*\\|\\.svn\\|" + "\\.hg\\|\\.git\\|\\.bzr\\|_darcs\\)\\(/\\|\\'\\)") + "A regexp matching files to be ignored in Muse directories. + +You should set `case-fold-search' to nil before using this regexp +in code." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-project-publish-private-files t + "If this is non-nil, files will be published even if their permissions +are set so that no one else on the filesystem can read them. + +Set this to nil if you would like to indicate that some files +should not be published by manually doing \"chmod o-rwx\" on +them. + +This setting has no effect under Windows (that is, all files are +published regardless of permissions) because Windows lacks the +needed filesystem attributes." + :type 'boolean + :group 'muse-project) + +(defun muse-project-recurse-directory (base) + "Recusively retrieve all of the directories underneath BASE. +A list of these directories is returned. + +Directories starting with \".\" will be ignored, as well as those +which match `muse-project-ignore-regexp'." + (let ((case-fold-search nil) + list dir) + (when (and (file-directory-p base) + (not (string-match muse-project-ignore-regexp base))) + (dolist (file (directory-files base t "^[^.]")) + (when (and (file-directory-p file) + (not (string-match muse-project-ignore-regexp file))) + (setq dir (file-name-nondirectory file)) + (push dir list) + (nconc list (mapcar #'(lambda (item) + (concat dir "/" item)) + (muse-project-recurse-directory file))))) + list))) + +(defun muse-project-alist-styles (entry-dir output-dir style &rest other) + "Return a list of styles to use in a `muse-project-alist' entry. +ENTRY-DIR is the top-level directory of the project. +OUTPUT-DIR is where Muse files are published, keeping directory structure. +STYLE is the publishing style to use. + +OTHER contains other definitions to add to each style. It is optional. + +For an example of the use of this function, see +`examples/mwolson/muse-init.el' from the Muse distribution." + (let ((fnd (file-name-nondirectory entry-dir))) + (when (string= fnd "") + ;; deal with cases like "foo/" that have a trailing slash + (setq fnd (file-name-nondirectory (substring entry-dir 0 -1)))) + (cons `(:base ,style :path ,(if (muse-file-remote-p output-dir) + output-dir + (expand-file-name output-dir)) + :include ,(concat "/" fnd "/[^/]+$") + ,@other) + (mapcar (lambda (dir) + `(:base ,style + :path ,(expand-file-name dir output-dir) + :include ,(concat "/" dir "/[^/]+$") + ,@other)) + (muse-project-recurse-directory entry-dir))))) + +(defun muse-project-alist-dirs (entry-dir) + "Return a list of directories to use in a `muse-project-alist' entry. +ENTRY-DIR is the top-level directory of the project. + +For an example of the use of this function, see +`examples/mwolson/muse-init.el' from the Muse distribution." + (cons (expand-file-name entry-dir) + (mapcar (lambda (dir) (expand-file-name dir entry-dir)) + (muse-project-recurse-directory entry-dir)))) + +;; Constructing the file-alist + +(defvar muse-project-file-alist nil + "This variable is automagically constructed as needed.") + +(defvar muse-project-file-alist-hook nil + "Functions that are to be exectuted immediately after updating +`muse-project-file-alist'.") + +(defvar muse-current-project nil + "Project we are currently visiting.") +(make-variable-buffer-local 'muse-current-project) +(defvar muse-current-project-global nil + "Project we are currently visiting. This is used to propagate the value +of `muse-current-project' into a new buffer during publishing.") + +(defvar muse-current-output-style nil + "The output style that we are currently using for publishing files.") + +(defsubst muse-project (&optional project) + "Resolve the given PROJECT into a full Muse project, if it is a string." + (if (null project) + (or muse-current-project + (muse-project-of-file)) + (if (stringp project) + (assoc project muse-project-alist) + (muse-assert (consp project)) + project))) + +(defun muse-project-page-file (page project &optional no-check-p) + "Return a filename if PAGE exists within the given Muse PROJECT." + (setq project (muse-project project)) + (if (null page) + ;; if not given a page, return the first directory instead + (let ((pats (cadr project))) + (catch 'done + (while pats + (if (symbolp (car pats)) + (setq pats (cddr pats)) + (throw 'done (file-name-as-directory (car pats))))))) + (let ((dir (file-name-directory page)) + (expanded-path nil)) + (when dir + (setq expanded-path (concat (expand-file-name + page + (file-name-directory (muse-current-file))) + (when muse-file-extension + (concat "." muse-file-extension)))) + (setq page (file-name-nondirectory page))) + (let ((files (muse-collect-alist + (muse-project-file-alist project no-check-p) + page)) + (matches nil)) + (if dir + (catch 'done + (save-match-data + (dolist (file files) + (if (and expanded-path + (string= expanded-path (cdr file))) + (throw 'done (cdr file)) + (let ((pos (string-match (concat (regexp-quote dir) "\\'") + (file-name-directory + (cdr file))))) + (when pos + (setq matches (cons (cons pos (cdr file)) + matches))))))) + ;; if we haven't found an exact match, pick a candidate + (car (muse-sort-by-rating matches))) + (dolist (file files) + (setq matches (cons (cons (length (cdr file)) (cdr file)) + matches))) + (car (muse-sort-by-rating matches '<))))))) + +(defun muse-project-private-p (file) + "Return non-nil if NAME is a private page with PROJECT." + (unless (or muse-under-windows-p + muse-project-publish-private-files) + (setq file (file-truename file)) + (if (file-attributes file) ; don't publish if no attributes exist + (or (when (eq ?- (aref (nth 8 (file-attributes + (file-name-directory file))) 7)) + (message (concat + "The " (file-name-directory file) + " directory must be readable by others" + " in order for its contents to be published."))) + (eq ?- (aref (nth 8 (file-attributes file)) 7))) + t))) + +(defun muse-project-file-entries (path) + (let* ((names (list t)) + (lnames names) + (case-fold-search nil)) + (cond + ((file-directory-p path) + (dolist (file (directory-files + path t (when (and muse-file-extension + (not (string= muse-file-extension ""))) + (concat "." muse-file-extension "\\'")))) + (unless (or (string-match muse-project-ignore-regexp file) + (string-match muse-project-ignore-regexp + (file-name-nondirectory file)) + (file-directory-p file)) + (setcdr lnames + (cons (cons (muse-page-name file) file) nil)) + (setq lnames (cdr lnames))))) + ((file-readable-p path) + (setcdr lnames + (cons (cons (muse-page-name path) path) nil)) + (setq lnames (cdr lnames))) + (t ; regexp + (muse-assert (file-name-directory path)) + (dolist (file (directory-files + (file-name-directory path) t + (file-name-nondirectory path))) + (unless (or (string-match muse-project-ignore-regexp file) + (string-match muse-project-ignore-regexp + (file-name-nondirectory file))) + (setcdr lnames + (cons (cons (muse-page-name file) file) nil)) + (setq lnames (cdr lnames)))))) + (cdr names))) + +(defvar muse-updating-file-alist-p nil + "Make sure that recursive calls to `muse-project-file-alist' are bounded.") + +(defun muse-project-determine-last-mod (project &optional no-check-p) + "Return the most recent last-modified timestamp of dirs in PROJECT." + (let ((last-mod nil)) + (unless (or muse-under-windows-p no-check-p) + (let ((pats (cadr project))) + (while pats + (if (symbolp (car pats)) + (setq pats (cddr pats)) + (let* ((fnd (file-name-directory (car pats))) + (dir (cond ((file-directory-p (car pats)) + (car pats)) + ((and (not (file-readable-p (car pats))) + fnd + (file-directory-p fnd)) + fnd)))) + (when dir + (let ((mod-time (nth 5 (file-attributes dir)))) + (when (or (null last-mod) + (and mod-time + (muse-time-less-p last-mod mod-time))) + (setq last-mod mod-time))))) + (setq pats (cdr pats)))))) + last-mod)) + +(defun muse-project-file-alist (&optional project no-check-p) + "Return member filenames for the given Muse PROJECT. +Also, update the `muse-project-file-alist' variable. + +On UNIX, this alist is only updated if one of the directories' +contents have changed. On Windows, it is always reread from +disk. + +If NO-CHECK-P is non-nil, do not update the alist, just return +the current one." + (setq project (muse-project project)) + (when (and project muse-project-alist) + (let* ((file-alist (assoc (car project) muse-project-file-alist)) + (last-mod (muse-project-determine-last-mod project no-check-p))) + ;; Either return the currently known list, or read it again from + ;; disk + (if (or (and no-check-p (cadr file-alist)) + muse-updating-file-alist-p + (not (or muse-under-windows-p + (null (cddr file-alist)) + (null last-mod) + (muse-time-less-p (cddr file-alist) last-mod)))) + (cadr file-alist) + (if file-alist + (setcdr (cdr file-alist) last-mod) + (setq file-alist (cons (car project) (cons nil last-mod)) + muse-project-file-alist + (cons file-alist muse-project-file-alist))) + ;; Read in all of the file entries + (let ((muse-updating-file-alist-p t)) + (prog1 + (save-match-data + (setcar + (cdr file-alist) + (let* ((names (list t)) + (pats (cadr project))) + (while pats + (if (symbolp (car pats)) + (setq pats (cddr pats)) + (nconc names (muse-project-file-entries (car pats))) + (setq pats (cdr pats)))) + (cdr names)))) + (run-hooks 'muse-project-file-alist-hook))))))) + +(defun muse-project-add-to-alist (file &optional project) + "Make sure FILE is added to `muse-project-file-alist'. + +It works by either calling the `muse-project-file-alist' function +if a directory has been modified since we last checked, or +manually forcing the file entry to exist in the alist. This +works around an issue where if several files being saved at the +same time, only the first one will make it into the alist. It is +meant to be called by `muse-project-after-save-hook'. + +The project of the file is determined by either the PROJECT +argument, or `muse-project-of-file' if PROJECT is not specified." + (setq project (or (muse-project project) (muse-project-of-file file))) + (when (and project muse-project-alist) + (let* ((file-alist (assoc (car project) muse-project-file-alist)) + (last-mod (muse-project-determine-last-mod project))) + ;; Determine whether we need to call this + (if (or (null (cddr file-alist)) + (null last-mod) + (muse-time-less-p (cddr file-alist) last-mod)) + ;; The directory will show up as modified, so go ahead and + ;; call `muse-project-file-alist' + (muse-project-file-alist project) + ;; It is not showing as modified, so forcefully add the + ;; current file to the project file-alist + (let ((muse-updating-file-alist-p t)) + (prog1 + (save-match-data + (setcar (cdr file-alist) + (nconc (muse-project-file-entries file) + (cadr file-alist)))) + (run-hooks 'muse-project-file-alist-hook))))))) + +(defun muse-project-of-file (&optional pathname) + "Determine which project the given PATHNAME relates to. +If PATHNAME is nil, the current buffer's filename is used." + (if (and (null pathname) muse-current-project) + muse-current-project + (unless pathname (setq pathname (muse-current-file))) + (save-match-data + (when (and (stringp pathname) + muse-project-alist + (not (string= pathname "")) + (not (let ((case-fold-search nil)) + (or (string-match muse-project-ignore-regexp + pathname) + (string-match muse-project-ignore-regexp + (file-name-nondirectory + pathname)))))) + (let* ((file (file-truename pathname)) + (dir (file-name-directory file)) + found rating matches) + (catch 'found + (dolist (project-entry muse-project-alist) + (let ((pats (cadr project-entry))) + (while pats + (if (symbolp (car pats)) + (setq pats (cddr pats)) + (let ((tname (file-truename (car pats)))) + (cond ((or (string= tname file) + (string= (file-name-as-directory tname) dir)) + (throw 'found project-entry)) + ((string-match (concat "\\`" (regexp-quote tname)) + file) + (setq matches (cons (cons (match-end 0) + project-entry) + matches))))) + (setq pats (cdr pats)))))) + ;; if we haven't found an exact match, pick a candidate + (car (muse-sort-by-rating matches)))))))) + +(defun muse-project-after-save-hook () + "Update Muse's file-alist if we are saving a Muse file." + (let ((project (muse-project-of-file))) + (when project + (muse-project-add-to-alist (buffer-file-name) project)))) + +(add-hook 'after-save-hook 'muse-project-after-save-hook) + +(defun muse-read-project (prompt &optional no-check-p no-assume) + "Read a project name from the minibuffer, if it can't be figured + out." + (if (null muse-project-alist) + (error "There are no Muse projects defined; see `muse-project-alist'") + (or (unless no-check-p + (muse-project-of-file)) + (if (and (not no-assume) + (= 1 (length muse-project-alist))) + (car muse-project-alist) + (assoc (funcall muse-completing-read-function + prompt muse-project-alist) + muse-project-alist))))) + +(defvar muse-project-page-history nil) + +(defun muse-read-project-file (project prompt &optional default) + (let* ((file-list (muse-delete-dups + (mapcar #'(lambda (a) (list (car a))) + (muse-project-file-alist project)))) + (name (funcall muse-completing-read-function + prompt file-list nil nil nil + 'muse-project-page-history default))) + (cons name (muse-project-page-file name project)))) + +;;;###autoload +(defun muse-project-find-file (name project &optional command directory) + "Open the Muse page given by NAME in PROJECT. +If COMMAND is non-nil, it is the function used to visit the file. +If DIRECTORY is non-nil, it is the directory in which the page +will be created if it does not already exist. Otherwise, the +first directory within the project's fileset is used." + (interactive + (let* ((project (muse-read-project "Find in project: " + current-prefix-arg)) + (default (muse-get-keyword :default (cadr project))) + (entry (muse-read-project-file + project (if default + (format "Find page: (default: %s) " + default) + "Find page: ") + default))) + (list entry project))) + (setq project (muse-project project)) + (let ((project-name (car project))) + (unless (interactive-p) + (setq project (muse-project project) + name (cons name (muse-project-page-file name project)))) + ;; If we're given a relative or absolute filename, open it as-is + (if (and (car name) + (save-match-data + (or (string-match "\\`\\.+/" (car name)) + (string-match muse-file-regexp (car name)) + (string-match muse-image-regexp (car name))))) + (setcdr name (car name)) + ;; At this point, name is (PAGE . FILE). + (unless (cdr name) + (let ((pats (cadr project))) + (while (and pats (null directory)) + (if (symbolp (car pats)) + (setq pats (cddr pats)) + (if (file-directory-p (car pats)) + (setq directory (car pats) pats nil) + (setq pats (cdr pats)))))) + (when directory + (let ((filename (expand-file-name (car name) directory))) + (when (and muse-file-extension + (not (string= muse-file-extension "")) + (not (file-exists-p (car name)))) + (setq filename (concat filename "." muse-file-extension))) + (unless (file-exists-p directory) + (make-directory directory t)) + (setcdr name filename))))) + ;; Open the file + (if (cdr name) + (funcall (or command 'find-file) (cdr name)) + (error "There is no page %s in project %s" + (car name) project-name)))) + +(defun muse-project-choose-style (closure test styles) + "Run TEST on STYLES and return first style where TEST yields non-nil. +TEST should take two arguments. The first is CLOSURE, which is +passed verbatim. The second if the current style to consider. + +If no style passes TEST, return the first style." + (or (catch 'winner + (dolist (style styles) + (when (funcall test closure style) + (throw 'winner style)))) + (car styles))) + +(defun muse-project-choose-style-by-link-suffix (given-suffix style) + "If the given STYLE has a link-suffix that equals GIVEN-SUFFIX, +return non-nil." + (let ((link-suffix (or (muse-style-element :link-suffix style) + (muse-style-element :suffix style)))) + (and (stringp link-suffix) + (string= given-suffix link-suffix)))) + +(defun muse-project-applicable-styles (file styles) + "Given STYLES, return a list of the ones that are considered for FILE. +The name of a project may be used for STYLES." + (when (stringp styles) + (setq styles (cddr (muse-project styles)))) + (when (and file styles) + (let ((used-styles nil)) + (dolist (style styles) + (let ((include-regexp (muse-style-element :include style)) + (exclude-regexp (muse-style-element :exclude style)) + (rating nil)) + (when (and (or (and (null include-regexp) + (null exclude-regexp)) + (if include-regexp + (setq rating (string-match include-regexp file)) + (not (string-match exclude-regexp file)))) + (file-exists-p file) + (not (muse-project-private-p file))) + (setq used-styles (cons (cons rating style) used-styles))))) + (muse-sort-by-rating (nreverse used-styles))))) + +(defun muse-project-get-applicable-style (file styles) + "Choose a style from the STYLES that FILE can publish to. +The user is prompted if several styles are found." + (muse-publish-get-style + (mapcar (lambda (style) + (cons (muse-get-keyword :base style) style)) + (muse-project-applicable-styles file styles)))) + +(defun muse-project-resolve-directory (page local-style remote-style) + "Figure out the directory part of the path that provides a link to PAGE. +LOCAL-STYLE is the style of the current Muse file, and +REMOTE-STYLE is the style associated with PAGE. + +If REMOTE-STYLE has a :base-url element, concatenate it and PAGE. +Otherwise, return a relative link." + (let ((prefix (muse-style-element :base-url remote-style))) + (if prefix + (concat prefix page) + (file-relative-name (expand-file-name + (file-name-nondirectory page) + (muse-style-element :path remote-style)) + (expand-file-name + (muse-style-element :path local-style)))))) + +(defun muse-project-resolve-link (page local-style remote-styles) + "Return a published link from the output path of one file to another file. + +The best match for PAGE is determined by comparing the link +suffix of the given local style and that of the remote styles. + +The remote styles are usually populated by +`muse-project-applicable-styles'. + +If no remote style is found, return PAGE verbatim + +If PAGE has a :base-url associated with it, return the +concatenation of the :base-url value and PAGE. + +Otherwise, return a relative path from the directory of +LOCAL-STYLE to the best directory among REMOTE-STYLES." + (let ((link-suffix (or (muse-style-element :link-suffix local-style) + (muse-style-element :suffix local-style))) + remote-style) + (if (not (stringp link-suffix)) + (setq remote-style (car remote-styles)) + (setq remote-style (muse-project-choose-style + link-suffix + #'muse-project-choose-style-by-link-suffix + remote-styles))) + (if (null remote-style) + page + (setq page (muse-project-resolve-directory + page local-style remote-style)) + (concat (file-name-directory page) + (muse-publish-link-name page remote-style))))) + +(defun muse-project-current-output-style (&optional file project) + (or muse-current-output-style + (progn + (unless file (setq file (muse-current-file))) + (unless project (setq project (muse-project-of-file file))) + (car (muse-project-applicable-styles file (cddr project)))))) + +(defun muse-project-link-page (page) + (let ((project (muse-project-of-file))) + (muse-project-resolve-link page + (muse-project-current-output-style) + (muse-project-applicable-styles + (muse-project-page-file page project) + (cddr project))))) + +(defun muse-project-publish-file-default (file style output-dir force) + ;; ensure the publishing location is available + (unless (file-exists-p output-dir) + (message "Creating publishing directory %s" output-dir) + (make-directory output-dir t)) + ;; publish the member file! + (muse-publish-file file style output-dir force)) + +(defun muse-project-publish-file (file styles &optional force) + (setq styles (muse-project-applicable-styles file styles)) + (let (published) + (dolist (style styles) + (if (or (not (listp style)) + (not (cdr style))) + (muse-display-warning + (concat "Skipping malformed muse-project-alist style." + "\nPlease double-check your configuration,")) + (let ((output-dir (muse-style-element :path style)) + (muse-current-output-style style) + (fun (or (muse-style-element :publish style t) + 'muse-project-publish-file-default))) + (when (funcall fun file style output-dir force) + (setq published t))))) + published)) + +;;;###autoload +(defun muse-project-publish-this-file (&optional force style) + "Publish the currently-visited file according to `muse-project-alist', +prompting if more than one style applies. + +If FORCE is given, publish the file even if it is up-to-date. + +If STYLE is given, use that publishing style rather than +prompting for one." + (interactive (list current-prefix-arg)) + (let ((muse-current-project (muse-project-of-file))) + (if (not muse-current-project) + ;; file is not part of a project, so fall back to muse-publish + (if (interactive-p) (call-interactively 'muse-publish-this-file) + (muse-publish-this-file style nil force)) + (unless style + (setq style (muse-project-get-applicable-style + buffer-file-name (cddr muse-current-project)))) + (let* ((output-dir (muse-style-element :path style)) + (muse-current-project-global muse-current-project) + (muse-current-output-style (list :base (car style) + :path output-dir)) + (fun (or (muse-style-element :publish style t) + 'muse-project-publish-file-default))) + (unless (funcall fun buffer-file-name style output-dir force) + (message (concat "The published version is up-to-date; use" + " C-u C-c C-t to force an update."))))))) + +(defun muse-project-save-buffers (&optional project) + (setq project (muse-project project)) + (when project + (save-excursion + (map-y-or-n-p + (function + (lambda (buffer) + (and (buffer-modified-p buffer) + (not (buffer-base-buffer buffer)) + (or (buffer-file-name buffer) + (progn + (set-buffer buffer) + (and buffer-offer-save + (> (buffer-size) 0)))) + (with-current-buffer buffer + (let ((proj (muse-project-of-file))) + (and proj (string= (car proj) + (car project))))) + (if (buffer-file-name buffer) + (format "Save file %s? " + (buffer-file-name buffer)) + (format "Save buffer %s? " + (buffer-name buffer)))))) + (function + (lambda (buffer) + (set-buffer buffer) + (save-buffer))) + (buffer-list) + '("buffer" "buffers" "save") + (if (boundp 'save-some-buffers-action-alist) + save-some-buffers-action-alist))))) + +(defun muse-project-publish-default (project styles &optional force) + "Publish the pages of PROJECT that need publishing." + (setq project (muse-project project)) + (let ((published nil)) + ;; publish all files in the project, for each style; the actual + ;; publishing will only happen if the files are newer than the + ;; last published output, or if the file is listed in + ;; :force-publish. Files in :force-publish will not trigger the + ;; "All pages need to be published" message. + (let ((forced-files (muse-get-keyword :force-publish (cadr project))) + (file-alist (muse-project-file-alist project))) + (dolist (pair file-alist) + (when (muse-project-publish-file (cdr pair) styles force) + (setq forced-files (delete (car pair) forced-files)) + (setq published t))) + (dolist (file forced-files) + (muse-project-publish-file (cdr (assoc file file-alist)) styles t))) + ;; run hook after publishing ends + (run-hook-with-args 'muse-after-project-publish-hook project) + ;; notify the user that everything is now done + (if published + (message "All pages in %s have been published." (car project)) + (message "No pages in %s need publishing at this time." + (car project))))) + +;;;###autoload +(defun muse-project-publish (project &optional force) + "Publish the pages of PROJECT that need publishing." + (interactive (list (muse-read-project "Publish project: " nil t) + current-prefix-arg)) + (setq project (muse-project project)) + (let ((styles (cddr project)) + (muse-current-project project) + (muse-current-project-global project)) + ;; determine the style from the project, or else ask + (unless styles + (setq styles (list (muse-publish-get-style)))) + (unless project + (error "Cannot find a project to publish")) + ;; prompt to save any buffers related to this project + (muse-project-save-buffers project) + ;; run hook before publishing begins + (run-hook-with-args 'muse-before-project-publish-hook project) + ;; run the project-level publisher + (let ((fun (or (muse-get-keyword :publish-project (cadr project) t) + 'muse-project-publish-default))) + (funcall fun project styles force)))) + +(defun muse-project-batch-publish () + "Publish Muse files in batch mode." + (let ((muse-batch-publishing-p t) + force) + (if (string= "--force" (or (car command-line-args-left) "")) + (setq force t + command-line-args-left (cdr command-line-args-left))) + (if command-line-args-left + (dolist (project command-line-args-left) + (message "Publishing project %s ..." project) + (muse-project-publish project force)) + (message "No projects specified.")))) + +(eval-when-compile + (put 'make-local-hook 'byte-compile nil)) + +(defun muse-project-set-variables () + "Load project-specific variables." + (when (and muse-current-project-global (null muse-current-project)) + (setq muse-current-project muse-current-project-global)) + (let ((vars (muse-get-keyword :set (cadr muse-current-project))) + sym custom-set var) + (while vars + (setq sym (car vars)) + (setq custom-set (or (get sym 'custom-set) 'set)) + (setq var (if (eq (get sym 'custom-type) 'hook) + (make-local-hook sym) + (make-local-variable sym))) + (funcall custom-set var (car (cdr vars))) + (setq vars (cdr (cdr vars)))))) + +(custom-add-option 'muse-before-publish-hook 'muse-project-set-variables) +(add-to-list 'muse-before-publish-hook 'muse-project-set-variables) + +(defun muse-project-delete-output-files (project) + (interactive + (list (muse-read-project "Remove all output files for project: " nil t))) + (setq project (muse-project project)) + (let ((file-alist (muse-project-file-alist project)) + (styles (cddr project)) + output-file path) + (dolist (entry file-alist) + (dolist (style styles) + (setq output-file + (and (setq path (muse-style-element :path style)) + (expand-file-name + (concat (muse-style-element :prefix style) + (car entry) + (or (muse-style-element :osuffix style) + (muse-style-element :suffix style))) + path))) + (if output-file + (muse-delete-file-if-exists output-file)))))) + +;;; muse-project.el ends here diff --git a/emacs.d/elisp/muse/muse-protocols.el b/emacs.d/elisp/muse/muse-protocols.el new file mode 100644 index 0000000..5e1061c --- /dev/null +++ b/emacs.d/elisp/muse/muse-protocols.el @@ -0,0 +1,251 @@ +;;; muse-protocols.el --- URL protocols that Muse recognizes + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Brad Collins (brad AT chenla DOT org) + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Here's an example for adding a protocol for the site yubnub, a Web +;; Command line service. +;; +;; (add-to-list 'muse-url-protocols '("yubnub://" muse-browse-url-yubnub +;; muse-resolve-url-yubnub)) +;; +;; (defun muse-resolve-url-yubnub (url) +;; "Resolve a yubnub URL." +;; ;; Remove the yubnub:// +;; (when (string-match "\\`yubnub://\\(.+\\)" url) +;; (match-string 1))) +;; +;; (defun muse-browse-url-yubnub (url) +;; "If this is a yubnub URL-command, jump to it." +;; (setq url (muse-resolve-url-yubnub url)) +;; (browse-url (concat "http://yubnub.org/parser/parse?command=" +;; url))) + +;;; Contributors: + +;; Phillip Lord (Phillip.Lord AT newcastle DOT ac DOT uk) provided a +;; handler for DOI URLs. + +;; Stefan Schlee fixed a bug with handling of colons at the end of +;; URLs. + +;; Valery V. Vorotyntsev contribued the woman:// protocol handler and +;; simplified `muse-browse-url-man'. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse URL Protocols +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'info) +(require 'muse-regexps) + +(defvar muse-url-regexp nil + "A regexp used to match URLs within a Muse page. +This is autogenerated from `muse-url-protocols'.") + +(defun muse-update-url-regexp (sym value) + (setq muse-url-regexp + (concat "\\<\\(" (mapconcat 'car value "\\|") "\\)" + "[^][" muse-regexp-blank "\"'()<>^`{}\n]*" + "[^][" muse-regexp-blank "\"'()<>^`{}.,;:\n]+")) + (set sym value)) + +(defcustom muse-url-protocols + '(("[uU][rR][lL]:" muse-browse-url-url identity) + ("info://" muse-browse-url-info nil) + ("man://" muse-browse-url-man nil) + ("woman://" muse-browse-url-woman nil) + ("google://" muse-browse-url-google muse-resolve-url-google) + ("http:/?/?" browse-url identity) + ("https:/?/?" browse-url identity) + ("ftp:/?/?" browse-url identity) + ("gopher://" browse-url identity) + ("telnet://" browse-url identity) + ("wais://" browse-url identity) + ("file://?" browse-url identity) + ("dict:" muse-browse-url-dict muse-resolve-url-dict) + ("doi:" muse-browse-url-doi muse-resolve-url-doi) + ("news:" browse-url identity) + ("snews:" browse-url identity) + ("mailto:" browse-url identity)) + "A list of (PROTOCOL BROWSE-FUN RESOLVE-FUN) used to match URL protocols. +PROTOCOL describes the first part of the URL, including the +\"://\" part. This may be a regexp. + +BROWSE-FUN should accept URL as an argument and open the URL in +the current window. + +RESOLVE-FUN should accept URL as an argument and return the final +URL, or nil if no URL should be included." + :type '(repeat (list :tag "Protocol" + (string :tag "Regexp") + (function :tag "Browse") + (choice (function :tag "Resolve") + (const :tag "Don't resolve" nil)))) + :set 'muse-update-url-regexp + :group 'muse) + +(add-hook 'muse-update-values-hook + (lambda () + (muse-update-url-regexp 'muse-url-protocols muse-url-protocols))) + +(defcustom muse-wikipedia-country "en" + "Indicate the 2-digit country code that we use for Wikipedia +queries." + :type 'string + :options '("de" "en" "es" "fr" "it" "pl" "pt" "ja" "nl" "sv") + :group 'muse) + +(defun muse-protocol-find (proto list) + "Return the first element of LIST whose car matches the regexp PROTO." + (catch 'found + (dolist (item list) + (when (string-match (concat "\\`" (car item)) proto) + (throw 'found item))))) + +;;;###autoload +(defun muse-browse-url (url &optional other-window) + "Handle URL with the function specified in `muse-url-protocols'. +If OTHER-WINDOW is non-nil, open in a different window." + (interactive (list (read-string "URL: ") + current-prefix-arg)) + ;; Strip text properties + (when (fboundp 'set-text-properties) + (set-text-properties 0 (length url) nil url)) + (when other-window + (switch-to-buffer-other-window (current-buffer))) + (when (string-match muse-url-regexp url) + (let* ((proto (match-string 1 url)) + (entry (muse-protocol-find proto muse-url-protocols))) + (when entry + (funcall (cadr entry) url))))) + +(defun muse-resolve-url (url &rest ignored) + "Resolve URL with the function specified in `muse-url-protocols'." + (when (string-match muse-url-regexp url) + (let* ((proto (match-string 1 url)) + (entry (muse-protocol-find proto muse-url-protocols))) + (when entry + (let ((func (car (cddr entry)))) + (if func + (setq url (funcall func url)) + (setq url nil)))))) + url) + +(defun muse-protocol-add (protocol browse-function resolve-function) + "Add PROTOCOL to `muse-url-protocols'. PROTOCOL may be a regexp. + +BROWSE-FUNCTION should be a function that visits a URL in the +current buffer. + +RESOLVE-FUNCTION should be a function that transforms a URL for +publishing or returns nil if not linked." + (add-to-list 'muse-url-protocols + (list protocol browse-function resolve-function)) + (muse-update-url-regexp 'muse-url-protocols + muse-url-protocols)) + +(defun muse-browse-url-url (url) + "Call `muse-protocol-browse-url' to browse URL. +This is used when we are given something like +\"URL:http://example.org/\". + +If you're looking for a good example for how to make a custom URL +handler, look at `muse-browse-url-dict' instead." + (when (string-match "\\`[uU][rR][lL]:\\(.+\\)" url) + (muse-browse-url (match-string 1 url)))) + +(defun muse-resolve-url-dict (url) + "Return the Wikipedia link corresponding with the given URL." + (when (string-match "\\`dict:\\(.+\\)" url) + (concat "http://" muse-wikipedia-country ".wikipedia.org/" + "wiki/Special:Search?search=" (match-string 1 url)))) + +(defun muse-browse-url-dict (url) + "If this is a Wikipedia URL, browse it." + (let ((dict-url (muse-resolve-url-dict url))) + (when dict-url + (browse-url dict-url)))) + +(defun muse-resolve-url-doi (url) + "Return the URL through DOI proxy server." + (when (string-match "\\`doi:\\(.+\\)" url) + (concat "http://dx.doi.org/" + (match-string 1 url)))) + +(defun muse-browse-url-doi (url) + "If this is a DOI URL, browse it. + +DOI's (digitial object identifiers) are a standard identifier +used in the publishing industry." + (let ((doi-url (muse-resolve-url-doi url))) + (when doi-url + (browse-url doi-url)))) + +(defun muse-resolve-url-google (url) + "Return the correct Google search string." + (when (string-match "\\`google:/?/?\\(.+\\)" url) + (concat "http://www.google.com/search?q=" + (match-string 1 url)))) + +(defun muse-browse-url-google (url) + "If this is a Google URL, jump to it." + (let ((google-url (muse-resolve-url-google url))) + (when google-url + (browse-url google-url)))) + +(defun muse-browse-url-info (url) + "If this in an Info URL, jump to it." + (require 'info) + (cond + ((string-match "\\`info://\\([^#\n]+\\)#\\(.+\\)" url) + (Info-find-node (match-string 1 url) + (match-string 2 url))) + ((string-match "\\`info://\\([^#\n]+\\)" url) + (Info-find-node (match-string 1 url) + "Top")) + ((string-match "\\`info://(\\([^)\n]+\\))\\(.+\\)" url) + (Info-find-node (match-string 1 url) (match-string 2 url))) + ((string-match "\\`info://\\(.+\\)" url) + (Info-find-node (match-string 1 url) "Top")))) + +(defun muse-browse-url-man (url) + "If this in a manpage URL, jump to it." + (require 'man) + (when (string-match "\\`man://\\([^(]+\\(([^)]+)\\)?\\)" url) + (man (match-string 1 url)))) + +(defun muse-browse-url-woman (url) + "If this is a WoMan URL, jump to it." + (require 'woman) + (when (string-match "\\`woman://\\(.+\\)" url) + (woman (match-string 1 url)))) + +(provide 'muse-protocols) + +;;; muse-protocols.el ends here diff --git a/emacs.d/elisp/muse/muse-publish.el b/emacs.d/elisp/muse/muse-publish.el new file mode 100644 index 0000000..ec6e176 --- /dev/null +++ b/emacs.d/elisp/muse/muse-publish.el @@ -0,0 +1,2193 @@ +;;; muse-publish.el --- base publishing implementation + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;; Yann Hodique (yann DOT hodique AT gmail DOT com) fixed an +;; unnecessary URL description transform in `muse-publish-url'. + +;; Peter K. Lee (saint AT corenova DOT com) provided the +;; `muse-style-elements-list' function. + +;; Jim Ottaway (j DOT ottaway AT lse DOT ac DOT uk) provided a +;; reference implementation for nested lists, as well as some code for +;; the "style" element of the <literal> tag. + +;; Deus Max (deusmax AT gmail DOT com) provided the <php> tag. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(provide 'muse-publish) + +(require 'muse) +(require 'muse-regexps) + +(defgroup muse-publish nil + "Options controlling the general behavior of Muse publishing." + :group 'muse) + +(defcustom muse-before-publish-hook nil + "A hook run in the buffer to be published, before it is done." + :type 'hook + :group 'muse-publish) + +(defcustom muse-after-publish-hook nil + "A hook run in the buffer to be published, after it is done." + :type 'hook + :group 'muse-publish) + +(defcustom muse-publish-url-transforms + '(muse-resolve-url) + "A list of functions used to prepare URLs for publication. +Each is passed the URL. The transformed URL should be returned." + :type 'hook + :options '(muse-resolve-url) + :group 'muse-publish) + +(defcustom muse-publish-desc-transforms + '(muse-publish-strip-URL) + "A list of functions used to prepare URL desciptions for publication. +Each is passed the description. The modified description should +be returned." + :type 'hook + :options '(muse-publish-strip-URL) + :group 'muse-publish) + +(defcustom muse-publish-date-format "%B %e, %Y" + "Format string for the date, used by `muse-publish-markup-buffer'. +See `format-time-string' for details on the format options." + :type 'string + :group 'muse-publish) + +(defcustom muse-publish-comments-p nil + "If nil, remove comments before publishing. +If non-nil, publish comments using the markup of the current style." + :type 'boolean + :group 'muse-publish) + +(defcustom muse-publish-report-threshhold 100000 + "If a file is this size or larger, report publishing progress." + :type 'integer + :group 'muse-publish) + +(defcustom muse-publish-markup-regexps + `(;; Remove leading and trailing whitespace from the file + (1000 "\\(\\`\n+\\|\n+\\'\\)" 0 "") + + ;; Remove trailing whitespace from all lines + (1100 ,(concat "[" muse-regexp-blank "]+$") 0 "") + + ;; Handle any leading #directives + (1200 "\\`#\\([a-zA-Z-]+\\)\\s-+\\(.+\\)\n+" 0 directive) + + ;; commented lines + (1250 ,(concat "^;\\(?:[" muse-regexp-blank "]+\\(.+\\)\\|$\\|'\\)") + 0 comment) + + ;; markup tags + (1300 muse-tag-regexp 0 tag) + + ;; prevent emphasis characters in explicit links from being marked + (1400 muse-explicit-link-regexp 0 muse-publish-mark-link) + + ;; emphasized or literal text + (1600 ,(concat "\\(^\\|[-[" muse-regexp-blank + "<('`\"\n]\\)\\(=[^=" muse-regexp-blank + "\n]\\|_[^_" muse-regexp-blank + "\n]\\|\\*+[^*" muse-regexp-blank + "\n]\\)") + 2 word) + + ;; headings, outline-mode style + (1700 "^\\(\\*+\\)\\s-+" 0 heading) + + ;; ellipses + (1800 "\\.\\.\\.\\." 0 enddots) + (1850 "\\.\\.\\." 0 dots) + + ;; horizontal rule, or section separator + (1900 "^----+" 0 rule) + + ;; non-breaking space + (1950 "~~" 0 no-break-space) + + ;; beginning of footnotes section + (2000 "^Footnotes:?\\s-*" 0 fn-sep) + ;; footnote definition/reference (def if at beginning of line) + (2100 "\\[\\([1-9][0-9]*\\)\\]" 0 footnote) + + ;; unnumbered List items begin with a -. numbered list items + ;; begin with number and a period. definition lists have a + ;; leading term separated from the body with ::. centered + ;; paragraphs begin with at least six columns of whitespace; any + ;; other whitespace at the beginning indicates a blockquote. The + ;; reason all of these rules are handled here, is so that + ;; blockquote detection doesn't interfere with indented list + ;; members. + (2200 ,(format muse-list-item-regexp (concat "[" muse-regexp-blank "]*")) + 0 list) + + ;; support table.el style tables + (2300 ,(concat "^" muse-table-el-border-regexp "\n" + "\\(\\(" muse-table-el-line-regexp "\n\\)+" + "\\(" muse-table-el-border-regexp "\\)" + "\\(\n\\|\\'\\)\\)+") + 0 table-el) + + ;; simple table markup is supported, nothing fancy. use | to + ;; separate cells, || to separate header cells, and ||| for footer + ;; cells + (2350 ,(concat "\\(\\([" muse-regexp-blank "]*\n\\)?" + "\\(\\(?:" muse-table-line-regexp "\\|" + muse-table-hline-regexp "\\)\\(?:\n\\|\\'\\)\\)\\)+") + 0 table) + + ;; blockquote and centered text + (2400 ,(concat "^\\([" muse-regexp-blank "]+\\).+") 0 quote) + + ;; the emdash ("--" or "---") + (2500 ,(concat "\\(^\\|[" muse-regexp-blank "]*\\)---?\\($\\|[" + muse-regexp-blank "]*\\)") + 0 emdash) + + ;; "verse" text is indicated the same way as a quoted e-mail + ;; response: "> text", where text may contain initial whitespace + ;; (see below). + (2600 ,(concat "^[" muse-regexp-blank "]*> ") 0 verse) + + ;; define anchor points + (2700 "^\\(\\W*\\)#\\(\\S-+\\)\\s-*" 0 anchor) + + ;; replace links in the buffer (links to other pages) + (2900 muse-explicit-link-regexp 0 link) + + ;; bare URLs + (3000 muse-url-regexp 0 url) + + ;; bare email addresses + (3500 + "\\([^[]\\)[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" 0 email) + ) + "List of markup rules for publishing a page with Muse. +The rules given in this variable are invoked first, followed by +whatever rules are specified by the current style. + +Each member of the list is either a function, or a list of the form: + + (REGEXP/SYMBOL TEXT-BEGIN-GROUP REPLACEMENT-TEXT/FUNCTION/SYMBOL) + +REGEXP is a regular expression, or symbol whose value is a regular +expression, which is searched for using `re-search-forward'. +TEXT-BEGIN-GROUP is the matching group within that regexp which +denotes the beginning of the actual text to be marked up. +REPLACEMENT-TEXT is a string that will be passed to `replace-match'. +If it is not a string, but a function, it will be called to determine +what the replacement text should be (it must return a string). If it +is a symbol, the value of that symbol should be a string. + +The replacements are done in order, one rule at a time. Writing +the regular expressions can be a tricky business. Note that case +is never ignored. `case-fold-search' is always bound to nil +while processing the markup rules." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-publish) + +(defcustom muse-publish-markup-functions + '((directive . muse-publish-markup-directive) + (comment . muse-publish-markup-comment) + (anchor . muse-publish-markup-anchor) + (tag . muse-publish-markup-tag) + (word . muse-publish-markup-word) + (emdash . muse-publish-markup-emdash) + (enddots . muse-publish-markup-enddots) + (dots . muse-publish-markup-dots) + (rule . muse-publish-markup-rule) + (no-break-space . muse-publish-markup-no-break-space) + (heading . muse-publish-markup-heading) + (footnote . muse-publish-markup-footnote) + (fn-sep . muse-publish-markup-fn-sep) + (list . muse-publish-markup-list) + (quote . muse-publish-markup-quote) + (verse . muse-publish-markup-verse) + (table . muse-publish-markup-table) + (table-el . muse-publish-markup-table-el) + (email . muse-publish-markup-email) + (link . muse-publish-markup-link) + (url . muse-publish-markup-url)) + "An alist of style types to custom functions for that kind of text. + +Each member of the list is of the form: + + (SYMBOL FUNCTION) + +SYMBOL describes the type of text to associate with this rule. +`muse-publish-markup-regexps' maps regexps to these symbols. + +FUNCTION is the function to use to mark up this kind of rule if +no suitable function is found through the :functions tag of the +current style." + :type '(alist :key-type symbol :value-type function) + :group 'muse-publish) + +(defcustom muse-publish-markup-tags + '(("contents" nil t nil muse-publish-contents-tag) + ("verse" t nil nil muse-publish-verse-tag) + ("example" t nil nil muse-publish-example-tag) + ("src" t t nil muse-publish-src-tag) + ("code" t nil nil muse-publish-code-tag) + ("quote" t nil t muse-publish-quote-tag) + ("literal" t t nil muse-publish-literal-tag) + ("verbatim" t nil nil muse-publish-verbatim-tag) + ("br" nil nil nil muse-publish-br-tag) + ("lisp" t t nil muse-publish-lisp-tag) + ("class" t t nil muse-publish-class-tag) + ("div" t t nil muse-publish-div-tag) + ("command" t t nil muse-publish-command-tag) + ("perl" t t nil muse-publish-perl-tag) + ("php" t t nil muse-publish-php-tag) + ("python" t t nil muse-publish-python-tag) + ("ruby" t t nil muse-publish-ruby-tag) + ("comment" t nil nil muse-publish-comment-tag) + ("include" nil t nil muse-publish-include-tag) + ("markup" t t nil muse-publish-mark-up-tag) + ("cite" t t nil muse-publish-cite-tag)) + "A list of tag specifications, for specially marking up text. +XML-style tags are the best way to add custom markup to Muse. +This is easily accomplished by customizing this list of markup tags. + +For each entry, the name of the tag is given, whether it expects +a closing tag, whether it takes an optional set of attributes, +whether it is nestable, and a function that performs whatever +action is desired within the delimited region. + +The tags themselves are deleted during publishing, before the +function is called. The function is called with three arguments, +the beginning and end of the region surrounded by the tags. If +properties are allowed, they are passed as a third argument in +the form of an alist. The `end' argument to the function is +always a marker. + +Point is always at the beginning of the region within the tags, when +the function is called. Wherever point is when the function finishes +is where tag markup will resume. + +These tag rules are processed once at the beginning of markup, and +once at the end, to catch any tags which may have been inserted +in-between." + :type '(repeat (list (string :tag "Markup tag") + (boolean :tag "Expect closing tag" :value t) + (boolean :tag "Parse attributes" :value nil) + (boolean :tag "Nestable" :value nil) + function)) + :group 'muse-publish) + +(defcustom muse-publish-markup-header-footer-tags + '(("lisp" t t nil muse-publish-lisp-tag) + ("markup" t t nil muse-publish-mark-up-tag)) + "Tags used when publishing headers and footers. +See `muse-publish-markup-tags' for details." + :type '(repeat (list (string :tag "Markup tag") + (boolean :tag "Expect closing tag" :value t) + (boolean :tag "Parse attributes" :value nil) + (boolean :tag "Nestable" :value nil) + function)) + :group 'muse-publish) + +(defcustom muse-publish-markup-specials nil + "A table of characters which must be represented specially." + :type '(alist :key-type character :value-type string) + :group 'muse-publish) + +(defcustom muse-publish-enable-local-variables nil + "If non-nil, interpret local variables in a file when publishing." + :type 'boolean + :group 'muse-publish) + +(defcustom muse-publish-enable-dangerous-tags t + "If non-nil, publish tags like <lisp> and <command> that can +call external programs or expose sensitive information. +Otherwise, ignore tags like this. + +This is useful to set to nil when the file to publish is coming +from an untrusted source." + :type 'boolean + :group 'muse-publish) + +(defvar muse-publishing-p nil + "This is set to t while a page is being published.") +(defvar muse-batch-publishing-p nil + "This is set to t while a page is being batch published.") +(defvar muse-inhibit-before-publish-hook nil + "This is set to t when publishing a file rather than just a buffer. +It is used by `muse-publish-markup-buffer'.") +(defvar muse-publishing-styles nil + "The publishing styles that Muse recognizes. +This is automatically generated when loading publishing styles.") +(defvar muse-publishing-current-file nil + "The file that is currently being published.") +(defvar muse-publishing-current-output-path nil + "The path where the current file will be published to.") +(defvar muse-publishing-current-style nil + "The style of the file that is currently being published.") +(defvar muse-publishing-directives nil + "An alist of publishing directives from the top of a file.") +(defvar muse-publish-generate-contents nil + "Non-nil if a table of contents should be generated. +If non-nil, it is a cons cell specifying (MARKER . DEPTH), to +tell where the <contents> was seen, and to what depth the +contents were requested.") +(defvar muse-publishing-last-position nil + "Last position of the point when publishing. +This is used to make sure that publishing doesn't get stalled.") + +(defvar muse-publish-inhibit-style-hooks nil + "If non-nil, do not call the :before or :before-end hooks when publishing.") + +(defvar muse-publish-use-header-footer-tags nil + "If non-nil, use `muse-publish-markup-header-footer-tags' for looking up +tags. Otherwise, use `muse-publish-markup-tags'.") + +(defvar muse-inhibit-style-tags nil + "If non-nil, do not search for style-specific tags. +This is used when publishing headers and footers.") + +;; Functions for handling style information + +(defsubst muse-style (&optional style) + "Resolve the given STYLE into a Muse style, if it is a string." + (if (null style) + muse-publishing-current-style + (if (stringp style) + (assoc style muse-publishing-styles) + (muse-assert (consp style)) + style))) + +(defun muse-define-style (name &rest elements) + (let ((entry (assoc name muse-publishing-styles))) + (if entry + (setcdr entry elements) + (setq muse-publishing-styles + (cons (append (list name) elements) + muse-publishing-styles))))) + +(defun muse-derive-style (new-name base-name &rest elements) + (apply 'muse-define-style new-name + (append elements (list :base base-name)))) + +(defsubst muse-get-keyword (keyword list &optional direct) + (let ((value (cadr (memq keyword list)))) + (if (and (not direct) (symbolp value)) + (symbol-value value) + value))) + +(defun muse-style-elements-list (elem &optional style) + "Return a list all references to ELEM in STYLE, including base styles. +If STYLE is not specified, use current style." + (let (base elements) + (while style + (setq style (muse-style style)) + (setq elements (append elements + (muse-get-keyword elem style))) + (setq style (muse-get-keyword :base style))) + elements)) + +(defun muse-style-element (elem &optional style direct) + "Search for ELEM in STYLE, including base styles. +If STYLE is not specified, use current style." + (setq style (muse-style style)) + (let ((value (muse-get-keyword elem style direct))) + (if value + value + (let ((base (muse-get-keyword :base style))) + (if base + (muse-style-element elem base direct)))))) + +(defun muse-style-derived-p-1 (base style) + "Internal function used by `muse-style-derived-p'." + (if (and (stringp style) + (string= style base)) + t + (setq style (muse-style style)) + (let ((value (muse-get-keyword :base style))) + (when value + (muse-style-derived-p base value))))) + +(defun muse-style-derived-p (base &optional style) + "Return non-nil if STYLE is equal to or derived from BASE, +non-nil otherwise. + +BASE should be a string." + (unless style + (setq style (muse-style))) + (when (and (consp style) + (stringp (car style))) + (setq style (car style))) + (muse-style-derived-p-1 base style)) + +(defun muse-find-markup-element (keyword ident style) + (let ((def (assq ident (muse-style-element keyword style)))) + (if def + (cdr def) + (let ((base (muse-style-element :base style))) + (if base + (muse-find-markup-element keyword ident base)))))) + +(defun muse-markup-text (ident &rest args) + "Insert ARGS into the text markup associated with IDENT. +If the markup text has sections like %N%, this will be replaced +with the N-1th argument in ARGS. After that, `format' is applied +to the text with ARGS as parameters." + (let ((text (muse-find-markup-element :strings ident (muse-style)))) + (if (and text args) + (progn + (let (start repl-text) + (while (setq start (string-match "%\\([1-9][0-9]*\\)%" text start)) + ;; escape '%' in the argument text, since we will be + ;; using format on it + (setq repl-text (muse-replace-regexp-in-string + "%" "%%" + (nth (1- (string-to-number + (match-string 1 text))) args) + t t) + start (+ start (length repl-text)) + text (replace-match repl-text t t text)))) + (apply 'format text args)) + (or text "")))) + +(defun muse-insert-markup (&rest args) + (let ((beg (point))) + (apply 'insert args) + (muse-publish-mark-read-only beg (point)))) + +(defun muse-find-markup-tag (keyword tagname style) + (let ((def (assoc tagname (muse-style-element keyword style)))) + (or def + (let ((base (muse-style-element :base style))) + (if base + (muse-find-markup-tag keyword tagname base)))))) + +(defun muse-markup-tag-info (tagname &rest args) + (let ((tag-info (and (not muse-inhibit-style-tags) + (muse-find-markup-tag :tags tagname (muse-style))))) + (or tag-info + (assoc tagname + (if muse-publish-use-header-footer-tags + muse-publish-markup-header-footer-tags + muse-publish-markup-tags))))) + +(defsubst muse-markup-function (category) + (let ((func (muse-find-markup-element :functions category (muse-style)))) + (or func + (cdr (assq category muse-publish-markup-functions))))) + +;; Publishing routines + +(defun muse-publish-markup (name rules) + (let* ((case-fold-search nil) + (inhibit-read-only t) + (limit (* (length rules) (point-max))) + (verbose (and muse-publish-report-threshhold + (> (point-max) muse-publish-report-threshhold))) + (base 0)) + (while rules + (goto-char (point-min)) + (let ((regexp (nth 1 (car rules))) + (group (nth 2 (car rules))) + (repl (nth 3 (car rules))) + pos) + (setq muse-publishing-last-position nil) + (if (symbolp regexp) + (setq regexp (symbol-value regexp))) + (if (and verbose (not muse-batch-publishing-p)) + (message "Publishing %s...%d%%" name + (* (/ (float (+ (point) base)) limit) 100))) + (while (and regexp (progn + (when (and (get-text-property (point) 'read-only) + (> (point) (point-min))) + (goto-char (or (next-single-property-change + (point) 'read-only) + (point-max)))) + (setq pos (re-search-forward regexp nil t)))) + (if (and verbose (not muse-batch-publishing-p)) + (message "Publishing %s...%d%%" name + (* (/ (float (+ (point) base)) limit) 100))) + (unless (and (> (- (match-end 0) (match-beginning 0)) 0) + (match-beginning group) + (get-text-property (match-beginning group) 'read-only)) + (let* (func + (text (cond + ((and (symbolp repl) + (setq func (muse-markup-function repl))) + (funcall func)) + ((functionp repl) + (funcall repl)) + ((symbolp repl) + (symbol-value repl)) + (t repl)))) + (if (stringp text) + (replace-match text t)))) + (if (and muse-publishing-last-position + (= pos muse-publishing-last-position)) + (if (eobp) + (setq regexp nil) + (forward-char 1))) + (setq muse-publishing-last-position pos))) + (setq rules (cdr rules) + base (+ base (point-max)))) + (if (and verbose (not muse-batch-publishing-p)) + (message "Publishing %s...done" name)))) + +(defun muse-insert-file-or-string (file-or-string &optional title) + (let ((beg (point)) end) + (if (and (not (string-equal file-or-string "")) + (not (string-match "\n" file-or-string)) + (file-readable-p file-or-string)) + (setq end (+ beg + (cadr (muse-insert-file-contents file-or-string)))) + (insert file-or-string) + (setq end (point))) + (save-restriction + (narrow-to-region beg end) + (remove-text-properties (point-min) (point-max) + '(read-only nil rear-nonsticky nil)) + (goto-char (point-min)) + (let ((muse-inhibit-style-tags t) + (muse-publish-use-header-footer-tags t)) + (muse-publish-markup (or title "") + '((100 muse-tag-regexp 0 + muse-publish-markup-tag))))))) + +(defun muse-style-run-hooks (keyword style &rest args) + (catch 'handled + (let ((cache nil)) + (while (and style + (setq style (muse-style style))) + (let ((func (muse-style-element keyword style t))) + (when (and func + (not (member func cache))) + (setq cache (cons func cache)) + (when (apply func args) + (throw 'handled t)))) + (setq style (muse-style-element :base style)))))) + +(defun muse-publish-markup-region (beg end &optional title style) + "Apply the given STYLE's markup rules to the given region. +TITLE is used when indicating the publishing progress; it may be nil. + +The point is guaranteed to be at END if the routine terminates +normally." + (unless title (setq title "")) + (unless style + (or (setq style muse-publishing-current-style) + (error "Cannot find any publishing styles to use"))) + (save-restriction + (narrow-to-region beg end) + (let ((muse-publish-generate-contents nil)) + (unless muse-publish-inhibit-style-hooks + (muse-style-run-hooks :before style)) + (muse-publish-markup + title + (sort (copy-alist (append muse-publish-markup-regexps + (muse-style-elements-list :regexps style))) + (function + (lambda (l r) + (< (car l) (car r)))))) + (unless muse-publish-inhibit-style-hooks + (muse-style-run-hooks :before-end style)) + (muse-publish-escape-specials (point-min) (point-max) nil 'document)) + (goto-char (point-max)))) + +(defun muse-publish-markup-buffer (title style) + "Apply the given STYLE's markup rules to the current buffer." + (setq style (muse-style style)) + (let ((style-header (muse-style-element :header style)) + (style-footer (muse-style-element :footer style)) + (muse-publishing-current-style style) + (muse-publishing-directives + (list (cons "title" title) + (cons "author" (user-full-name)) + (cons "date" (format-time-string + muse-publish-date-format + (if muse-publishing-current-file + (nth 5 (file-attributes + muse-publishing-current-file)) + (current-time)))))) + (muse-publishing-p t) + (inhibit-read-only t)) + (run-hooks 'muse-update-values-hook) + (unless muse-inhibit-before-publish-hook + (run-hooks 'muse-before-publish-hook)) + (muse-publish-markup-region (point-min) (point-max) title style) + (goto-char (point-min)) + (when style-header + (muse-insert-file-or-string style-header title)) + (goto-char (point-max)) + (when style-footer + (muse-insert-file-or-string style-footer title)) + (muse-style-run-hooks :after style) + (run-hooks 'muse-after-publish-hook))) + +(defun muse-publish-markup-string (string &optional style) + "Markup STRING using the given STYLE's markup rules." + (setq style (muse-style style)) + (muse-with-temp-buffer + (insert string) + (let ((muse-publishing-current-style style) + (muse-publishing-p t)) + (muse-publish-markup "*string*" (muse-style-element :rules style))) + (buffer-string))) + +;; Commands for publishing files + +(defun muse-publish-get-style (&optional styles) + (unless styles (setq styles muse-publishing-styles)) + (if (= 1 (length styles)) + (car styles) + (when (catch 'different + (let ((first (car (car styles)))) + (dolist (style (cdr styles)) + (unless (equal first (car style)) + (throw 'different t))))) + (setq styles (muse-collect-alist + styles + (funcall muse-completing-read-function + "Publish with style: " styles nil t)))) + (if (or (= 1 (length styles)) + (not (muse-get-keyword :path (car styles)))) + (car styles) + (setq styles (mapcar (lambda (style) + (cons (muse-get-keyword :path style) + style)) + styles)) + (cdr (assoc (funcall muse-completing-read-function + "Publish to directory: " styles nil t) + styles))))) + +(defsubst muse-publish-get-output-dir (style) + (let ((default-directory (or (muse-style-element :path style) + default-directory))) + (muse-read-directory-name "Publish to directory: " nil default-directory))) + +(defsubst muse-publish-get-info () + (let ((style (muse-publish-get-style))) + (list style (muse-publish-get-output-dir style) + current-prefix-arg))) + +(defsubst muse-publish-output-name (&optional file style) + (setq style (muse-style style)) + (concat (muse-style-element :prefix style) + (muse-page-name file) + (muse-style-element :suffix style))) + +(defsubst muse-publish-output-file (file &optional output-dir style) + (setq style (muse-style style)) + (if output-dir + (expand-file-name (muse-publish-output-name file style) output-dir) + (concat (file-name-directory file) + (muse-publish-output-name file style)))) + +(defsubst muse-publish-link-name (&optional file style) + "Take FILE and add :prefix and either :link-suffix or :suffix from STYLE. +We assume that FILE is a Muse file. + +We call `muse-page-name' on FILE to remove the directory part of +FILE and any extensions that are in `muse-ignored-extensions'." + (setq style (muse-style style)) + (concat (muse-style-element :prefix style) + (muse-page-name file) + (or (muse-style-element :link-suffix style) + (muse-style-element :suffix style)))) + +(defsubst muse-publish-link-file (file &optional style) + "Turn FILE into a URL. + +If FILE exists on the system as-is, return it without +modification. In the case of wanting to link to Muse files when +`muse-file-extension' is nil, you should load muse-project.el. + +Otherwise, assume that it is a Muse file and call +`muse-publish-link-name' to add :prefix, :link-suffix, :suffix, +and removing ignored file extensions, but preserving the +directory part of FILE." + (setq style (muse-style style)) + (if (file-exists-p file) + file + (concat (file-name-directory file) + (muse-publish-link-name file style)))) + +(defsubst muse-publish-link-page (page) + "Turn PAGE into a URL. + +This is called by `muse-publish-classify-url' to figure out what +a link to another file or Muse page should look like. + +If muse-project.el is loaded, call `muse-project-link-page' for this. +Otherwise, call `muse-publish-link-file'." + (if (fboundp 'muse-project-link-page) + (muse-project-link-page page) + (muse-publish-link-file page))) + +(defmacro muse-publish-ensure-block (beg &optional end) + "Ensure that block-level markup at BEG is published with at least one +preceding blank line. BEG must be an unquoted symbol that contains a +position or marker. BEG is modified to be the new position. +The point is left at the new value of BEG. + +Additionally, make sure that BEG is placed on a blank line. + +If END is given, make sure that it is placed on a blank line. In +order to achieve this, END must be an unquoted symbol that +contains a marker. This is the case with Muse tag functions." + `(progn + (goto-char ,beg) + (cond ((not (bolp)) (insert "\n\n")) + ((eq (point) (point-min)) nil) + ((prog2 (backward-char) (bolp) (forward-char)) nil) + (t (insert "\n"))) + (unless (and (bolp) (eolp)) + (insert "\n") + (backward-char)) + (setq ,beg (point)) + (when (markerp ,end) + (goto-char ,end) + (unless (and (bolp) (eolp)) + (insert-before-markers "\n"))) + (goto-char ,beg))) + +;;;###autoload +(defun muse-publish-region (beg end &optional title style) + "Apply the given STYLE's markup rules to the given region. +The result is placed in a new buffer that includes TITLE in its name." + (interactive "r") + (when (interactive-p) + (unless title (setq title (read-string "Title: "))) + (unless style (setq style (muse-publish-get-style)))) + (let ((text (buffer-substring beg end)) + (buf (generate-new-buffer (concat "*Muse: " title "*")))) + (with-current-buffer buf + (insert text) + (muse-publish-markup-buffer title style) + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) + '(rear-nonsticky nil read-only nil)))) + (pop-to-buffer buf))) + +;;;###autoload +(defun muse-publish-file (file style &optional output-dir force) + "Publish the given FILE in a particular STYLE to OUTPUT-DIR. +If the argument FORCE is nil, each file is only published if it is +newer than the published version. If the argument FORCE is non-nil, +the file is published no matter what." + (interactive (cons (read-file-name "Publish file: ") + (muse-publish-get-info))) + (let ((style-name style)) + (setq style (muse-style style)) + (unless style + (error "There is no style '%s' defined" style-name))) + (let* ((output-path (muse-publish-output-file file output-dir style)) + (output-suffix (muse-style-element :osuffix style)) + (muse-publishing-current-file file) + (muse-publishing-current-output-path output-path) + (target (if output-suffix + (concat (muse-path-sans-extension output-path) + output-suffix) + output-path)) + (threshhold (nth 7 (file-attributes file)))) + (if (not threshhold) + (message "Please save %s before publishing" file) + (when (or force (file-newer-than-file-p file target)) + (if (and muse-publish-report-threshhold + (> threshhold + muse-publish-report-threshhold)) + (message "Publishing %s ..." file)) + (muse-with-temp-buffer + (muse-insert-file-contents file) + (run-hooks 'muse-before-publish-hook) + (when muse-publish-enable-local-variables + (hack-local-variables)) + (let ((muse-inhibit-before-publish-hook t)) + (muse-publish-markup-buffer (muse-page-name file) style)) + (when (muse-write-file output-path) + (muse-style-run-hooks :final style file output-path target))) + t)))) + +;;;###autoload +(defun muse-publish-this-file (style output-dir &optional force) + "Publish the currently-visited file. +Prompt for both the STYLE and OUTPUT-DIR if they are not +supplied." + (interactive (muse-publish-get-info)) + (setq style (muse-style style)) + (if buffer-file-name + (let ((muse-current-output-style (list :base (car style) + :path output-dir))) + (unless (muse-publish-file buffer-file-name style output-dir force) + (message (concat "The published version is up-to-date; use" + " C-u C-c C-T to force an update.")))) + (message "This buffer is not associated with any file"))) + +(defun muse-batch-publish-files () + "Publish Muse files in batch mode." + (let ((muse-batch-publishing-p t) + (font-lock-verbose nil) + muse-current-output-style + style output-dir) + ;; don't activate VC when publishing files + (setq vc-handled-backends nil) + (setq style (car command-line-args-left) + command-line-args-left (cdr command-line-args-left) + output-dir (car command-line-args-left) + output-dir + (if (string-match "\\`--output-dir=" output-dir) + (prog1 + (substring output-dir (match-end 0)) + (setq command-line-args-left (cdr command-line-args-left)))) + muse-current-output-style (list :base style :path output-dir)) + (setq auto-mode-alist + (delete (cons (concat "\\." muse-file-extension "\\'") + 'muse-mode-choose-mode) + auto-mode-alist)) + (dolist (file command-line-args-left) + (muse-publish-file file style output-dir t)))) + +;; Default publishing rules + +(defun muse-publish-section-close (depth) + "Seach forward for the closing tag of given DEPTH." + (let (not-end) + (save-excursion + (while (and (setq not-end (re-search-forward + (concat "^\\*\\{1," (number-to-string depth) + "\\}\\s-+") + nil t)) + (get-text-property (match-beginning 0) 'read-only))) + (if not-end + (forward-line 0) + (goto-char (point-max))) + (cond ((not (eq (char-before) ?\n)) + (insert "\n\n")) + ((not (eq (char-before (1- (point))) ?\n)) + (insert "\n"))) + (muse-insert-markup (muse-markup-text 'section-close depth)) + (insert "\n")))) + +(defun muse-publish-markup-directive (&optional name value) + (unless name (setq name (match-string 1))) + (unless value (setq value (match-string 2))) + (let ((elem (assoc name muse-publishing-directives))) + (if elem + (setcdr elem value) + (setq muse-publishing-directives + (cons (cons name value) + muse-publishing-directives)))) + ;; Make sure we don't ever try to move the point forward (past the + ;; beginning of buffer) while we're still searching for directives. + (setq muse-publishing-last-position nil) + (delete-region (match-beginning 0) (match-end 0))) + +(defsubst muse-publishing-directive (name) + (cdr (assoc name muse-publishing-directives))) + +(defmacro muse-publish-get-and-delete-attr (attr attrs) + "Delete attribute ATTR from ATTRS only once, destructively. + +This function returns the matching attribute value, if found." + (let ((last (make-symbol "last")) + (found (make-symbol "found")) + (vals (make-symbol "vals"))) + `(let ((,vals ,attrs)) + (if (string= (caar ,vals) ,attr) + (prog1 (cdar ,vals) + (setq ,attrs (cdr ,vals))) + (let ((,last ,vals) + (,found nil)) + (while ,vals + (setq ,vals (cdr ,vals)) + (when (string= (caar ,vals) ,attr) + (setq ,found (cdar ,vals)) + (setcdr ,last (cdr ,vals)) + (setq ,vals nil)) + (setq ,last ,vals)) + ,found))))) + +(defun muse-publish-markup-anchor () + (unless (get-text-property (match-end 1) 'muse-link) + (let ((text (muse-markup-text 'anchor (match-string 2)))) + (unless (string= text "") + (save-match-data + (skip-chars-forward (concat muse-regexp-blank "\n")) + (muse-insert-markup text))) + (match-string 1)))) + +(defun muse-publish-markup-comment () + (if (null muse-publish-comments-p) + "" + (goto-char (match-end 0)) + (muse-insert-markup (muse-markup-text 'comment-end)) + (if (match-beginning 1) + (progn + (muse-publish-mark-read-only (match-beginning 1) (match-end 1)) + (delete-region (match-beginning 0) (match-beginning 1))) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (match-beginning 0)) + (muse-insert-markup (muse-markup-text 'comment-begin)))) + +(defun muse-publish-markup-tag () + (let ((tag-info (muse-markup-tag-info (match-string 1)))) + (when (and tag-info + (not (get-text-property (match-beginning 0) 'read-only)) + (nth 4 tag-info) + (or muse-publish-enable-dangerous-tags + (not (get (nth 4 tag-info) 'muse-dangerous-tag)))) + (let ((closed-tag (match-string 3)) + (start (match-beginning 0)) + (beg (point)) + end attrs) + (when (nth 2 tag-info) + (let ((attrstr (match-string 2))) + (while (and attrstr + (string-match (concat "\\([^" + muse-regexp-blank + "=\n]+\\)\\(=\"\\" + "([^\"]+\\)\"\\)?") + attrstr)) + (let ((attr (cons (downcase + (muse-match-string-no-properties 1 attrstr)) + (muse-match-string-no-properties 3 attrstr)))) + (setq attrstr (replace-match "" t t attrstr)) + (if attrs + (nconc attrs (list attr)) + (setq attrs (list attr))))))) + (if (and (cadr tag-info) (not closed-tag)) + (if (muse-goto-tag-end (car tag-info) (nth 3 tag-info)) + (delete-region (match-beginning 0) (point)) + (setq tag-info nil))) + (when tag-info + (setq end (point-marker)) + (delete-region start beg) + (goto-char start) + (let ((args (list start end))) + (if (nth 2 tag-info) + (nconc args (list attrs))) + (let ((muse-inhibit-style-tags nil)) + ;; remove the inhibition + (apply (nth 4 tag-info) args))) + (set-marker end nil))))) + nil) + +(defun muse-publish-escape-specials (beg end &optional ignore-read-only context) + "Escape specials from BEG to END using style-specific :specials. +If IGNORE-READ-ONLY is non-nil, ignore the read-only property. +CONTEXT is used to figure out what kind of specials to escape. + +The following contexts exist in Muse. +'underline _underlined text_ +'literal =monospaced text= or <code> region (monospaced, escaped) +'emphasis *emphasized text* +'email email@example.com +'url http://example.com +'url-desc [[...][description of an explicit link]] +'image [[image.png]] +'example <example> region (monospaced, block context, escaped) +'verbatim <verbatim> region (escaped) +'footnote footnote text +'document normal text" + (let ((specials (muse-style-element :specials nil t))) + (cond ((functionp specials) + (setq specials (funcall specials context))) + ((symbolp specials) + (setq specials (symbol-value specials)))) + (if (functionp specials) + (funcall specials beg end ignore-read-only) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (while (< (point) (point-max)) + (if (and (not ignore-read-only) + (get-text-property (point) 'read-only)) + (goto-char (or (next-single-property-change (point) 'read-only) + (point-max))) + (let ((repl (or (assoc (char-after) specials) + (assoc (char-after) + muse-publish-markup-specials)))) + (if (null repl) + (forward-char 1) + (delete-char 1) + (insert-before-markers (cdr repl))))))))))) + +(defun muse-publish-markup-word () + (let* ((beg (match-beginning 2)) + (end (1- (match-end 2))) + (leader (buffer-substring-no-properties beg end)) + open-tag close-tag mark-read-only loc context) + (cond + ((string= leader "_") + (setq context 'underline + open-tag (muse-markup-text 'begin-underline) + close-tag (muse-markup-text 'end-underline))) + ((string= leader "=") + (setq context 'literal + open-tag (muse-markup-text 'begin-literal) + close-tag (muse-markup-text 'end-literal)) + (setq mark-read-only t)) + (t + (let ((l (length leader))) + (setq context 'emphasis) + (cond + ((= l 1) (setq open-tag (muse-markup-text 'begin-emph) + close-tag (muse-markup-text 'end-emph))) + ((= l 2) (setq open-tag (muse-markup-text 'begin-more-emph) + close-tag (muse-markup-text 'end-more-emph))) + ((= l 3) (setq open-tag (muse-markup-text 'begin-most-emph) + close-tag (muse-markup-text 'end-most-emph))) + (t (setq context nil)))))) + (if (and context + (not (get-text-property beg 'muse-link)) + (setq loc (search-forward leader nil t)) + (or (eobp) (not (eq (char-syntax (char-after loc)) ?w))) + (not (eq (char-syntax (char-before (point))) ?\ )) + (not (get-text-property (point) 'muse-link))) + (progn + (replace-match "") + (delete-region beg end) + (setq end (point-marker)) + (muse-insert-markup close-tag) + (goto-char beg) + (muse-insert-markup open-tag) + (setq beg (point)) + (when mark-read-only + (muse-publish-escape-specials beg end t context) + (muse-publish-mark-read-only beg end)) + (set-marker end nil)) + (backward-char)) + nil)) + +(defun muse-publish-markup-emdash () + (unless (get-text-property (match-beginning 0) 'muse-link) + (let ((prespace (match-string 1)) + (postspace (match-string 2))) + (delete-region (match-beginning 0) (match-end 0)) + (muse-insert-markup (muse-markup-text 'emdash prespace postspace)) + (when (eq (char-after) ?\<) + (insert ?\n))))) + +(defun muse-publish-markup-enddots () + (unless (get-text-property (match-beginning 0) 'muse-link) + (delete-region (match-beginning 0) (match-end 0)) + (muse-insert-markup (muse-markup-text 'enddots)))) + +(defun muse-publish-markup-dots () + (unless (get-text-property (match-beginning 0) 'muse-link) + (delete-region (match-beginning 0) (match-end 0)) + (muse-insert-markup (muse-markup-text 'dots)))) + +(defun muse-publish-markup-rule () + (unless (get-text-property (match-beginning 0) 'muse-link) + (delete-region (match-beginning 0) (match-end 0)) + (muse-insert-markup (muse-markup-text 'rule)))) + +(defun muse-publish-markup-no-break-space () + (unless (get-text-property (match-beginning 0) 'muse-link) + (delete-region (match-beginning 0) (match-end 0)) + (muse-insert-markup (muse-markup-text 'no-break-space)))) + +(defun muse-publish-markup-heading () + (let* ((len (length (match-string 1))) + (start (muse-markup-text + (cond ((= len 1) 'section) + ((= len 2) 'subsection) + ((= len 3) 'subsubsection) + (t 'section-other)) + len)) + (end (muse-markup-text + (cond ((= len 1) 'section-end) + ((= len 2) 'subsection-end) + ((= len 3) 'subsubsection-end) + (t 'section-other-end)) + len))) + (delete-region (match-beginning 0) (match-end 0)) + (muse-insert-markup start) + (end-of-line) + (when end + (muse-insert-markup end)) + (forward-line 1) + (unless (eq (char-after) ?\n) + (insert "\n")) + (muse-publish-section-close len))) + +(defvar muse-publish-footnotes nil) + +(defun muse-publish-markup-footnote () + "Scan ahead and snarf up the footnote body." + (cond + ((get-text-property (match-beginning 0) 'muse-link) + nil) + ((= (muse-line-beginning-position) (match-beginning 0)) + "") + (t + (let ((footnote (save-match-data + (string-to-number (match-string 1)))) + (oldtext (match-string 0)) + footnotemark) + (delete-region (match-beginning 0) (match-end 0)) + (save-excursion + (when (re-search-forward (format "^\\[%d\\]\\s-+" footnote) nil t) + (let* ((start (match-beginning 0)) + (beg (goto-char (match-end 0))) + (end (save-excursion + (if (search-forward "\n\n" nil t) + (copy-marker (match-beginning 0)) + (goto-char (point-max)) + (skip-chars-backward "\n") + (point-marker))))) + (while (re-search-forward + (concat "^[" muse-regexp-blank "]+\\([^\n]\\)") + end t) + (replace-match "\\1" t)) + (let ((footnotemark-cmd (muse-markup-text 'footnotemark)) + (footnotemark-end-cmd (muse-markup-text 'footnotemark-end))) + (if (string= "" footnotemark-cmd) + (setq footnotemark + (concat (muse-markup-text 'footnote) + (muse-publish-escape-specials-in-string + (buffer-substring-no-properties beg end) + 'footnote) + (muse-markup-text 'footnote-end))) + (setq footnotemark (format footnotemark-cmd footnote + footnotemark-end-cmd)) + (unless muse-publish-footnotes + (set (make-local-variable 'muse-publish-footnotes) + (make-vector 256 nil))) + (unless (aref muse-publish-footnotes footnote) + (setq footnotemark + (concat + footnotemark + (concat (format (muse-markup-text 'footnotetext) + footnote) + (buffer-substring-no-properties beg end) + (muse-markup-text 'footnotetext-end)))) + (aset muse-publish-footnotes footnote footnotemark)))) + (goto-char end) + (skip-chars-forward "\n") + (delete-region start (point)) + (set-marker end nil)))) + (if footnotemark + (muse-insert-markup footnotemark) + (insert oldtext)))))) + +(defun muse-publish-markup-fn-sep () + (delete-region (match-beginning 0) (match-end 0)) + (muse-insert-markup (muse-markup-text 'fn-sep))) + +(defun muse-insert-markup-end-list (&rest args) + (let ((beg (point))) + (apply 'insert args) + (add-text-properties beg (point) '(muse-end-list t)) + (muse-publish-mark-read-only beg (point)))) + +(defun muse-publish-determine-dl-indent (continue indent-sym determine-sym) + ;; If the caller doesn't know how much indentation to use, figure it + ;; out ourselves. It is assumed that `muse-forward-list-item' has + ;; been called just before this to set the match data. + (when (and continue + (symbol-value determine-sym)) + (save-match-data + ;; snarf all leading whitespace + (let ((indent (and (match-beginning 2) + (buffer-substring (match-beginning 1) + (match-beginning 2))))) + (when (and indent + (not (string= indent ""))) + (set indent-sym indent) + (set determine-sym nil)))))) + +(defun muse-publish-surround-dl (indent post-indent) + (let* ((beg-item (muse-markup-text 'begin-dl-item)) + (end-item (muse-markup-text 'end-dl-item)) + (beg-ddt (muse-markup-text 'begin-ddt)) ;; term + (end-ddt (muse-markup-text 'end-ddt)) + (beg-dde (muse-markup-text 'begin-dde)) ;; definition + (end-dde (muse-markup-text 'end-dde)) + (continue t) + (no-terms t) + beg) + (while continue + ;; envelope this as one term+definitions unit -- HTML does not + ;; need this, but DocBook and Muse's custom XML format do + (muse-insert-markup beg-item) + (when (looking-at muse-dl-term-regexp) + ;; find the term and wrap it with published markup + (setq beg (point) + no-terms nil) + (goto-char (match-end 1)) + (delete-region (point) (match-end 0)) + (muse-insert-markup-end-list end-ddt) + ;; if definition is immediately after term, move to next line + (unless (eq (char-after) ?\n) + (insert ?\n)) + (save-excursion + (goto-char beg) + (delete-region (point) (match-beginning 1)) + (muse-insert-markup beg-ddt))) + ;; handle pathological edge case where there is no term -- I + ;; would prefer to just disallow this, but people seem to want + ;; this behavior + (when (and no-terms + (looking-at (concat "[" muse-regexp-blank "]*::" + "[" muse-regexp-blank "]*"))) + (delete-region (point) (match-end 0)) + ;; but only do this once + (setq no-terms nil)) + (setq beg (point) + ;; move past current item + continue (muse-forward-list-item 'dl-term indent)) + (save-restriction + (narrow-to-region beg (point)) + (goto-char (point-min)) + ;; publish each definition that we find, defaulting to an + ;; empty definition if none are found + (muse-publish-surround-text beg-dde end-dde + (lambda (indent) + (muse-forward-list-item 'dl-entry indent)) + indent post-indent + #'muse-publish-determine-dl-indent) + (goto-char (point-max)) + (skip-chars-backward (concat muse-regexp-blank "\n")) + (muse-insert-markup-end-list end-item) + (when continue + (goto-char (point-max))))))) + +(defun muse-publish-strip-list-indentation (list-item empty-line indent post-indent) + (let ((list-nested nil) + (indent-found nil)) + (while (< (point) (point-max)) + (when (and (looking-at list-item) + (not (or (get-text-property + (muse-list-item-critical-point) 'read-only) + (get-text-property + (muse-list-item-critical-point) 'muse-link)))) + ;; if we encounter a list item, allow no post-indent space + (setq list-nested t)) + (when (and (not (looking-at empty-line)) + (looking-at (concat indent "\\(" + (or (and list-nested "") + post-indent) + "\\)"))) + ;; if list is not nested, remove indentation + (unless indent-found + (setq post-indent (match-string 1) + indent-found t)) + (replace-match "")) + (forward-line 1)))) + +(defun muse-publish-surround-text (beg-tag end-tag move-func &optional indent post-indent determine-indent-func list-item) + (unless list-item + (setq list-item (format muse-list-item-regexp + (concat "[" muse-regexp-blank "]*")))) + (let ((continue t) + (empty-line (concat "^[" muse-regexp-blank "]*\n")) + (determine-indent (if determine-indent-func t nil)) + (new-indent indent) + (first t) + beg) + (unless indent + (setq indent (concat "[" muse-regexp-blank "]+"))) + (if post-indent + (setq post-indent (concat " \\{0," (number-to-string post-indent) + "\\}")) + (setq post-indent "")) + (while continue + (if (or (not end-tag) (string= end-tag "")) + ;; if no end of list item markup exists, treat the beginning + ;; of list item markup as it if it were the end -- this + ;; prevents multiple-level lists from being confused + (muse-insert-markup-end-list beg-tag) + (muse-insert-markup beg-tag)) + (setq beg (point) + ;; move past current item; continue is non-nil if there + ;; are more like items to be processed + continue (if (and determine-indent-func first) + (funcall move-func (concat indent post-indent)) + (funcall move-func indent))) + (when determine-indent-func + (funcall determine-indent-func continue 'new-indent 'determine-indent)) + (when continue + ;; remove list markup if we encountered another item of the + ;; same type + (replace-match "" t t nil 1)) + (save-restriction + ;; narrow to current item + (narrow-to-region beg (point)) + (goto-char (point-min)) + (if (looking-at empty-line) + ;; if initial line is blank, move to first non-blank line + (while (progn (forward-line 1) + (and (< (point) (point-max)) + (looking-at empty-line)))) + ;; otherwise, move to second line of text + (forward-line 1)) + ;; strip list indentation + (muse-publish-strip-list-indentation list-item empty-line + indent post-indent) + (skip-chars-backward (concat muse-regexp-blank "\n")) + (muse-insert-markup-end-list end-tag) + (when determine-indent-func + (setq indent new-indent)) + (when first + (setq first nil)) + (when continue + (goto-char (point-max))))))) + +(defun muse-publish-ensure-blank-line () + "Make sure that a blank line exists on the line before point." + (let ((pt (point-marker))) + (beginning-of-line) + (cond ((eq (point) (point-min)) nil) + ((prog2 (backward-char) (bolp) (forward-char)) nil) + (t (insert-before-markers "\n"))) + (goto-char pt) + (set-marker pt nil))) + +(defun muse-publish-markup-list () + "Markup a list entry. +This function works by marking up items of the same list level +and type, respecting the end-of-list property." + (let* ((str (match-string 1)) + (type (muse-list-item-type str)) + (indent (buffer-substring (muse-line-beginning-position) + (match-beginning 1))) + (post-indent (length str))) + (cond + ((or (get-text-property (muse-list-item-critical-point) 'read-only) + (get-text-property (muse-list-item-critical-point) 'muse-link)) + nil) + ((eq type 'ul) + (unless (eq (char-after (match-end 1)) ?-) + (delete-region (match-beginning 0) (match-end 0)) + (muse-publish-ensure-blank-line) + (muse-insert-markup (muse-markup-text 'begin-uli)) + (save-excursion + (muse-publish-surround-text + (muse-markup-text 'begin-uli-item) + (muse-markup-text 'end-uli-item) + (lambda (indent) + (muse-forward-list-item 'ul indent)) + indent post-indent) + (muse-insert-markup-end-list (muse-markup-text 'end-uli))) + (forward-line 1))) + ((eq type 'ol) + (delete-region (match-beginning 0) (match-end 0)) + (muse-publish-ensure-blank-line) + (muse-insert-markup (muse-markup-text 'begin-oli)) + (save-excursion + (muse-publish-surround-text + (muse-markup-text 'begin-oli-item) + (muse-markup-text 'end-oli-item) + (lambda (indent) + (muse-forward-list-item 'ol indent)) + indent post-indent) + (muse-insert-markup-end-list (muse-markup-text 'end-oli))) + (forward-line 1)) + (t + (goto-char (match-beginning 0)) + (muse-publish-ensure-blank-line) + (muse-insert-markup (muse-markup-text 'begin-dl)) + (save-excursion + (muse-publish-surround-dl indent post-indent) + (muse-insert-markup-end-list (muse-markup-text 'end-dl))) + (forward-line 1)))) + nil) + +(defun muse-publish-markup-quote () + "Markup a quoted paragraph. +The reason this function is so funky, is to prevent text properties +like read-only from being inadvertently deleted." + (let* ((ws (match-string 1)) + (centered (>= (string-width ws) 6)) + (begin-elem (if centered 'begin-center 'begin-quote-item)) + (end-elem (if centered 'end-center 'end-quote-item))) + (replace-match "" t t nil 1) + (unless centered + (muse-insert-markup (muse-markup-text 'begin-quote))) + (muse-publish-surround-text (muse-markup-text begin-elem) + (muse-markup-text end-elem) + (function (lambda (indent) + (muse-forward-paragraph) + nil))) + (unless centered + (muse-insert-markup (muse-markup-text 'end-quote))))) + +(defun muse-publish-markup-leading-space (markup-space multiple) + (let (count) + (when (and markup-space + (>= (setq count (skip-chars-forward " ")) 0)) + (delete-region (muse-line-beginning-position) (point)) + (while (> count 0) + (muse-insert-markup markup-space) + (setq count (- count multiple)))))) + +(defun muse-publish-markup-verse () + (let ((leader (match-string 0))) + (goto-char (match-beginning 0)) + (muse-insert-markup (muse-markup-text 'begin-verse)) + (while (looking-at leader) + (replace-match "") + (muse-publish-markup-leading-space (muse-markup-text 'verse-space) 2) + (let ((beg (point))) + (end-of-line) + (cond + ((bolp) + (let ((text (muse-markup-text 'empty-verse-line))) + (when text (muse-insert-markup text)))) + ((save-excursion + (save-match-data + (forward-line 1) + (or (looking-at (concat leader "[" + muse-regexp-blank + "]*$")) + (not (looking-at leader))))) + (let ((begin-text (muse-markup-text 'begin-last-stanza-line)) + (end-text (muse-markup-text 'end-last-stanza-line))) + (when end-text (muse-insert-markup end-text)) + (goto-char beg) + (when begin-text (muse-insert-markup begin-text)) + (end-of-line))) + (t + (let ((begin-text (muse-markup-text 'begin-verse-line)) + (end-text (muse-markup-text 'end-verse-line))) + (when end-text (muse-insert-markup end-text)) + (goto-char beg) + (when begin-text (muse-insert-markup begin-text)) + (end-of-line)))) + (forward-line 1)))) + (muse-insert-markup (muse-markup-text 'end-verse)) + (insert ?\n)) + +(defun muse-publish-trim-table (table) + "Remove completely blank columns from table, if at start or end of row." + ;; remove first + (catch 'found + (dolist (row (cdr table)) + (let ((el (cadr row))) + (when (and (stringp el) (not (string= el ""))) + (throw 'found t)))) + (dolist (row (cdr table)) + (setcdr row (cddr row))) + (setcar table (1- (car table)))) + ;; remove last + (catch 'found + (dolist (row (cdr table)) + (let ((el (car (last row)))) + (when (and (stringp el) (not (string= el ""))) + (throw 'found t)))) + (dolist (row (cdr table)) + (setcdr (last row 2) nil)) + (setcar table (1- (car table)))) + table) + +(defun muse-publish-table-fields (beg end) + "Parse given region as a table, returning a cons cell. +The car is the length of the longest row. + +The cdr is a list of the fields of the table, with the first +element indicating the type of the row: + 1: body, 2: header, 3: footer, hline: separator. + +The existing region will be removed, except for initial blank lines." + (unless (muse-publishing-directive "disable-tables") + (let ((longest 0) + (left 0) + (seen-hline nil) + fields field-list) + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (while (looking-at (concat "^[" muse-regexp-blank "]*$")) + (forward-line 1)) + (setq beg (point)) + (while (= left 0) + (cond + ((looking-at muse-table-hline-regexp) + (when field-list ; skip if at the beginning of table + (if seen-hline + (setq field-list (cons (cons 'hline nil) field-list)) + (dolist (field field-list) + ;; the preceding fields are header lines + (setcar field 2)) + (setq seen-hline t)))) + ((looking-at muse-table-line-regexp) + (setq fields (cons (length (match-string 1)) + (mapcar #'muse-trim-whitespace + (split-string (match-string 0) + muse-table-field-regexp))) + field-list (cons fields field-list) + longest (max (length fields) longest)) + ;; strip initial bars, if they exist + (let ((first (cadr fields))) + (when (and first (string-match "\\`|+\\s-*" first)) + (setcar (cdr fields) (replace-match "" t t first)))))) + (setq left (forward-line 1)))) + (delete-region beg end) + (if (= longest 0) + (cons 0 nil) + ;; if the last line was an hline, remove it + (when (eq (caar field-list) 'hline) + (setq field-list (cdr field-list))) + (muse-publish-trim-table (cons (1- longest) (nreverse field-list))))))) + +(defun muse-publish-markup-table () + "Style does not support tables.\n") + +(defun muse-publish-table-el-table (variant) + "Publish table.el-style tables in the format given by VARIANT." + (when (condition-case nil + (progn (require 'table) + t) + (error nil)) + (let ((muse-buf (current-buffer))) + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + (goto-char (point-min)) + (forward-line 1) + (when (search-forward "|" nil t) + (with-temp-buffer + (let ((temp-buf (current-buffer))) + (with-current-buffer muse-buf + (table-generate-source variant temp-buf)) + (with-current-buffer muse-buf + (delete-region (point-min) (point-max)) + (insert-buffer-substring temp-buf) + (muse-publish-mark-read-only (point-min) (point-max)))))))))) + +(defun muse-publish-markup-table-el () + "Mark up table.el-style tables." + (cond ((muse-style-derived-p 'html) + (muse-publish-table-el-table 'html)) + ((muse-style-derived-p 'latex) + (muse-publish-table-el-table 'latex)) + ((muse-style-derived-p 'docbook) + (muse-publish-table-el-table 'cals)) + (t "Style does not support table.el tables.\n"))) + +(defun muse-publish-escape-specials-in-string (string &optional context) + "Escape specials in STRING using style-specific :specials. +CONTEXT is used to figure out what kind of specials to escape. + +See the documentation of the `muse-publish-escape-specials' +function for the list of available contexts." + (unless string + (setq string "")) + (let ((specials (muse-style-element :specials nil t))) + (cond ((functionp specials) + (setq specials (funcall specials context))) + ((symbolp specials) + (setq specials (symbol-value specials)))) + (if (functionp specials) + (funcall specials string) + (apply (function concat) + (mapcar + (lambda (ch) + (let ((repl (or (assoc ch specials) + (assoc ch muse-publish-markup-specials)))) + (if (null repl) + (char-to-string ch) + (cdr repl)))) + (append string nil)))))) + +(defun muse-publish-markup-email () + (let* ((beg (match-end 1)) + (addr (buffer-substring-no-properties beg (match-end 0)))) + (setq addr (muse-publish-escape-specials-in-string addr 'email)) + (goto-char beg) + (delete-region beg (match-end 0)) + (if (or (eq (char-before (match-beginning 0)) ?\") + (eq (char-after (match-end 0)) ?\")) + (insert addr) + (insert (format (muse-markup-text 'email-addr) addr addr))) + (muse-publish-mark-read-only beg (point)))) + +(defun muse-publish-classify-url (target) + "Transform anchors and get published name, if TARGET is a page. +The return value is two linked cons cells. The car is the type +of link, the cadr is the page name, and the cddr is the anchor." + (save-match-data + (cond ((or (null target) (string= target "")) + nil) + ((string-match "\\`[uU][rR][lL]:\\(.+\\)\\'" target) + (cons 'url (cons (match-string 1 target) nil))) + ((string-match muse-image-regexp target) + (cons 'image (cons target nil))) + ((string-match muse-url-regexp target) + (cons 'url (cons target nil))) + ((string-match muse-file-regexp target) + (cons 'file (cons target nil))) + ((string-match "#" target) + (if (eq (aref target 0) ?\#) + (cons 'anchor-ref (cons nil (substring target 1))) + (cons 'link-and-anchor + ;; match-data is changed by + ;; `muse-publish-link-page' or descendants. + (cons (save-match-data + (muse-publish-link-page + (substring target 0 (match-beginning 0)))) + (substring target (match-end 0)))))) + (t + (cons 'link (cons (muse-publish-link-page target) nil)))))) + +(defun muse-publish-url-desc (desc explicit) + (when desc + (dolist (transform muse-publish-desc-transforms) + (setq desc (save-match-data + (when desc (funcall transform desc explicit))))) + (setq desc (muse-link-unescape desc)) + (muse-publish-escape-specials-in-string desc 'url-desc))) + +(defun muse-publish-url (url &optional desc orig-url explicit) + "Resolve a URL into its final <a href> form." + (let ((unesc-url url) + (unesc-orig-url orig-url) + (unesc-desc desc) + type anchor) + ;; Transform URL + (dolist (transform muse-publish-url-transforms) + (setq url (save-match-data (when url (funcall transform url explicit))))) + ;; Classify URL + (let ((target (muse-publish-classify-url url))) + (setq type (car target) + url (if (eq type 'image) + (muse-publish-escape-specials-in-string (cadr target) + 'image) + (muse-publish-escape-specials-in-string (cadr target) 'url)) + anchor (muse-publish-escape-specials-in-string + (cddr target) 'url))) + ;; Transform description + (if desc + (setq desc (muse-publish-url-desc desc explicit)) + (when orig-url + (setq orig-url (muse-publish-url-desc orig-url explicit)))) + ;; Act on URL classification + (cond ((eq type 'anchor-ref) + (muse-markup-text 'anchor-ref anchor (or desc orig-url))) + ((and unesc-desc (string-match muse-image-regexp unesc-desc)) + (let ((ext (or (file-name-extension desc) ""))) + (setq desc (muse-publish-escape-specials-in-string unesc-desc + 'image)) + (setq desc (muse-path-sans-extension desc)) + (muse-markup-text 'image-link url desc ext))) + ((string= url "") + desc) + ((eq type 'image) + (let ((ext (or (file-name-extension url) ""))) + (setq url (muse-path-sans-extension url)) + (if desc + (muse-markup-text 'image-with-desc url ext desc) + (muse-markup-text 'image url ext)))) + ((eq type 'link-and-anchor) + (muse-markup-text 'link-and-anchor url anchor + (or desc orig-url) + (muse-path-sans-extension url))) + ((eq type 'link) + (muse-markup-text 'link url (or desc orig-url))) + (t + (or (and (or desc + ;; compare the not-escaped versions of url and + ;; orig-url + (not (string= unesc-url unesc-orig-url))) + (let ((text (muse-markup-text 'url-and-desc url + (or desc orig-url)))) + (and (not (string= text "")) + text))) + (muse-markup-text 'url url (or desc orig-url))))))) + +(defun muse-publish-insert-url (url &optional desc orig-url explicit) + "Resolve a URL into its final <a href> form." + (delete-region (match-beginning 0) (match-end 0)) + (let ((text (muse-publish-url url desc orig-url explicit))) + (when text + (muse-insert-markup text)))) + +(defun muse-publish-markup-link () + (let (desc explicit orig-link link) + (setq explicit (save-match-data + (if (string-match muse-explicit-link-regexp + (match-string 0)) + t nil))) + (setq orig-link (if explicit (match-string 1) (match-string 0))) + (setq desc (when explicit (match-string 2))) + (setq link (if explicit + (muse-handle-explicit-link orig-link) + (muse-handle-implicit-link orig-link))) + (when (and link + (or explicit + (not (or (eq (char-before (match-beginning 0)) ?\") + (eq (char-after (match-end 0)) ?\"))))) + ;; if explicit link has no user-provided description, treat it + ;; as if it were an implicit link + (when (and explicit (not desc)) + (setq explicit nil)) + (muse-publish-insert-url link desc orig-link explicit)))) + +(defun muse-publish-markup-url () + (unless (or (eq (char-before (match-beginning 0)) ?\") + (eq (char-after (match-end 0)) ?\")) + (let ((url (match-string 0))) + (muse-publish-insert-url url nil url)))) + +;; Default publishing tags + +(defcustom muse-publish-contents-depth 2 + "The number of heading levels to include with <contents> tags." + :type 'integer + :group 'muse-publish) + +(defun muse-publish-contents-tag (beg end attrs) + (set (make-local-variable 'muse-publish-generate-contents) + (cons (copy-marker (point) t) + (let ((depth (cdr (assoc "depth" attrs)))) + (or (and depth (string-to-number depth)) + muse-publish-contents-depth))))) + +(defun muse-publish-verse-tag (beg end) + (muse-publish-ensure-block beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (delete-char 1) + (while (< (point) (point-max)) + (insert "> ") + (forward-line)) + (if (eq ?\ (char-syntax (char-before))) + (delete-char -1))))) + +(defun muse-publish-mark-read-only (beg end) + "Add read-only properties to the given region." + (add-text-properties beg end '(rear-nonsticky (read-only) read-only t)) + nil) + +(defun muse-publish-mark-link (&optional beg end) + "Indicate that the given region is a Muse link, so that other +markup elements respect it. If a region is not specified, use +the 0th match data to determine it. + +This is usually applied to explicit links." + (unless beg (setq beg (match-beginning 0))) + (unless end (setq end (match-end 0))) + (add-text-properties beg end '(muse-link t)) + nil) + +(defun muse-publish-quote-tag (beg end) + (muse-publish-ensure-block beg) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let ((quote-regexp "^\\(<\\(/?\\)quote>\\)")) + (muse-insert-markup (muse-markup-text 'begin-quote)) + (while (progn + (unless (looking-at (concat "[" muse-regexp-blank "\n]*" + "<quote>")) + (muse-publish-surround-text + (muse-markup-text 'begin-quote-item) + (muse-markup-text 'end-quote-item) + (function + (lambda (indent) + (muse-forward-paragraph) + (goto-char (match-end 0)) + (and (< (point) (point-max)) + (not (looking-at quote-regexp))))) + nil nil nil + quote-regexp)) + (if (>= (point) (point-max)) + t + (and (search-forward "<quote>" nil t) + (muse-goto-tag-end "quote" t) + (progn (forward-line 1) t) + (< (point) (point-max)))))) + (goto-char (point-max)) + (muse-insert-markup (muse-markup-text 'end-quote)))))) + +(defun muse-publish-code-tag (beg end) + (muse-publish-escape-specials beg end nil 'literal) + (goto-char beg) + (insert (muse-markup-text 'begin-literal)) + (goto-char end) + (insert (muse-markup-text 'end-literal)) + (muse-publish-mark-read-only beg (point))) + +(defun muse-publish-cite-tag (beg end attrs) + (let* ((type (muse-publish-get-and-delete-attr "type" attrs)) + (citetag (cond ((string-equal type "author") + 'begin-cite-author) + ((string-equal type "year") + 'begin-cite-year) + (t + 'begin-cite)))) + (goto-char beg) + (insert (muse-markup-text citetag (muse-publishing-directive "bibsource"))) + (goto-char end) + (insert (muse-markup-text 'end-cite)) + (muse-publish-mark-read-only beg (point)))) + +(defun muse-publish-src-tag (beg end attrs) + (muse-publish-example-tag beg end)) + +(defun muse-publish-example-tag (beg end) + (muse-publish-ensure-block beg end) + (muse-publish-escape-specials beg end nil 'example) + (goto-char beg) + (insert (muse-markup-text 'begin-example)) + (goto-char end) + (insert (muse-markup-text 'end-example)) + (muse-publish-mark-read-only beg (point))) + +(defun muse-publish-literal-tag (beg end attrs) + "Ensure that the text between BEG and END is not interpreted later on. + +ATTRS is an alist of attributes. + +If it contains a \"style\" element, delete the region if the +current style is neither derived from nor equal to this style. + +If it contains both a \"style\" element and an \"exact\" element +with the value \"t\", delete the region only if the current style +is exactly this style." + (let* ((style (cdr (assoc "style" attrs))) + (exact (cdr (assoc "exact" attrs))) + (exactp (and (stringp exact) (string= exact "t")))) + (if (or (not style) + (and exactp (equal (muse-style style) + muse-publishing-current-style)) + (and (not exactp) (muse-style-derived-p style))) + (muse-publish-mark-read-only beg end) + (delete-region beg end) + (when (and (bolp) (eolp) (not (eobp))) + (delete-char 1))))) + +(put 'muse-publish-literal-tag 'muse-dangerous-tag t) + +(defun muse-publish-verbatim-tag (beg end) + (muse-publish-escape-specials beg end nil 'verbatim) + (muse-publish-mark-read-only beg end)) + +(defun muse-publish-br-tag (beg end) + "Insert a line break." + (delete-region beg end) + (muse-insert-markup (muse-markup-text 'line-break))) + +(defalias 'muse-publish-class-tag 'ignore) +(defalias 'muse-publish-div-tag 'ignore) + +(defun muse-publish-call-tag-on-buffer (tag &optional attrs) + "Transform the current buffer as if it were surrounded by the tag TAG. +If attributes ATTRS are given, pass them to the tag function." + (let ((tag-info (muse-markup-tag-info tag))) + (when tag-info + (let* ((end (progn (goto-char (point-max)) (point-marker))) + (args (list (point-min) end)) + (muse-inhibit-style-tags nil)) + (when (nth 2 tag-info) + (nconc args (list attrs))) + (apply (nth 4 tag-info) args) + (set-marker end nil))))) + +(defun muse-publish-examplify-buffer (&optional attrs) + "Transform the current buffer as if it were an <example> region." + (muse-publish-call-tag-on-buffer "example" attrs)) + +(defun muse-publish-srcify-buffer (&optional attrs) + "Transform the current buffer as if it were a <src> region." + (muse-publish-call-tag-on-buffer "src" attrs)) + +(defun muse-publish-versify-buffer (&optional attrs) + "Transform the current buffer as if it were a <verse> region." + (muse-publish-call-tag-on-buffer "verse" attrs) + (muse-publish-markup "" + `((100 ,(concat "^[" muse-regexp-blank "]*> ") 0 + muse-publish-markup-verse))) + (goto-char (point-min))) + +(defmacro muse-publish-markup-attribute (beg end attrs reinterp &rest body) + "Evaluate BODY within the bounds of BEG and END. +ATTRS is an alist. Only the \"markup\" element of ATTRS is acted +on. + +If it is omitted, publish the region with the normal Muse rules. +If RE-INTERP is specified, this is done immediately in a new +publishing process. Currently, RE-INTERP is specified only by +the <include> tag. + +If \"nil\", do not mark up the region at all, but prevent it from +being further interpreted by Muse. + +If \"example\", treat the region as if it was surrounded by the +<example> tag. + +If \"src\", treat the region as if it was surrounded by the +<src> tag. + +If \"verse\", treat the region as if it was surrounded by the +<verse> tag, to preserve newlines. + +Otherwise, it should be the name of a function to call in the +narrowed region after evaluating BODY. The function should +take the ATTRS parameter. + +BEG is modified to be the start of the published markup." + (let ((attrs-sym (make-symbol "attrs")) + (markup (make-symbol "markup")) + (markup-function (make-symbol "markup-function"))) + `(let* ((,attrs-sym ,attrs) + (,markup (muse-publish-get-and-delete-attr "markup" ,attrs-sym))) + (save-restriction + (narrow-to-region ,beg ,end) + (goto-char (point-min)) + ,@body + (if (not ,markup) + (when ,reinterp + (muse-publish-markup-region (point-min) (point-max)) + (muse-publish-mark-read-only (point-min) (point-max)) + (goto-char (point-max))) + (let ((,markup-function (read ,markup))) + (cond ((eq ,markup-function 'example) + (setq ,markup-function #'muse-publish-examplify-buffer)) + ((eq ,markup-function 'src) + (setq ,markup-function #'muse-publish-srcify-buffer)) + ((eq ,markup-function 'verse) + (setq ,markup-function #'muse-publish-versify-buffer)) + ((and ,markup-function (not (functionp ,markup-function))) + (error "Invalid markup function `%s'" ,markup)) + (t nil)) + (if ,markup-function + (funcall ,markup-function ,attrs-sym) + (muse-publish-mark-read-only (point-min) (point-max)) + (goto-char (point-max))))))))) + +(put 'muse-publish-markup-attribute 'lisp-indent-function 4) +(put 'muse-publish-markup-attribute 'edebug-form-spec + '(sexp sexp sexp sexp body)) + +(defun muse-publish-lisp-tag (beg end attrs) + (muse-publish-markup-attribute beg end attrs nil + (save-excursion + (save-restriction + (let ((str (muse-eval-lisp + (prog1 + (concat "(progn " + (buffer-substring-no-properties (point-min) + (point-max)) + ")") + (delete-region (point-min) (point-max)) + (widen))))) + (set-text-properties 0 (length str) nil str) + (insert str)))))) + +(put 'muse-publish-lisp-tag 'muse-dangerous-tag t) + +(defun muse-publish-command-tag (beg end attrs) + (muse-publish-markup-attribute beg end attrs nil + (while (looking-at "\\s-*$") + (forward-line)) + (let ((interp (muse-publish-get-and-delete-attr "interp" attrs))) + (if interp + (shell-command-on-region (point) (point-max) interp t t) + (shell-command + (prog1 + (buffer-substring-no-properties (point) (point-max)) + (delete-region (point-min) (point-max))) + t))) + ;; make sure there is a newline at end + (goto-char (point-max)) + (forward-line 0) + (unless (looking-at "\\s-*$") + (goto-char (point-max)) + (insert ?\n)) + (goto-char (point-min)))) + +(put 'muse-publish-command-tag 'muse-dangerous-tag t) + +(defun muse-publish-perl-tag (beg end attrs) + (muse-publish-command-tag beg end + (cons (cons "interp" (executable-find "perl")) + attrs))) + +(put 'muse-publish-perl-tag 'muse-dangerous-tag t) + +(defun muse-publish-php-tag (beg end attrs) + (muse-publish-command-tag beg end + (cons (cons "interp" (executable-find "php")) + attrs))) + +(put 'muse-publish-php-tag 'muse-dangerous-tag t) + +(defun muse-publish-python-tag (beg end attrs) + (muse-publish-command-tag beg end + (cons (cons "interp" (executable-find "python")) + attrs))) + +(put 'muse-publish-python-tag 'muse-dangerous-tag t) + +(defun muse-publish-ruby-tag (beg end attrs) + (muse-publish-command-tag beg end + (cons (cons "interp" (executable-find "ruby")) + attrs))) + +(put 'muse-publish-ruby-tag 'muse-dangerous-tag t) + +(defun muse-publish-comment-tag (beg end) + (if (null muse-publish-comments-p) + (delete-region beg end) + (goto-char end) + (muse-insert-markup (muse-markup-text 'comment-end)) + (muse-publish-mark-read-only beg end) + (goto-char beg) + (muse-insert-markup (muse-markup-text 'comment-begin)))) + +(defun muse-publish-include-tag (beg end attrs) + "Include the named file at the current location during publishing. + +<include file=\"...\" markup=\"...\"> + +The `markup' attribute controls how this file is marked up after +being inserted. See `muse-publish-markup-attribute' for an +explanation of how it works." + (let ((filename (muse-publish-get-and-delete-attr "file" attrs)) + (muse-publishing-directives (copy-alist muse-publishing-directives))) + (if filename + (setq filename (expand-file-name + filename + (file-name-directory muse-publishing-current-file))) + (error "No file attribute specified in <include> tag")) + (muse-publish-markup-attribute beg end attrs t + (muse-insert-file-contents filename)))) + +(put 'muse-publish-include-tag 'muse-dangerous-tag t) + +(defun muse-publish-mark-up-tag (beg end attrs) + "Run an Emacs Lisp function on the region delimted by this tag. + +<markup function=\"...\" style=\"...\" exact=\"...\"> + +The optional \"function\" attribute controls how this section is +marked up. If used, it should be the name of a function to call +with the buffer narrowed to the delimited region. Note that no +further marking-up will be performed on this region. + +If \"function\" is omitted, use the standard Muse markup function. +This is useful for marking up content in headers and footers. + +The optional \"style\" attribute causes the region to be deleted +if the current style is neither derived from nor equal to this +style. + +If both a \"style\" attribute and an \"exact\" attribute are +provided, and \"exact\" is \"t\", delete the region only if the +current style is exactly this style." + (let* ((style (cdr (assoc "style" attrs))) + (exact (cdr (assoc "exact" attrs))) + (exactp (and (stringp exact) (string= exact "t")))) + (if (or (not style) + (and exactp (equal (muse-style style) + muse-publishing-current-style)) + (and (not exactp) (muse-style-derived-p style))) + (let* ((function (cdr (assoc "function" attrs))) + (muse-publish-use-header-footer-tags nil) + (markup-function (and function (intern-soft function)))) + (if (and markup-function (functionp markup-function)) + (save-restriction + (narrow-to-region beg end) + (funcall markup-function) + (goto-char (point-max))) + (let ((muse-publish-inhibit-style-hooks t)) + (muse-publish-markup-region beg end))) + (muse-publish-mark-read-only beg (point))) + (delete-region beg end)))) + +(put 'muse-publish-mark-up-tag 'muse-dangerous-tag t) + +;; Miscellaneous helper functions + +(defun muse-publish-strip-URL (string &rest ignored) + "If the text \"URL:\" exists at the beginning of STRING, remove it. +The text is removed regardless of whether and part of it is uppercase." + (save-match-data + (if (string-match "\\`[uU][rR][lL]:\\(.+\\)\\'" string) + (match-string 1 string) + string))) + +(defun muse-publish-markup-type (category default-func) + (let ((rule (muse-find-markup-element :overrides category (muse-style)))) + (funcall (or rule default-func)))) + +(defun muse-published-buffer-contents (buffer) + (with-current-buffer buffer + (goto-char (point-min)) + (let ((beg (and (search-forward "Emacs Muse begins here") + (muse-line-end-position))) + (end (and (search-forward "Emacs Muse ends here") + (muse-line-beginning-position)))) + (buffer-substring-no-properties beg end)))) + +(defun muse-published-contents (file) + (when (file-readable-p file) + (muse-with-temp-buffer + (muse-insert-file-contents file) + (muse-published-buffer-contents (current-buffer))))) + +(defun muse-publish-transform-output + (file temp-file output-path name gen-func &rest cleanup-exts) + "Transform the given TEMP-FILE into the OUTPUT-PATH, using GEN-FUNC." + (setq file (muse-page-name file)) + (message "Generating %s output for %s..." name file) + (if (not (funcall gen-func temp-file output-path)) + (message "Generating %s from %s...failed" name file) + (message "Generating %s output for %s...done" name file) + (muse-delete-file-if-exists temp-file) + (dolist (ext cleanup-exts) + (muse-delete-file-if-exists + (expand-file-name (concat file ext) + (file-name-directory output-path)))) + (message "Wrote %s" output-path))) + +(defun muse-publish-read-only (string) + (let ((end (1- (length string)))) + (add-text-properties 0 end + '(rear-nonsticky (read-only) read-only t) + string) + string)) + +;;; muse-publish.el ends here diff --git a/emacs.d/elisp/muse/muse-regexps.el b/emacs.d/elisp/muse/muse-regexps.el new file mode 100644 index 0000000..ad3ce3f --- /dev/null +++ b/emacs.d/elisp/muse/muse-regexps.el @@ -0,0 +1,270 @@ +;;; muse-regexps.el --- define regexps used by Muse + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file is the part of the Muse project that describes regexps +;; that are used throughout the project. + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Regular Expressions +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup muse-regexp nil + "Regular expressions used in publishing and syntax highlighting." + :group 'muse) + +;;; Deal with the lack of character classes for regexps in Emacs21 and +;;; XEmacs + +(defcustom muse-regexp-use-character-classes 'undecided + "Indicate whether to use extended character classes like [:space:]. +If 'undecided, Muse will use them if your emacs is known to support them. + +Emacs 22 and Emacs 21.3.50 are known to support them. XEmacs +does not support them. + +Emacs 21.2 or higher support them, but with enough annoying edge +cases that the sanest default is to leave them disabled." + :type '(choice (const :tag "Yes" t) + (const :tag "No" nil) + (const :tag "Let Muse decide" undecided)) + :group 'muse-regexp) + +(defvar muse-regexp-emacs-revision + (save-match-data + (and (string-match "^[0-9]+\\.[0-9]+\\.\\([0-9]+\\)" + emacs-version) + (match-string 1 emacs-version) + (string-to-number (match-string 1 emacs-version)))) + "The revision number of this version of Emacs.") + +(defun muse-extreg-usable-p () + "Return non-nil if extended character classes can be used, +nil otherwise. + +This is used when deciding the initial values of the muse-regexp +options." + (cond + ((eq muse-regexp-use-character-classes t) + t) + ((eq muse-regexp-use-character-classes nil) + nil) + ((featurep 'xemacs) nil) ; unusable on XEmacs + ((> emacs-major-version 21) t) ; usable if > 21 + ((< emacs-major-version 21) nil) + ((< emacs-minor-version 3) nil) + ;; don't use if version is of format 21.x + ((null muse-regexp-emacs-revision) nil) + ;; only trust 21.3.50 or higher + ((>= muse-regexp-emacs-revision 50) t) + (t nil))) + +(defcustom muse-regexp-blank + (if (muse-extreg-usable-p) + "[:blank:]" + " \t") + "Regexp to use in place of \"[:blank:]\". +This should be something that matches spaces and tabs. + +It is like a regexp, but should be embeddable inside brackets. +Muse will detect the appropriate value correctly most of +the time." + :type 'string + :options '("[:blank:]" " \t") + :group 'muse-regexp) + +(defcustom muse-regexp-alnum + (if (muse-extreg-usable-p) + "[:alnum:]" + "A-Za-z0-9") + "Regexp to use in place of \"[:alnum:]\". +This should be something that matches all letters and numbers. + +It is like a regexp, but should be embeddable inside brackets. +muse will detect the appropriate value correctly most of +the time." + :type 'string + :options '("[:alnum:]" "A-Za-z0-9") + :group 'muse-regexp) + +(defcustom muse-regexp-lower + (if (muse-extreg-usable-p) + "[:lower:]" + "a-z") + "Regexp to use in place of \"[:lower:]\". +This should match all lowercase characters. + +It is like a regexp, but should be embeddable inside brackets. +muse will detect the appropriate value correctly most of +the time." + :type 'string + :options '("[:lower:]" "a-z") + :group 'muse-regexp) + +(defcustom muse-regexp-upper + (if (muse-extreg-usable-p) + "[:upper:]" + "A-Z") + "Regexp to use in place of \"[:upper:]\". +This should match all uppercase characters. + +It is like a regexp, but should be embeddable inside brackets. +muse will detect the appropriate value correctly most of +the time." + :type 'string + :options '("[:upper:]" "A-Z") + :group 'muse-regexp) + +;;; Regexps used to define Muse publishing syntax + +(defcustom muse-list-item-regexp + (concat "^%s\\(\\([^\n" muse-regexp-blank "].*?\\)?::" + "\\(?:[" muse-regexp-blank "]+\\|$\\)" + "\\|[" muse-regexp-blank "]-[" muse-regexp-blank "]*" + "\\|[" muse-regexp-blank "][0-9]+\\.[" muse-regexp-blank "]*\\)") + "Regexp used to match the beginning of a list item. +The '%s' will be replaced with a whitespace regexp when publishing." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-ol-item-regexp (concat "\\`[" muse-regexp-blank "]+[0-9]+\\.") + "Regexp used to match an ordered list item." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-ul-item-regexp (concat "\\`[" muse-regexp-blank "]+-") + "Regexp used to match an unordered list item." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-dl-term-regexp + (concat "[" muse-regexp-blank "]*\\(.+?\\)[" + muse-regexp-blank "]+::\\(?:[" muse-regexp-blank "]+\\|$\\)") + "Regexp used to match a definition list term. +The first match string must contain the term." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-dl-entry-regexp (concat "\\`[" muse-regexp-blank "]*::") + "Regexp used to match a definition list entry." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-table-field-regexp + (concat "[" muse-regexp-blank "]+\\(|+\\)\\(?:[" + muse-regexp-blank "]\\|$\\)") + "Regexp used to match table separators when publishing." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-table-line-regexp (concat ".*" muse-table-field-regexp ".*") + "Regexp used to match a table line when publishing." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-table-hline-regexp (concat "[" muse-regexp-blank + "]*|[-+]+|[" muse-regexp-blank + "]*") + "Regexp used to match a horizontal separator line in a table." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-table-el-border-regexp (concat "[" muse-regexp-blank "]*" + "\\+\\(-*\\+\\)+" + "[" muse-regexp-blank "]*") + "Regexp used to match the beginning and end of a table.el-style table." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-table-el-line-regexp (concat "[" muse-regexp-blank "]*" + "|\\(.*|\\)*" + "[" muse-regexp-blank "]*") + "Regexp used to match a table line of a table.el-style table." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-tag-regexp + (concat "<\\([^/" muse-regexp-blank "\n][^" muse-regexp-blank + "</>\n]*\\)\\(\\s-+[^<>]+[^</>\n]\\)?\\(/\\)?>") + "A regexp used to find XML-style tags within a buffer when publishing. +Group 1 should be the tag name, group 2 the properties, and group +3 the optional immediate ending slash." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-explicit-link-regexp + "\\[\\[\\([^][\n]+\\)\\]\\(?:\\[\\([^][\n]+\\)\\]\\)?\\]" + "Regexp used to match [[target][description]] links. +Paren group 1 must match the URL, and paren group 2 the description." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-implicit-link-regexp + (concat "\\([^" muse-regexp-blank "\n]+\\)") + "Regexp used to match an implicit link. +An implicit link is the largest block of text to be checked for +URLs and bare WikiNames by the `muse-link-at-point' function. +Paren group 1 is the text to be checked. + +URLs are checked by default. To get WikiNames, load +muse-wiki.el. + +This is only used when you are using muse-mode.el, but not +muse-colors.el. + +If the above applies, and you want to match things with spaces in +them, you will have to modify this." + :type 'regexp + :group 'muse-regexp) + +;;; Regexps used to determine file types + +(defcustom muse-file-regexp + (concat "\\`[~/]\\|\\?\\|/\\'\\|\\." + "\\(html?\\|pdf\\|mp3\\|el\\|zip\\|txt\\|tar\\)" + "\\(\\.\\(gz\\|bz2\\)\\)?\\'") + "A link matching this regexp will be regarded as a link to a file." + :type 'regexp + :group 'muse-regexp) + +(defcustom muse-image-regexp + "\\.\\(eps\\|gif\\|jp\\(e?g\\)\\|p\\(bm\\|ng\\)\\|tiff\\|x\\([bp]m\\)\\)\\'" + "A link matching this regexp will be published inline as an image. +For example: + + [[./wife.jpg][A picture of my wife]] + +If you omit the description, the alt tag of the resulting HTML +buffer will be the name of the file." + :type 'regexp + :group 'muse-regexp) + +(provide 'muse-regexps) + +;;; muse-regexps.el ends here diff --git a/emacs.d/elisp/muse/muse-texinfo.el b/emacs.d/elisp/muse/muse-texinfo.el new file mode 100644 index 0000000..4ad0092 --- /dev/null +++ b/emacs.d/elisp/muse/muse-texinfo.el @@ -0,0 +1,346 @@ +;;; muse-texinfo.el --- publish entries to Texinfo format or PDF + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse Texinfo Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) +(require 'muse-latex) +(require 'texnfo-upd) + +(defgroup muse-texinfo nil + "Rules for marking up a Muse file as a Texinfo article." + :group 'muse-publish) + +(defcustom muse-texinfo-process-natively nil + "If non-nil, use the Emacs `texinfmt' module to make Info files." + :type 'boolean + :require 'texinfmt + :group 'muse-texinfo) + +(defcustom muse-texinfo-extension ".texi" + "Default file extension for publishing Texinfo files." + :type 'string + :group 'muse-texinfo) + +(defcustom muse-texinfo-info-extension ".info" + "Default file extension for publishing Info files." + :type 'string + :group 'muse-texinfo) + +(defcustom muse-texinfo-pdf-extension ".pdf" + "Default file extension for publishing PDF files." + :type 'string + :group 'muse-texinfo) + +(defcustom muse-texinfo-header + "\\input texinfo @c -*-texinfo-*- + +@setfilename <lisp>(concat (muse-page-name) \".info\")</lisp> +@settitle <lisp>(muse-publishing-directive \"title\")</lisp> + +@documentencoding iso-8859-1 + +@iftex +@finalout +@end iftex + +@titlepage +@title <lisp>(muse-publishing-directive \"title\")</lisp> +@author <lisp>(muse-publishing-directive \"author\")</lisp> +@end titlepage + +<lisp>(and muse-publish-generate-contents \"@contents\")</lisp> + +@node Top, Overview, , (dir) +@top Overview +@c Page published by Emacs Muse begins here\n\n" + "Text to prepend to a Muse page being published as Texinfo. +This may be text or a filename. +It may contain <lisp> markup tags." + :type 'string + :group 'muse-texinfo) + +(defcustom muse-texinfo-footer + "\n@c Page published by Emacs Muse ends here +@bye\n" + "Text to append to a Muse page being published as Texinfo. +This may be text or a filename. +It may contain <lisp> markup tags." + :type 'string + :group 'muse-texinfo) + +(defcustom muse-texinfo-markup-regexps nil + "List of markup rules for publishing a Muse page to Texinfo. +For more on the structure of this list, see `muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-texinfo) + +(defcustom muse-texinfo-markup-functions + '((table . muse-texinfo-markup-table) + (heading . muse-texinfo-markup-heading)) + "An alist of style types to custom functions for that kind of text. +For more on the structure of this list, see +`muse-publish-markup-functions'." + :type '(alist :key-type symbol :value-type function) + :group 'muse-texinfo) + +(defcustom muse-texinfo-markup-strings + '((image-with-desc . "@center @image{%1%, , , %3%, %2%}@*\n@center %3%") + (image . "@noindent @image{%s, , , , %s}") + (image-link . "@uref{%s, %s.%s}") + (anchor-ref . "@ref{%s, %s}") + (url . "@uref{%s, %s}") + (link . "@ref{Top, %2%, , %1%, }") + (link-and-anchor . "@ref{%3%, %2%, , %1%, %3%}") + (email-addr . "@email{%s}") + (anchor . "@anchor{%s} ") + (emdash . "---") + (comment-begin . "@ignore\n") + (comment-end . "\n@end ignore\n") + (rule . "@sp 1") + (no-break-space . "@w{ }") + (line-break . "@*") + (enddots . "@enddots{}") + (dots . "@dots{}") + (section . "@chapter ") + (subsection . "@section ") + (subsubsection . "@subsection ") + (section-other . "@subsubheading ") + (footnote . "@footnote{") + (footnote-end . "}") + (begin-underline . "_") + (end-underline . "_") + (begin-literal . "@samp{") + (end-literal . "}") + (begin-emph . "@emph{") + (end-emph . "}") + (begin-more-emph . "@strong{") + (end-more-emph . "}") + (begin-most-emph . "@strong{@emph{") + (end-most-emph . "}}") + (begin-verse . "@display\n") + (end-verse-line . "") + (verse-space . "@ @ ") + (end-verse . "\n@end display") + (begin-example . "@example\n") + (end-example . "\n@end example") + (begin-center . "@quotation\n") + (end-center . "\n@end quotation") + (begin-quote . "@quotation\n") + (end-quote . "\n@end quotation") + (begin-cite . "") + (begin-cite-author . "") + (begin-cite-year . "") + (end-cite . "") + (begin-uli . "@itemize @bullet\n") + (end-uli . "\n@end itemize") + (begin-uli-item . "@item\n") + (begin-oli . "@enumerate\n") + (end-oli . "\n@end enumerate") + (begin-oli-item . "@item\n") + (begin-dl . "@table @strong\n") + (end-dl . "\n@end table") + (begin-ddt . "@item ")) + "Strings used for marking up text. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-texinfo) + +(defcustom muse-texinfo-markup-specials + '((?@ . "@@") + (?{ . "@{") + (?} . "@}")) + "A table of characters which must be represented specially." + :type '(alist :key-type character :value-type string) + :group 'muse-texinfo) + +(defcustom muse-texinfo-markup-specials-url + '((?@ . "@@") + (?{ . "@{") + (?} . "@}") + (?, . "@comma{}")) + "A table of characters which must be represented specially. +These are applied to URLs." + :type '(alist :key-type character :value-type string) + :group 'muse-texinfo) + +(defun muse-texinfo-decide-specials (context) + "Determine the specials to escape, depending on CONTEXT." + (cond ((memq context '(underline literal emphasis email url url-desc image + footnote)) + muse-texinfo-markup-specials-url) + (t muse-texinfo-markup-specials))) + +(defun muse-texinfo-markup-table () + (let* ((table-info (muse-publish-table-fields (match-beginning 0) + (match-end 0))) + (row-len (car table-info)) + (field-list (cdr table-info))) + (when table-info + (muse-insert-markup "@multitable @columnfractions") + (dotimes (field row-len) + (muse-insert-markup " " (number-to-string (/ 1.0 row-len)))) + (dolist (fields field-list) + (let ((type (car fields))) + (unless (eq type 'hline) + (setq fields (cdr fields)) + (if (= type 2) + (muse-insert-markup "\n@headitem ") + (muse-insert-markup "\n@item ")) + (insert (car fields)) + (setq fields (cdr fields)) + (dolist (field fields) + (muse-insert-markup " @tab ") + (insert field))))) + (muse-insert-markup "\n@end multitable") + (insert ?\n)))) + +(defun muse-texinfo-remove-links (string) + "Remove explicit links from STRING, replacing them with the link +description. + +If no description exists for the link, use the link itself." + (let ((start nil)) + (while (setq start (string-match muse-explicit-link-regexp string + start)) + (setq string + (replace-match (or (match-string 2 string) + (match-string 1 string)) + t t string))) + string)) + +(defun muse-texinfo-protect-wikiwords (start end) + "Protect all wikiwords from START to END from further processing." + (and (boundp 'muse-wiki-wikiword-regexp) + (featurep 'muse-wiki) + (save-excursion + (goto-char start) + (while (re-search-forward muse-wiki-wikiword-regexp end t) + (muse-publish-mark-read-only (match-beginning 0) + (match-end 0)))))) + +(defun muse-texinfo-markup-heading () + (save-excursion + (muse-publish-markup-heading)) + (let* ((eol (muse-line-end-position)) + (orig-heading (buffer-substring (point) eol)) + (beg (point))) + (delete-region (point) eol) + ;; don't allow links to be published in headings + (insert (muse-texinfo-remove-links orig-heading)) + (muse-texinfo-protect-wikiwords beg (point)))) + +(defun muse-texinfo-munge-buffer () + (muse-latex-fixup-dquotes) + (texinfo-insert-node-lines (point-min) (point-max) t) + (texinfo-all-menus-update t)) + +(defun muse-texinfo-pdf-browse-file (file) + (shell-command (concat "open " file))) + +(defun muse-texinfo-info-generate (file output-path final-target) + ;; The version of `texinfmt.el' that comes with Emacs 21 doesn't + ;; support @documentencoding, so hack it in. + (when (and (not (featurep 'xemacs)) + (eq emacs-major-version 21)) + (put 'documentencoding 'texinfo-format + 'texinfo-discard-line-with-args)) + ;; Most versions of `texinfmt.el' do not support @headitem, so hack + ;; it in. + (unless (get 'headitem 'texinfo-format) + (put 'headitem 'texinfo-format 'texinfo-multitable-item)) + (muse-publish-transform-output + file output-path final-target "Info" + (function + (lambda (file output-path) + (if muse-texinfo-process-natively + (save-window-excursion + (save-excursion + (find-file file) + (let ((inhibit-read-only t)) + (texinfo-format-buffer)) + (save-buffer) + (kill-buffer (current-buffer)) + (let ((buf (get-file-buffer file))) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)))) + t)) + (let ((result (shell-command + (concat "makeinfo --enable-encoding --output=" + output-path " " file)))) + (if (or (not (numberp result)) + (eq result 0)) + t + nil))))))) + +(defun muse-texinfo-pdf-generate (file output-path final-target) + (let ((muse-latex-pdf-program "pdftex") + (muse-latex-pdf-cruft '(".aux" ".cp" ".fn" ".ky" ".log" ".pg" ".toc" + ".tp" ".vr"))) + (muse-latex-pdf-generate file output-path final-target))) + +;;; Register the Muse TEXINFO Publishers + +(muse-define-style "texi" + :suffix 'muse-texinfo-extension + :regexps 'muse-texinfo-markup-regexps + :functions 'muse-texinfo-markup-functions + :strings 'muse-texinfo-markup-strings + :specials 'muse-texinfo-decide-specials + :after 'muse-texinfo-munge-buffer + :header 'muse-texinfo-header + :footer 'muse-texinfo-footer + :browser 'find-file) + +(muse-derive-style "info" "texi" + :final 'muse-texinfo-info-generate + :link-suffix 'muse-texinfo-info-extension + :osuffix 'muse-texinfo-info-extension + :browser 'info) + +(muse-derive-style "info-pdf" "texi" + :final 'muse-texinfo-pdf-generate + :link-suffix 'muse-texinfo-pdf-extension + :osuffix 'muse-texinfo-pdf-extension + :browser 'muse-texinfo-pdf-browse-file) + +(provide 'muse-texinfo) + +;;; muse-texinfo.el ends here diff --git a/emacs.d/elisp/muse/muse-wiki.el b/emacs.d/elisp/muse/muse-wiki.el new file mode 100644 index 0000000..e2cd3a2 --- /dev/null +++ b/emacs.d/elisp/muse/muse-wiki.el @@ -0,0 +1,498 @@ +;;; muse-wiki.el --- wiki features for Muse + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Yann Hodique <Yann.Hodique@lifl.fr> +;; Keywords: + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;; Per B. Sederberg (per AT med DOT upenn DOT edu) made it so that all +;; files in a Muse project can become implicit links. + +;;; Code: + +(require 'muse-regexps) +(require 'muse-mode) + +(eval-when-compile + (require 'muse-colors)) + +(defgroup muse-wiki nil + "Options controlling the behavior of Emacs Muse Wiki features." + :group 'muse-mode) + +(defcustom muse-wiki-use-wikiword t + "Whether to use color and publish bare WikiNames." + :type 'boolean + :group 'muse-wiki) + +(defcustom muse-wiki-allow-nonexistent-wikiword nil + "Whether to color bare WikiNames that don't have an existing file." + :type 'boolean + :group 'muse-wiki) + +(defcustom muse-wiki-match-all-project-files nil + "If non-nil, Muse will color and publish implicit links to any +file in your project, regardless of whether its name is a WikiWord." + :type 'boolean + :group 'muse-wiki) + +(defcustom muse-wiki-ignore-implicit-links-to-current-page nil + "If non-nil, Muse will not recognize implicit links to the current +page, both when formatting and publishing." + :type 'boolean + :group 'muse-wiki) + +(defvar muse-wiki-project-file-regexp nil + "Regexp used to match the files in the current project. + +This is set by `muse-wiki-update-project-file-regexp' automatically +when `muse-wiki-match-all-project-files' is non-nil.") +(make-variable-buffer-local 'muse-wiki-project-file-regexp) + +(defun muse-wiki-update-project-file-regexp () + "Update a local copy of `muse-wiki-project-file-regexp' to include +all the files in the project." + ;; see if the user wants to match project files + (when muse-wiki-match-all-project-files + (let ((files (mapcar #'car (muse-project-file-alist (muse-project))))) + (setq muse-wiki-project-file-regexp + (when files + (concat "\\(" + ;; include all files from the project + (regexp-opt files 'words) + "\\)")))) + ;; update coloring setup + (when (featurep 'muse-colors) + (muse-colors-define-highlighting 'muse-mode muse-colors-markup)))) + +(add-hook 'muse-update-values-hook + 'muse-wiki-update-project-file-regexp) +(add-hook 'muse-project-file-alist-hook + 'muse-wiki-update-project-file-regexp) + +(defcustom muse-wiki-wikiword-regexp + (concat "\\<\\(\\(?:[" muse-regexp-upper + "]+[" muse-regexp-lower "]+\\)\\(?:[" + muse-regexp-upper "]+[" muse-regexp-lower "]+\\)+\\)") + "Regexp used to match WikiWords." + :set (function + (lambda (sym value) + (set sym value) + (when (featurep 'muse-colors) + (muse-colors-define-highlighting 'muse-mode muse-colors-markup)))) + :type 'regexp + :group 'muse-wiki) + +(defcustom muse-wiki-ignore-bare-project-names nil + "Determine whether project names without a page specifer are links. + +If non-nil, project names without a page specifier will not be +considered links. + +When nil, project names without a specifier are highlighted and +they link to the default page of the project that they name." + :type 'boolean + :group 'muse-wiki) + +(defvar muse-wiki-interwiki-regexp nil + "Regexp that matches all interwiki links. + +This is automatically generated by setting `muse-wiki-interwiki-alist'. +It can also be set by calling `muse-wiki-update-interwiki-regexp'.") + +(defcustom muse-wiki-interwiki-delimiter "#\\|::" + "Delimiter regexp used for InterWiki links. + +If you use groups, use only shy groups." + :type 'regexp + :group 'muse-wiki) + +(defcustom muse-wiki-interwiki-replacement ": " + "Regexp used for replacing `muse-wiki-interwiki-delimiter' in +InterWiki link descriptions. + +If you want this replacement to happen, you must add +`muse-wiki-publish-pretty-interwiki' to +`muse-publish-desc-transforms'." + :type 'regexp + :group 'muse-wiki) + +(eval-when-compile + (defvar muse-wiki-interwiki-alist)) + +(defun muse-wiki-project-files-with-spaces (&optional project) + "Return a list of files in PROJECT that have spaces." + (setq project (muse-project project)) + (let ((flist nil)) + (save-match-data + (dolist (entry (muse-project-file-alist project)) + (when (string-match " " (car entry)) + (setq flist (cons (car entry) flist))))) + flist)) + +(defun muse-wiki-update-interwiki-regexp () + "Update the value of `muse-wiki-interwiki-regexp' based on +`muse-wiki-interwiki-alist' and `muse-project-alist'." + (if (null muse-project-alist) + (setq muse-wiki-interwiki-regexp nil) + (let ((old-value muse-wiki-interwiki-regexp)) + (setq muse-wiki-interwiki-regexp + (concat "\\<\\(" (regexp-opt (mapcar #'car muse-project-alist)) + (when muse-wiki-interwiki-alist + (let ((interwiki-rules + (mapcar #'car muse-wiki-interwiki-alist))) + (when interwiki-rules + (concat "\\|" (regexp-opt interwiki-rules))))) + "\\)\\(?:\\(" muse-wiki-interwiki-delimiter + "\\)\\(" + (when muse-wiki-match-all-project-files + ;; append the files from the project + (let ((files nil)) + (dolist (proj muse-project-alist) + (setq files + (nconc (muse-wiki-project-files-with-spaces + (car proj)) + files))) + (when files + (concat (regexp-opt files) "\\|")))) + "\\sw+\\)\\(#\\S-+\\)?\\)?\\>")) + (when (and (featurep 'muse-colors) + (not (string= old-value muse-wiki-interwiki-regexp))) + (muse-colors-define-highlighting 'muse-mode muse-colors-markup))))) + +(defcustom muse-wiki-interwiki-alist + '(("EmacsWiki" . "http://www.emacswiki.org/cgi-bin/wiki/")) + "A table of WikiNames that refer to external entities. + +The format of this table is an alist, or series of cons cells. +Each cons cell must be of the form: + + (WIKINAME . STRING-OR-FUNCTION) + +The second part of the cons cell may either be a STRING, which in most +cases should be a URL, or a FUNCTION. If a function, it will be +called with one argument: the tag applied to the Interwiki name, or +nil if no tag was used. If the cdr was a STRING and a tag is used, +the tag is simply appended. + +Here are some examples: + + (\"JohnWiki\" . \"http://alice.dynodns.net/wiki?\") + +Referring to [[JohnWiki::EmacsModules]] then really means: + + http://alice.dynodns.net/wiki?EmacsModules + +If a function is used for the replacement text, you can get creative +depending on what the tag is. Tags may contain any alphabetic +character, any number, % or _. If you need other special characters, +use % to specify the hex code, as in %2E. All browsers should support +this." + :type '(repeat (cons (string :tag "WikiName") + (choice (string :tag "URL") function))) + :set (function + (lambda (sym value) + (set sym value) + (muse-wiki-update-interwiki-regexp))) + :group 'muse-wiki) + +(add-hook 'muse-update-values-hook + 'muse-wiki-update-interwiki-regexp) + +(defun muse-wiki-resolve-project-page (&optional project page) + "Return the published path from the current page to PAGE of PROJECT. + +If PAGE is not specified, use the value of :default in PROJECT. + +If PROJECT is not specified, default to the current project. If +no project is current, use the first project of +`muse-projects-alist'. + +Note that PAGE can have several output directories. If this is +the case, we will use the first one that matches our current +style and has the same link suffix, ignoring the others. If no +style has the same link suffix as the current publishing style, +use the first style we find." + (setq project (or (and project + (muse-project project)) + (muse-project) + (car muse-project-alist)) + page (or page (muse-get-keyword :default (cadr project)))) + (let* ((page-path (and muse-project-alist + (muse-project-page-file page project))) + (remote-styles (and page-path (muse-project-applicable-styles + page-path (cddr project)))) + (local-style (muse-project-current-output-style))) + (cond ((and remote-styles local-style muse-publishing-p) + (muse-project-resolve-link page local-style remote-styles)) + ((not muse-publishing-p) + (if page-path + page-path + (when muse-wiki-allow-nonexistent-wikiword + ;; make a path to a nonexistent file in project + (setq page-path (expand-file-name + page (car (cadr project)))) + (if (and muse-file-extension + (not (string= muse-file-extension ""))) + (concat page-path "." muse-file-extension) + page-path))))))) + +(defun muse-wiki-handle-implicit-interwiki (&optional string) + "If STRING or point has an interwiki link, resolve it to a filename. + +Match string 0 is set to the link." + (when (and muse-wiki-interwiki-regexp + (if string (string-match muse-wiki-interwiki-regexp string) + (looking-at muse-wiki-interwiki-regexp))) + (let* ((project (match-string 1 string)) + (subst (cdr (assoc project muse-wiki-interwiki-alist))) + (word (match-string 3 string)) + (anchor (if (match-beginning 4) + (match-string 4 string) + ""))) + (if subst + (if (functionp subst) + (and (setq word (funcall subst word)) + (concat word anchor)) + (concat subst word anchor)) + (and (assoc project muse-project-alist) + (or word (not muse-wiki-ignore-bare-project-names)) + (setq word (muse-wiki-resolve-project-page project word)) + (concat word anchor)))))) + +(defun muse-wiki-handle-explicit-interwiki (&optional string) + "If STRING or point has an interwiki link, resolve it to a filename." + (let ((right-pos (if string (length string) (match-end 1)))) + (when (and muse-wiki-interwiki-regexp + (if string (string-match muse-wiki-interwiki-regexp string) + (save-restriction + (narrow-to-region (point) right-pos) + (looking-at muse-wiki-interwiki-regexp)))) + (let* ((project (match-string 1 string)) + (subst (cdr (assoc project muse-wiki-interwiki-alist))) + (anchor (and (match-beginning 4) + (match-string 4 string))) + (word (when (match-end 2) + (cond (anchor (match-string 3 string)) + (string (substring string (match-end 2))) + (right-pos (buffer-substring (match-end 2) + right-pos)) + (t nil))))) + (if (and (null word) + right-pos + (not (= right-pos (match-end 1)))) + ;; if only a project name was found, it must take up the + ;; entire string or link + nil + (unless anchor + (if (or (null word) + (not (string-match "#[^#]+\\'" word))) + (setq anchor "") + (setq anchor (match-string 0 word)) + (setq word (substring word 0 (match-beginning 0))))) + (if subst + (if (functionp subst) + (and (setq word (funcall subst word)) + (concat word anchor)) + (concat subst word anchor)) + (and (assoc project muse-project-alist) + (or word (not muse-wiki-ignore-bare-project-names)) + (setq word (muse-wiki-resolve-project-page project word)) + (concat word anchor)))))))) + +(defun muse-wiki-handle-wikiword (&optional string) + "If STRING or point has a WikiWord, return it. + +Match 1 is set to the WikiWord." + (when (and (or (and muse-wiki-match-all-project-files + muse-wiki-project-file-regexp + (if string + (string-match muse-wiki-project-file-regexp string) + (looking-at muse-wiki-project-file-regexp))) + (and muse-wiki-use-wikiword + (if string + (string-match muse-wiki-wikiword-regexp string) + (looking-at muse-wiki-wikiword-regexp)))) + (cond + (muse-wiki-allow-nonexistent-wikiword + t) + ((and muse-wiki-ignore-implicit-links-to-current-page + (string= (match-string 1 string) (muse-page-name))) + nil) + ((and (muse-project-of-file) + (muse-project-page-file + (match-string 1 string) muse-current-project t)) + t) + ((file-exists-p (match-string 1 string)) + t) + (t nil))) + (match-string 1 string))) + +;;; Prettifications + +(defcustom muse-wiki-publish-small-title-words + '("the" "and" "at" "on" "of" "for" "in" "an" "a") + "Strings that should be downcased in a page title. + +This is used by `muse-wiki-publish-pretty-title', which must be +called manually." + :type '(repeat string) + :group 'muse-wiki) + +(defcustom muse-wiki-hide-nop-tag t + "If non-nil, hide <nop> tags when coloring a Muse buffer." + :type 'boolean + :group 'muse-wiki) + +(defun muse-wiki-publish-pretty-title (&optional title explicit) + "Return a pretty version of the given TITLE. + +If EXPLICIT is non-nil, TITLE will be returned unmodified." + (unless title (setq title (or (muse-publishing-directive "title") ""))) + (if (or explicit + (save-match-data (string-match muse-url-regexp title))) + title + (save-match-data + (let ((case-fold-search nil)) + (while (string-match (concat "\\([" muse-regexp-lower + "]\\)\\([" muse-regexp-upper + "0-9]\\)") + title) + (setq title (replace-match "\\1 \\2" t nil title))) + (let* ((words (split-string title)) + (w (cdr words))) + (while w + (if (member (downcase (car w)) + muse-wiki-publish-small-title-words) + (setcar w (downcase (car w)))) + (setq w (cdr w))) + (mapconcat 'identity words " ")))))) + +(defun muse-wiki-publish-pretty-interwiki (desc &optional explicit) + "Replace instances of `muse-wiki-interwiki-delimiter' with +`muse-wiki-interwiki-replacement'." + (if (or explicit + (save-match-data (string-match muse-url-regexp desc))) + desc + (muse-replace-regexp-in-string muse-wiki-interwiki-delimiter + muse-wiki-interwiki-replacement + desc))) + +;;; Coloring setup + +(defun muse-wiki-colors-nop-tag (beg end) + "Inhibit the colorization of inhibit links just after the tag. + +Example: <nop>WikiWord" + (when muse-wiki-hide-nop-tag + (add-text-properties beg (+ beg 5) + '(invisible muse intangible t))) + (unless (> (+ beg 6) (point-max)) + (add-text-properties (+ beg 5) (+ beg 6) + '(muse-no-implicit-link t)))) + +(defun muse-colors-wikiword-separate () + (add-text-properties (match-beginning 0) (match-end 0) + '(invisible muse intangible t))) + +(defun muse-wiki-insinuate-colors () + (add-to-list 'muse-colors-tags + '("nop" nil nil nil muse-wiki-colors-nop-tag) + t) + (add-to-list 'muse-colors-markup + '(muse-wiki-interwiki-regexp t muse-colors-implicit-link) + t) + (add-to-list 'muse-colors-markup + '(muse-wiki-wikiword-regexp t muse-colors-implicit-link) + t) + (add-to-list 'muse-colors-markup + '(muse-wiki-project-file-regexp t muse-colors-implicit-link) + t) + (add-to-list 'muse-colors-markup + '("''''" ?\' muse-colors-wikiword-separate) + nil) + (muse-colors-define-highlighting 'muse-mode muse-colors-markup)) + +(eval-after-load "muse-colors" '(muse-wiki-insinuate-colors)) + +;;; Publishing setup + +(defun muse-wiki-publish-nop-tag (beg end) + "Inhibit the colorization of inhibit links just after the tag. + +Example: <nop>WikiWord" + (unless (= (point) (point-max)) + (muse-publish-mark-read-only (point) (+ (point) 1)))) + +(defun muse-wiki-insinuate-publish () + (add-to-list 'muse-publish-markup-tags + '("nop" nil nil nil muse-wiki-publish-nop-tag) + t) + (add-to-list 'muse-publish-markup-regexps + '(3100 muse-wiki-interwiki-regexp 0 link) + t) + (add-to-list 'muse-publish-markup-regexps + '(3200 muse-wiki-wikiword-regexp 0 link) + t) + (add-to-list 'muse-publish-markup-regexps + '(3250 muse-wiki-project-file-regexp 0 link) + t) + (add-to-list 'muse-publish-markup-regexps + '(3300 "''''" 0 "") + t) + (custom-add-option 'muse-publish-desc-transforms + 'muse-wiki-publish-pretty-interwiki) + (custom-add-option 'muse-publish-desc-transforms + 'muse-wiki-publish-pretty-title)) + +(eval-after-load "muse-publish" '(muse-wiki-insinuate-publish)) + +;;; Insinuate link handling + +(custom-add-option 'muse-implicit-link-functions + 'muse-wiki-handle-implicit-interwiki) +(custom-add-option 'muse-implicit-link-functions + 'muse-wiki-handle-wikiword) + +(custom-add-option 'muse-explicit-link-functions + 'muse-wiki-handle-explicit-interwiki) + +(add-to-list 'muse-implicit-link-functions + 'muse-wiki-handle-implicit-interwiki t) +(add-to-list 'muse-implicit-link-functions + 'muse-wiki-handle-wikiword t) + +(add-to-list 'muse-explicit-link-functions + 'muse-wiki-handle-explicit-interwiki t) + +;;; Obsolete functions + +(defun muse-wiki-update-custom-values () + (muse-display-warning + (concat "Please remove `muse-wiki-update-custom-values' from" + " `muse-mode-hook'. Its use is now deprecated."))) + +(provide 'muse-wiki) +;;; muse-wiki.el ends here diff --git a/emacs.d/elisp/muse/muse-xml-common.el b/emacs.d/elisp/muse/muse-xml-common.el new file mode 100644 index 0000000..75869ca --- /dev/null +++ b/emacs.d/elisp/muse/muse-xml-common.el @@ -0,0 +1,201 @@ +;;; muse-xml-common.el --- common routines for XML-like publishing styles + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Contributors: + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse XML Publishing - Common Elements +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) +(require 'muse-regexps) + +(defcustom muse-xml-encoding-map + '((iso-8859-1 . "iso-8859-1") + (iso-2022-jp . "iso-2022-jp") + (utf-8 . "utf-8") + (japanese-iso-8bit . "euc-jp") + (chinese-big5 . "big5") + (mule-utf-8 . "utf-8") + (chinese-iso-8bit . "gb2312") + (chinese-gbk . "gbk")) + "An alist mapping Emacs coding systems to appropriate XML charsets. +Use the base name of the coding system (i.e. without the -unix)." + :type '(alist :key-type coding-system :value-type string) + :group 'muse-xml) + +(defun muse-xml-transform-content-type (content-type default) + "Using `muse-xml-encoding-map', try and resolve an Emacs coding +system to an associated XML coding system. +If no match is found, the DEFAULT charset is used instead." + (let ((match (and (fboundp 'coding-system-base) + (assoc (coding-system-base content-type) + muse-xml-encoding-map)))) + (if match + (cdr match) + default))) + +(defcustom muse-xml-markup-specials + '((?\" . """) + (?\< . "<") + (?\> . ">") + (?\& . "&")) + "A table of characters which must be represented specially." + :type '(alist :key-type character :value-type string) + :group 'muse-xml) + +(defcustom muse-xml-markup-specials-url-extra + '((?\" . """) + (?\< . "<") + (?\> . ">") + (?\& . "&") + (?\ . "%20") + (?\n . "%0D%0A")) + "A table of characters which must be represented specially. +These are extra characters that are escaped within URLs." + :type '(alist :key-type character :value-type string) + :group 'muse-xml) + +(defun muse-xml-decide-specials (context) + "Determine the specials to escape, depending on CONTEXT." + (cond ((memq context '(email url image)) + 'muse-xml-escape-url) + ((eq context 'url-extra) + muse-xml-markup-specials-url-extra) + (t muse-xml-markup-specials))) + +(defun muse-xml-escape-url (str) + "Convert to character entities any non-alphanumeric characters +outside a few punctuation symbols, that risk being misinterpreted +if not escaped." + (when str + (setq str (muse-publish-escape-specials-in-string str 'url-extra)) + (let (pos code len ch) + (save-match-data + (while (setq pos (string-match (concat "[^-" + muse-regexp-alnum + "/:._=@\\?~#%\"\\+<>()&;]") + str pos)) + (setq ch (aref str pos) + code (concat "&#" (int-to-string + (cond ((fboundp 'char-to-ucs) + (char-to-ucs ch)) + ((fboundp 'char-to-int) + (char-to-int ch)) + (t ch))) + ";") + len (length code) + str (concat (substring str 0 pos) + code + (when (< pos (length str)) + (substring str (1+ pos) nil))) + pos (+ len pos))) + str)))) + +(defun muse-xml-markup-anchor () + (unless (get-text-property (match-end 1) 'muse-link) + (let ((text (muse-markup-text 'anchor (match-string 2)))) + (save-match-data + (skip-chars-forward (concat muse-regexp-blank "\n")) + (when (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>")) + (goto-char (match-end 0))) + (muse-insert-markup text))) + (match-string 1))) + +(defun muse-xml-sort-table (table) + "Sort the given table structure so that it validates properly." + ;; Note that the decision matrix must have a nil diagonal, or else + ;; elements with the same type will be reversed with respect to each + ;; other. + (let ((decisions '((nil nil nil) ; body < header, body < footer + (t nil t) ; header stays where it is + (t nil nil)))) ; footer < header + (sort table #'(lambda (l r) + (and (integerp (car l)) (integerp (car r)) + (nth (1- (car r)) + (nth (1- (car l)) decisions))))))) + +(defun muse-xml-markup-table (&optional attributes) + "Publish the matched region into a table. +If a string ATTRIBUTES is given, pass it to the markup string begin-table." + (let* ((table-info (muse-publish-table-fields (match-beginning 0) + (match-end 0))) + (row-len (car table-info)) + (supports-group (not (string= (muse-markup-text 'begin-table-group + row-len) + ""))) + (field-list (muse-xml-sort-table (cdr table-info))) + last-part) + (when table-info + (let ((beg (point))) + (muse-publish-ensure-block beg)) + (muse-insert-markup (muse-markup-text 'begin-table (or attributes ""))) + (muse-insert-markup (muse-markup-text 'begin-table-group row-len)) + (dolist (fields field-list) + (let* ((type (car fields)) + (part (cond ((eq type 'hline) nil) + ((= type 1) "tbody") + ((= type 2) "thead") + ((= type 3) "tfoot"))) + (col (cond ((eq type 'hline) nil) + ((= type 1) "td") + ((= type 2) "th") + ((= type 3) "td")))) + (setq fields (cdr fields)) + (unless (and part last-part (string= part last-part)) + (when last-part + (muse-insert-markup " </" last-part ">\n") + (when (eq type 'hline) + ;; horizontal separators are represented by closing + ;; the current table group and opening a new one + (muse-insert-markup (muse-markup-text 'end-table-group)) + (muse-insert-markup (muse-markup-text 'begin-table-group + row-len)))) + (when part + (muse-insert-markup " <" part ">\n")) + (setq last-part part)) + (unless (eq type 'hline) + (muse-insert-markup (muse-markup-text 'begin-table-row)) + (dolist (field fields) + (muse-insert-markup (muse-markup-text 'begin-table-entry col)) + (insert field) + (muse-insert-markup (muse-markup-text 'end-table-entry col))) + (muse-insert-markup (muse-markup-text 'end-table-row))))) + (when last-part + (muse-insert-markup " </" last-part ">\n")) + (muse-insert-markup (muse-markup-text 'end-table-group)) + (muse-insert-markup (muse-markup-text 'end-table)) + (insert ?\n)))) + +(defun muse-xml-prepare-buffer () + (set (make-local-variable 'muse-publish-url-transforms) + (cons 'muse-xml-escape-string muse-publish-url-transforms))) + +(provide 'muse-xml-common) + +;;; muse-xml-common.el ends here diff --git a/emacs.d/elisp/muse/muse-xml.el b/emacs.d/elisp/muse/muse-xml.el new file mode 100644 index 0000000..9f26ade --- /dev/null +++ b/emacs.d/elisp/muse/muse-xml.el @@ -0,0 +1,274 @@ +;;; muse-xml.el --- publish XML files + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Michael Olson <mwolson@gnu.org> +;; Date: Sat 23-Jul-2005 + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; James Clarke's nxml-mode can be used for editing and validating +;; Muse-generated XML files. If you are in nxml-mode use the command +;; C-c C-s C-f to point to the schema in `contrib/muse.rnc', which +;; comes with Muse. Say yes if you are asked if you want to copy the +;; file to your location. C-c C-s C-a can then be used to reload the +;; schema if you make changes to the file. + +;;; Contributors: + +;; Peter K. Lee (saint AT corenova DOT com) made the initial +;; implementation of planner-publish.el, which was heavily borrowed +;; from. + +;; Brad Collins (brad AT chenla DOT org) provided a Compact RelaxNG +;; schema. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse XML Publishing +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'muse-publish) +(require 'muse-regexps) +(require 'muse-xml-common) + +(defgroup muse-xml nil + "Options controlling the behavior of Muse XML publishing. +See `muse-xml' for more information." + :group 'muse-publish) + +(defcustom muse-xml-extension ".xml" + "Default file extension for publishing XML files." + :type 'string + :group 'muse-xml) + +(defcustom muse-xml-header + "<?xml version=\"1.0\" encoding=\"<lisp> + (muse-xml-encoding)</lisp>\"?> +<MUSE> + <pageinfo> + <title><lisp>(muse-publishing-directive \"title\")</lisp></title> + <author><lisp>(muse-publishing-directive \"author\")</lisp></author> + <maintainer><lisp>(muse-style-element :maintainer)</lisp></maintainer> + <pubdate><lisp>(muse-publishing-directive \"date\")</lisp></pubdate> + </pageinfo> + <!-- Page published by Emacs Muse begins here -->\n" + "Header used for publishing XML files. +This may be text or a filename." + :type 'string + :group 'muse-xml) + +(defcustom muse-xml-footer " + <!-- Page published by Emacs Muse ends here --> +</MUSE>\n" + "Footer used for publishing XML files. +This may be text or a filename." + :type 'string + :group 'muse-xml) + +(defcustom muse-xml-markup-regexps + `(;; Beginning of doc, end of doc, or plain paragraph separator + (10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*" + "\\([" muse-regexp-blank "]*\n\\)\\)" + "\\|\\`\\s-*\\|\\s-*\\'\\)") + ;; this is somewhat repetitive because we only require the + ;; line just before the paragraph beginning to be not + ;; read-only + 3 muse-xml-markup-paragraph)) + "List of markup rules for publishing a Muse page to XML. +For more on the structure of this list, see `muse-publish-markup-regexps'." + :type '(repeat (choice + (list :tag "Markup rule" + integer + (choice regexp symbol) + integer + (choice string function symbol)) + function)) + :group 'muse-xml) + +(defcustom muse-xml-markup-functions + '((anchor . muse-xml-markup-anchor) + (table . muse-xml-markup-table)) + "An alist of style types to custom functions for that kind of text. +For more on the structure of this list, see +`muse-publish-markup-functions'." + :type '(alist :key-type symbol :value-type function) + :group 'muse-xml) + +(defcustom muse-xml-markup-strings + '((image-with-desc . "<image href=\"%s.%s\">%s</image>") + (image . "<image href=\"%s.%s\"></image>") + (image-link . "<link type=\"image\" href=\"%s\">%s.%s</link>") + (anchor-ref . "<link type=\"url\" href=\"#%s\">%s</link>") + (url . "<link type=\"url\" href=\"%s\">%s</link>") + (link . "<link type=\"url\" href=\"%s\">%s</link>") + (link-and-anchor . "<link type=\"url\" href=\"%s#%s\">%s</link>") + (email-addr . "<link type=\"email\" href=\"%s\">%s</link>") + (anchor . "<anchor id=\"%s\" />\n") + (emdash . "%s--%s") + (comment-begin . "<!-- ") + (comment-end . " -->") + (rule . "<hr />") + (fn-sep . "<hr />\n") + (no-break-space . " ") + (line-break . "<br>") + (enddots . "....") + (dots . "...") + (section . "<section level=\"1\"><title>") + (section-end . "</title>") + (subsection . "<section level=\"2\"><title>") + (subsection-end . "</title>") + (subsubsection . "<section level=\"3\"><title>") + (subsubsection-end . "</title>") + (section-other . "<section level=\"%s\"><title>") + (section-other-end . "</title>") + (section-close . "</section>") + (footnote . "<footnote>") + (footnote-end . "</footnote>") + (begin-underline . "<format type=\"underline\">") + (end-underline . "</format>") + (begin-literal . "<code>") + (end-literal . "</code>") + (begin-emph . "<format type=\"emphasis\" level=\"1\">") + (end-emph . "</format>") + (begin-more-emph . "<format type=\"emphasis\" level=\"2\">") + (end-more-emph . "</format>") + (begin-most-emph . "<format type=\"emphasis\" level=\"3\">") + (end-most-emph . "</format>") + (begin-verse . "<verse>\n") + (begin-verse-line . "<line>") + (end-verse-line . "</line>") + (empty-verse-line . "<line />") + (begin-last-stanza-line . "<line>") + (end-last-stanza-line . "</line>") + (end-verse . "</verse>") + (begin-example . "<example>") + (end-example . "</example>") + (begin-center . "<p><format type=\"center\">\n") + (end-center . "\n</format></p>") + (begin-quote . "<blockquote>\n") + (end-quote . "\n</blockquote>") + (begin-cite . "<cite>") + (begin-cite-author . "<cite type=\"author\">") + (begin-cite-year . "<cite type=\"year\">") + (end-cite . "</cite>") + (begin-quote-item . "<p>") + (end-quote-item . "</p>") + (begin-uli . "<list type=\"unordered\">\n") + (end-uli . "\n</list>") + (begin-uli-item . "<item>") + (end-uli-item . "</item>") + (begin-oli . "<list type=\"ordered\">\n") + (end-oli . "\n</list>") + (begin-oli-item . "<item>") + (end-oli-item . "</item>") + (begin-dl . "<list type=\"definition\">\n") + (end-dl . "\n</list>") + (begin-dl-item . "<item>\n") + (end-dl-item . "\n</item>") + (begin-ddt . "<term>") + (end-ddt . "</term>") + (begin-dde . "<definition>") + (end-dde . "</definition>") + (begin-table . "<table%s>\n") + (end-table . "</table>") + (begin-table-row . " <tr>\n") + (end-table-row . " </tr>\n") + (begin-table-entry . " <%s>") + (end-table-entry . "</%s>\n")) + "Strings used for marking up text. +These cover the most basic kinds of markup, the handling of which +differs little between the various styles." + :type '(alist :key-type symbol :value-type string) + :group 'muse-xml) + +(defcustom muse-xml-encoding-default 'utf-8 + "The default Emacs buffer encoding to use in published files. +This will be used if no special characters are found." + :type 'symbol + :group 'muse-xml) + +(defcustom muse-xml-charset-default "utf-8" + "The default XML charset to use if no translation is +found in `muse-xml-encoding-map'." + :type 'string + :group 'muse-xml) + +(defun muse-xml-encoding () + (muse-xml-transform-content-type + (or (and (boundp 'buffer-file-coding-system) + buffer-file-coding-system) + muse-xml-encoding-default) + muse-xml-charset-default)) + +(defun muse-xml-markup-paragraph () + (let ((end (copy-marker (match-end 0) t))) + (goto-char (match-beginning 0)) + (when (save-excursion + (save-match-data + (and (not (get-text-property (max (point-min) (1- (point))) + 'muse-no-paragraph)) + (re-search-backward "<\\(/?\\)p[ >]" nil t) + (not (string-equal (match-string 1) "/"))))) + (when (get-text-property (1- (point)) 'muse-end-list) + (goto-char (previous-single-property-change (1- (point)) + 'muse-end-list))) + (muse-insert-markup "</p>")) + (goto-char end)) + (cond + ((eobp) + (unless (bolp) + (insert "\n"))) + ((get-text-property (point) 'muse-no-paragraph) + (forward-char 1) + nil) + ((eq (char-after) ?\<) + (when (looking-at (concat "<\\(format\\|code\\|link\\|image" + "\\|anchor\\|footnote\\)[ >]")) + (muse-insert-markup "<p>"))) + (t + (muse-insert-markup "<p>")))) + +(defun muse-xml-finalize-buffer () + (when (boundp 'buffer-file-coding-system) + (when (memq buffer-file-coding-system '(no-conversion undecided-unix)) + ;; make it agree with the default charset + (setq buffer-file-coding-system muse-xml-encoding-default)))) + +;;; Register the Muse XML Publisher + +(muse-define-style "xml" + :suffix 'muse-xml-extension + :regexps 'muse-xml-markup-regexps + :functions 'muse-xml-markup-functions + :strings 'muse-xml-markup-strings + :specials 'muse-xml-decide-specials + :after 'muse-xml-finalize-buffer + :header 'muse-xml-header + :footer 'muse-xml-footer + :browser 'find-file) + +(provide 'muse-xml) + +;;; muse-xml.el ends here diff --git a/emacs.d/elisp/muse/muse.el b/emacs.d/elisp/muse/muse.el new file mode 100644 index 0000000..4d4a0b9 --- /dev/null +++ b/emacs.d/elisp/muse/muse.el @@ -0,0 +1,881 @@ +;;; muse.el --- an authoring and publishing tool for Emacs + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Emacs Lisp Archive Entry +;; Filename: muse.el +;; Version: 3.20 +;; Date: Sun 31 Jan-2010 +;; Keywords: hypermedia +;; Author: John Wiegley <johnw@gnu.org> +;; Maintainer: Michael Olson <mwolson@gnu.org> +;; Description: An authoring and publishing tool for Emacs +;; URL: http://mwolson.org/projects/EmacsMuse.html +;; Compatibility: Emacs21 XEmacs21 Emacs22 + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Muse is a tool for easily authoring and publishing documents. It +;; allows for rapid prototyping of hyperlinked text, which may then be +;; exported to multiple output formats -- such as HTML, LaTeX, +;; Texinfo, etc. + +;; The markup rules used by Muse are intended to be very friendly to +;; people familiar with Emacs. See the included manual for more +;; information. + +;;; Contributors: + +;;; Code: + +;; Indicate that this version of Muse supports nested tags +(provide 'muse-nested-tags) + +(defvar muse-version "3.20" + "The version of Muse currently loaded") + +(defun muse-version (&optional insert) + "Display the version of Muse that is currently loaded. +If INSERT is non-nil, insert the text instead of displaying it." + (interactive "P") + (if insert + (insert muse-version) + (message muse-version))) + +(defgroup muse nil + "Options controlling the behavior of Muse. +The markup used by Muse is intended to be very friendly to people +familiar with Emacs." + :group 'hypermedia) + +(defvar muse-under-windows-p (memq system-type '(ms-dos windows-nt))) + +(provide 'muse) + +(condition-case nil + (require 'derived) + (error nil)) +(require 'wid-edit) +(require 'muse-regexps) + +(defvar muse-update-values-hook nil + "Hook for values that are automatically generated. +This is to be used by add-on modules for Muse. +It is run just before colorizing or publishing a buffer.") + +(defun muse-update-values () + "Update various values that are automatically generated. + +Call this after changing `muse-project-alist'." + (interactive) + (run-hooks 'muse-update-values-hook) + (dolist (buffer (buffer-list)) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when (derived-mode-p 'muse-mode) + (and (boundp 'muse-current-project) + (fboundp 'muse-project-of-file) + (setq muse-current-project nil) + (setq muse-current-project (muse-project-of-file)))))))) + +;; Default file extension + +;; By default, use the .muse file extension. +;;;###autoload (add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode)) + +;; We need to have this at top-level, as well, so that any Muse or +;; Planner documents opened during init will just work. +(add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode)) + +(eval-when-compile + (defvar muse-ignored-extensions)) + +(defvar muse-ignored-extensions-regexp nil + "A regexp of extensions to omit from the ending of a Muse page name. +This is autogenerated from `muse-ignored-extensions'.") + +(defun muse-update-file-extension (sym val) + "Update the value of `muse-file-extension'." + (let ((old (and (boundp sym) (symbol-value sym)))) + (set sym val) + (when (and (featurep 'muse-mode) + (or (not (stringp val)) + (not (stringp old)) + (not (string= old val)))) + ;; remove old auto-mode-alist association + (when (and (boundp sym) (stringp old)) + (setq auto-mode-alist + (delete (cons (concat "\\." old "\\'") + 'muse-mode-choose-mode) + auto-mode-alist))) + ;; associate the new file extension with muse-mode + (when (stringp val) + (add-to-list 'auto-mode-alist + (cons (concat "\\." val "\\'") + 'muse-mode-choose-mode))) + ;; update the ignored extensions regexp + (when (fboundp 'muse-update-ignored-extensions-regexp) + (muse-update-ignored-extensions-regexp + 'muse-ignored-extensions muse-ignored-extensions))))) + +(defcustom muse-file-extension "muse" + "File extension of Muse files. Omit the period at the beginning. +If you don't want Muse files to have an extension, set this to nil." + :type '(choice + (const :tag "None" nil) + (string)) + :set 'muse-update-file-extension + :group 'muse) + +(defcustom muse-completing-read-function 'completing-read + "Function to call when prompting user to choose between a list of options. +This should take the same arguments as `completing-read'." + :type 'function + :group 'muse) + +(defun muse-update-ignored-extensions-regexp (sym val) + "Update the value of `muse-ignored-extensions-regexp'." + (set sym val) + (if val + (setq muse-ignored-extensions-regexp + (concat "\\.\\(" + (regexp-quote (or muse-file-extension "")) "\\|" + (mapconcat 'identity val "\\|") + "\\)\\'")) + (setq muse-ignored-extensions-regexp + (if muse-file-extension + (concat "\\.\\(" muse-file-extension "\\)\\'") + nil)))) + +(add-hook 'muse-update-values-hook + (lambda () + (muse-update-ignored-extensions-regexp + 'muse-ignored-extensions muse-ignored-extensions))) + +(defcustom muse-ignored-extensions '("bz2" "gz" "[Zz]") + "A list of extensions to omit from the ending of a Muse page name. +These are regexps. + +Don't put a period at the beginning of each extension unless you +understand that it is part of a regexp." + :type '(repeat (regexp :tag "Extension")) + :set 'muse-update-ignored-extensions-regexp + :group 'muse) + +(defun muse-update-file-extension-after-init () + ;; This is short, but it has to be a function, otherwise Emacs21 + ;; does not load it properly when running after-init-hook + (unless (string= muse-file-extension "muse") + (let ((val muse-file-extension) + (muse-file-extension "muse")) + (muse-update-file-extension 'muse-file-extension val)))) + +;; Once the user's init file has been processed, determine whether +;; they want a file extension +(add-hook 'after-init-hook 'muse-update-file-extension-after-init) + +;; URL protocols + +(require 'muse-protocols) + +;; Helper functions + +(defsubst muse-delete-file-if-exists (file) + (when (file-exists-p file) + (delete-file file) + (message "Removed %s" file))) + +(defsubst muse-time-less-p (t1 t2) + "Say whether time T1 is less than time T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + +(eval-when-compile + (defvar muse-publishing-current-file nil)) + +(defun muse-current-file () + "Return the name of the currently visited or published file." + (or (and (boundp 'muse-publishing-current-file) + muse-publishing-current-file) + (buffer-file-name) + (concat default-directory (buffer-name)))) + +(defun muse-page-name (&optional name) + "Return the canonical form of a Muse page name. + +What this means is that the directory part of NAME is removed, +and the file extensions in `muse-ignored-extensions' are also +removed from NAME." + (save-match-data + (unless (and name (not (string= name ""))) + (setq name (muse-current-file))) + (if name + (let ((page (file-name-nondirectory name))) + (if (and muse-ignored-extensions-regexp + (string-match muse-ignored-extensions-regexp page)) + (replace-match "" t t page) + page))))) + +(defun muse-display-warning (message) + "Display the given MESSAGE as a warning." + (if (fboundp 'display-warning) + (display-warning 'muse message + (if (featurep 'xemacs) + 'warning + :warning)) + (let ((buf (get-buffer-create "*Muse warnings*"))) + (with-current-buffer buf + (goto-char (point-max)) + (insert "Warning (muse): " message) + (unless (bolp) + (newline))) + (display-buffer buf) + (sit-for 0)))) + +(defun muse-eval-lisp (form) + "Evaluate the given form and return the result as a string." + (require 'pp) + (save-match-data + (condition-case err + (let ((object (eval (read form)))) + (cond + ((stringp object) object) + ((and (listp object) + (not (eq object nil))) + (let ((string (pp-to-string object))) + (substring string 0 (1- (length string))))) + ((numberp object) + (number-to-string object)) + ((eq object nil) "") + (t + (pp-to-string object)))) + (error + (muse-display-warning (format "%s: Error evaluating %s: %s" + (muse-page-name) form err)) + "; INVALID LISP CODE")))) + +(defmacro muse-with-temp-buffer (&rest body) + "Create a temporary buffer, and evaluate BODY there like `progn'. +See also `with-temp-file' and `with-output-to-string'. + +Unlike `with-temp-buffer', this will never attempt to save the +temp buffer. It is meant to be used along with +`insert-file-contents' or `muse-insert-file-contents'. + +The undo feature will be disabled in the new buffer. + +If `debug-on-error' is set to t, keep the buffer around for +debugging purposes rather than removing it." + (let ((temp-buffer (make-symbol "temp-buffer"))) + `(let ((,temp-buffer (generate-new-buffer " *muse-temp*"))) + (buffer-disable-undo ,temp-buffer) + (unwind-protect + (if debug-on-error + (with-current-buffer ,temp-buffer + ,@body) + (condition-case err + (with-current-buffer ,temp-buffer + ,@body) + (error + (if (and (boundp 'muse-batch-publishing-p) + muse-batch-publishing-p) + (progn + (message "%s: Error occured: %s" + (muse-page-name) err) + (backtrace)) + (muse-display-warning + (format (concat "An error occurred while publishing" + " %s:\n %s\n\nSet debug-on-error to" + " `t' if you would like a backtrace.") + (muse-page-name) err)))))) + (when (buffer-live-p ,temp-buffer) + (with-current-buffer ,temp-buffer + (set-buffer-modified-p nil)) + (unless debug-on-error (kill-buffer ,temp-buffer))))))) + +(put 'muse-with-temp-buffer 'lisp-indent-function 0) +(put 'muse-with-temp-buffer 'edebug-form-spec '(body)) + +(defun muse-insert-file-contents (filename &optional visit) + "Insert the contents of file FILENAME after point. +Do character code conversion and end-of-line conversion, but none +of the other unnecessary things like format decoding or +`find-file-hook'. + +If VISIT is non-nil, the buffer's visited filename +and last save file modtime are set, and it is marked unmodified. +If visiting and the file does not exist, visiting is completed +before the error is signaled." + (let ((format-alist nil) + (after-insert-file-functions nil) + (inhibit-file-name-handlers + (append '(jka-compr-handler image-file-handler epa-file-handler) + inhibit-file-name-handlers)) + (inhibit-file-name-operation 'insert-file-contents)) + (insert-file-contents filename visit))) + +(defun muse-write-file (filename &optional nomessage) + "Write current buffer into file FILENAME. +Unlike `write-file', this does not visit the file, try to back it +up, or interact with vc.el in any way. + +If the file was not written successfully, return nil. Otherwise, +return non-nil. + +If the NOMESSAGE argument is non-nil, suppress the \"Wrote file\" +message." + (when nomessage (setq nomessage 'nomessage)) + (let ((backup-inhibited t) + (buffer-file-name filename) + (buffer-file-truename (file-truename filename))) + (save-current-buffer + (save-restriction + (widen) + (if (not (file-writable-p buffer-file-name)) + (prog1 nil + (muse-display-warning + (format "Cannot write file %s:\n %s" buffer-file-name + (let ((dir (file-name-directory buffer-file-name))) + (if (not (file-directory-p dir)) + (if (file-exists-p dir) + (format "%s is not a directory" dir) + (format "No directory named %s exists" dir)) + (if (not (file-exists-p buffer-file-name)) + (format "Directory %s write-protected" dir) + "File is write-protected")))))) + (let ((coding-system-for-write + (or (and (boundp 'save-buffer-coding-system) + save-buffer-coding-system) + coding-system-for-write))) + (write-region (point-min) (point-max) buffer-file-name + nil nomessage)) + (when (boundp 'last-file-coding-system-used) + (when (boundp 'buffer-file-coding-system-explicit) + (setq buffer-file-coding-system-explicit + last-coding-system-used)) + (if save-buffer-coding-system + (setq save-buffer-coding-system last-coding-system-used) + (setq buffer-file-coding-system last-coding-system-used))) + t))))) + +(defun muse-collect-alist (list element &optional test) + "Collect items from LIST whose car is equal to ELEMENT. +If TEST is specified, use it to compare ELEMENT." + (unless test (setq test 'equal)) + (let ((items nil)) + (dolist (item list) + (when (funcall test element (car item)) + (setq items (cons item items)))) + items)) + +(defmacro muse-sort-with-closure (list predicate closure) + "Sort LIST, stably, comparing elements using PREDICATE. +Returns the sorted list. LIST is modified by side effects. +PREDICATE is called with two elements of list and CLOSURE. +PREDICATE should return non-nil if the first element should sort +before the second." + `(sort ,list (lambda (a b) (funcall ,predicate a b ,closure)))) + +(put 'muse-sort-with-closure 'lisp-indent-function 0) +(put 'muse-sort-with-closure 'edebug-form-spec '(form function-form form)) + +(defun muse-sort-by-rating (rated-list &optional test) + "Sort RATED-LIST according to the rating of each element. +The rating is stripped out in the returned list. +Default sorting is highest-first. + +If TEST if specified, use it to sort the list. The default test is '>." + (unless test (setq test '>)) + (mapcar (function cdr) + (muse-sort-with-closure + rated-list + (lambda (a b closure) + (let ((na (numberp (car a))) + (nb (numberp (car b)))) + (cond ((and na nb) (funcall closure (car a) (car b))) + (na (not nb)) + (t nil)))) + test))) + +(defun muse-escape-specials-in-string (specials string &optional reverse) + "Apply the transformations in SPECIALS to STRING. + +The transforms should form a fully reversible and non-ambiguous +syntax when STRING is parsed from left to right. + +If REVERSE is specified, reverse an already-escaped string." + (let ((rules (mapcar (lambda (rule) + (cons (regexp-quote (if reverse + (cdr rule) + (car rule))) + (if reverse (car rule) (cdr rule)))) + specials))) + (save-match-data + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (not (eobp)) + (unless (catch 'found + (dolist (rule rules) + (when (looking-at (car rule)) + (replace-match (cdr rule) t t) + (throw 'found t)))) + (forward-char))) + (buffer-string))))) + +(defun muse-trim-whitespace (string) + "Return a version of STRING with no initial nor trailing whitespace." + (muse-replace-regexp-in-string + (concat "\\`[" muse-regexp-blank "]+\\|[" muse-regexp-blank "]+\\'") + "" string)) + +(defun muse-path-sans-extension (path) + "Return PATH sans final \"extension\". + +The extension, in a file name, is the part that follows the last `.', +except that a leading `.', if any, doesn't count. + +This differs from `file-name-sans-extension' in that it will +never modify the directory part of the path." + (concat (file-name-directory path) + (file-name-nondirectory (file-name-sans-extension path)))) + +;; The following code was extracted from cl + +(defun muse-const-expr-p (x) + (cond ((consp x) + (or (eq (car x) 'quote) + (and (memq (car x) '(function function*)) + (or (symbolp (nth 1 x)) + (and (eq (and (consp (nth 1 x)) + (car (nth 1 x))) 'lambda) 'func))))) + ((symbolp x) (and (memq x '(nil t)) t)) + (t t))) + +(put 'muse-assertion-failed 'error-conditions '(error)) +(put 'muse-assertion-failed 'error-message "Assertion failed") + +(defun muse-list* (arg &rest rest) + "Return a new list with specified args as elements, cons'd to last arg. +Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to +`(cons A (cons B (cons C D)))'." + (cond ((not rest) arg) + ((not (cdr rest)) (cons arg (car rest))) + (t (let* ((n (length rest)) + (copy (copy-sequence rest)) + (last (nthcdr (- n 2) copy))) + (setcdr last (car (cdr last))) + (cons arg copy))))) + +(defmacro muse-assert (form &optional show-args string &rest args) + "Verify that FORM returns non-nil; signal an error if not. +Second arg SHOW-ARGS means to include arguments of FORM in message. +Other args STRING and ARGS... are arguments to be passed to `error'. +They are not evaluated unless the assertion fails. If STRING is +omitted, a default message listing FORM itself is used." + (let ((sargs + (and show-args + (delq nil (mapcar + (function + (lambda (x) + (and (not (muse-const-expr-p x)) x))) + (cdr form)))))) + (list 'progn + (list 'or form + (if string + (muse-list* 'error string (append sargs args)) + (list 'signal '(quote muse-assertion-failed) + (muse-list* 'list (list 'quote form) sargs)))) + nil))) + +;; Compatibility functions + +(if (fboundp 'looking-back) + (defalias 'muse-looking-back 'looking-back) + (defun muse-looking-back (regexp &optional limit &rest ignored) + (save-excursion + (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)))) + +(eval-and-compile + (if (fboundp 'line-end-position) + (defalias 'muse-line-end-position 'line-end-position) + (defun muse-line-end-position (&optional n) + (save-excursion (end-of-line n) (point)))) + + (if (fboundp 'line-beginning-position) + (defalias 'muse-line-beginning-position 'line-beginning-position) + (defun muse-line-beginning-position (&optional n) + (save-excursion (beginning-of-line n) (point)))) + + (if (fboundp 'match-string-no-properties) + (defalias 'muse-match-string-no-properties 'match-string-no-properties) + (defun muse-match-string-no-properties (num &optional string) + (match-string num string)))) + +(defun muse-replace-regexp-in-string (regexp replacement text &optional fixedcase literal) + "Replace REGEXP with REPLACEMENT in TEXT. + +Return a new string containing the replacements. + +If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text. +If fifth arg LITERAL is non-nil, insert REPLACEMENT literally." + (cond + ((and (featurep 'xemacs) (fboundp 'replace-in-string)) + (and (fboundp 'replace-in-string) ; stupid byte-compiler warning + (replace-in-string text regexp replacement literal))) + ((fboundp 'replace-regexp-in-string) + (replace-regexp-in-string regexp replacement text fixedcase literal)) + (t (error (concat "Neither `replace-in-string' nor " + "`replace-regexp-in-string' was found"))))) + +(if (fboundp 'add-to-invisibility-spec) + (defalias 'muse-add-to-invisibility-spec 'add-to-invisibility-spec) + (defun muse-add-to-invisibility-spec (element) + "Add ELEMENT to `buffer-invisibility-spec'. +See documentation for `buffer-invisibility-spec' for the kind of elements +that can be added." + (if (eq buffer-invisibility-spec t) + (setq buffer-invisibility-spec (list t))) + (setq buffer-invisibility-spec + (cons element buffer-invisibility-spec)))) + +(if (fboundp 'read-directory-name) + (defalias 'muse-read-directory-name 'read-directory-name) + (defun muse-read-directory-name (prompt &optional dir default-dirname mustmatch initial) + "Read directory name - see `read-file-name' for details." + (unless dir + (setq dir default-directory)) + (read-file-name prompt dir (or default-dirname + (if initial (expand-file-name initial dir) + dir)) + mustmatch initial))) + +(defun muse-file-remote-p (file) + "Test whether FILE specifies a location on a remote system. +Return non-nil if the location is indeed remote. + +For example, the filename \"/user@host:/foo\" specifies a location +on the system \"/user@host:\"." + (cond ((fboundp 'file-remote-p) + (file-remote-p file)) + ((fboundp 'tramp-handle-file-remote-p) + (tramp-handle-file-remote-p file)) + ((and (boundp 'ange-ftp-name-format) + (string-match (car ange-ftp-name-format) file)) + t) + (t nil))) + +(if (fboundp 'delete-and-extract-region) + (defalias 'muse-delete-and-extract-region 'delete-and-extract-region) + (defun muse-delete-and-extract-region (start end) + "Delete the text between START and END and return it." + (prog1 (buffer-substring start end) + (delete-region start end)))) + +(if (fboundp 'delete-dups) + (defalias 'muse-delete-dups 'delete-dups) + (defun muse-delete-dups (list) + "Destructively remove `equal' duplicates from LIST. +Store the result in LIST and return it. LIST must be a proper list. +Of several `equal' occurrences of an element in LIST, the first +one is kept." + (let ((tail list)) + (while tail + (setcdr tail (delete (car tail) (cdr tail))) + (setq tail (cdr tail)))) + list)) + +;; Set face globally in a predictable fashion +(defun muse-copy-face (old new) + "Copy face OLD to NEW." + (if (featurep 'xemacs) + (copy-face old new 'all) + (copy-face old new))) + +;; Widget compatibility functions + +(defun muse-widget-type-value-create (widget) + "Convert and instantiate the value of the :type attribute of WIDGET. +Store the newly created widget in the :children attribute. + +The value of the :type attribute should be an unconverted widget type." + (let ((value (widget-get widget :value)) + (type (widget-get widget :type))) + (widget-put widget :children + (list (widget-create-child-value widget + (widget-convert type) + value))))) + +(defun muse-widget-child-value-get (widget) + "Get the value of the first member of :children in WIDGET." + (widget-value (car (widget-get widget :children)))) + +(defun muse-widget-type-match (widget value) + "Non-nil if the :type value of WIDGET matches VALUE. + +The value of the :type attribute should be an unconverted widget type." + (widget-apply (widget-convert (widget-get widget :type)) :match value)) + +;; Link-handling functions and variables + +(defun muse-get-link (&optional target) + "Based on the match data, retrieve the link. +Use TARGET to get the string, if it is specified." + (muse-match-string-no-properties 1 target)) + +(defun muse-get-link-desc (&optional target) + "Based on the match data, retrieve the link description. +Use TARGET to get the string, if it is specified." + (muse-match-string-no-properties 2 target)) + +(defvar muse-link-specials + '(("[" . "%5B") + ("]" . "%5D") + ("%" . "%%")) + "Syntax used for escaping and unescaping links. +This allows brackets to occur in explicit links as long as you +use the standard Muse functions to create them.") + +(defun muse-link-escape (text) + "Escape characters in TEXT that conflict with the explicit link +regexp." + (when (stringp text) + (muse-escape-specials-in-string muse-link-specials text))) + +(defun muse-link-unescape (text) + "Un-escape characters in TEXT that conflict with the explicit +link regexp." + (when (stringp text) + (muse-escape-specials-in-string muse-link-specials text t))) + +(defun muse-handle-url (&optional string) + "If STRING or point has a URL, match and return it." + (if (if string (string-match muse-url-regexp string) + (looking-at muse-url-regexp)) + (match-string 0 string))) + +(defcustom muse-implicit-link-functions '(muse-handle-url) + "A list of functions to handle an implicit link. +An implicit link is one that is not surrounded by brackets. + +By default, Muse handles URLs only. +If you want to handle WikiWords, load muse-wiki.el." + :type 'hook + :options '(muse-handle-url) + :group 'muse) + +(defun muse-handle-implicit-link (&optional link) + "Handle implicit links. If LINK is not specified, look at point. +An implicit link is one that is not surrounded by brackets. +By default, Muse handles URLs only. +If you want to handle WikiWords, load muse-wiki.el. + +This function modifies the match data so that match 0 is the +link. + +The match data is restored after each unsuccessful handler +function call. If LINK is specified, only restore at very end. + +This behavior is needed because the part of the buffer that +`muse-implicit-link-regexp' matches must be narrowed to the part +that is an accepted link." + (let ((funcs muse-implicit-link-functions) + (res nil) + (data (match-data t))) + (while funcs + (setq res (funcall (car funcs) link)) + (if res + (setq funcs nil) + (unless link (set-match-data data)) + (setq funcs (cdr funcs)))) + (when link (set-match-data data)) + res)) + +(defcustom muse-explicit-link-functions nil + "A list of functions to handle an explicit link. +An explicit link is one [[like][this]] or [[this]]." + :type 'hook + :group 'muse) + +(defun muse-handle-explicit-link (&optional link) + "Handle explicit links. If LINK is not specified, look at point. +An explicit link is one that looks [[like][this]] or [[this]]. + +The match data is preserved. If no handlers are able to process +LINK, return LINK (if specified) or the 1st match string. If +LINK is not specified, it is assumed that Muse has matched +against `muse-explicit-link-regexp' before calling this +function." + (let ((funcs muse-explicit-link-functions) + (res nil)) + (save-match-data + (while funcs + (setq res (funcall (car funcs) link)) + (if res + (setq funcs nil) + (setq funcs (cdr funcs))))) + (muse-link-unescape + (if res + res + (or link (muse-get-link)))))) + +;; Movement functions + +(defun muse-list-item-type (str) + "Determine the type of list given STR. +Returns either 'ul, 'ol, 'dl-term, 'dl-entry, or nil." + (save-match-data + (cond ((or (string= str "") + (< (length str) 2)) + nil) + ((string-match muse-dl-entry-regexp str) + 'dl-entry) + ((string-match muse-dl-term-regexp str) + 'dl-term) + ((string-match muse-ol-item-regexp str) + 'ol) + ((string-match muse-ul-item-regexp str) + 'ul) + (t nil)))) + +(defun muse-list-item-critical-point (&optional offset) + "Figure out where the important markup character for the +currently-matched list item is. + +If OFFSET is specified, it is the number of groupings outside of +the contents of `muse-list-item-regexp'." + (unless offset (setq offset 0)) + (if (match-end (+ offset 2)) + ;; at a definition list + (match-end (+ offset 2)) + ;; at a different kind of list + (match-beginning (+ offset 1)))) + +(defun muse-forward-paragraph (&optional pattern) + "Move forward safely by one paragraph, or according to PATTERN." + (when (get-text-property (point) 'muse-end-list) + (goto-char (next-single-property-change (point) 'muse-end-list))) + (setq pattern (if pattern + (concat "^\\(?:" pattern "\\|\n\\|\\'\\)") + "^\\s-*\\(\n\\|\\'\\)")) + (let ((next-list-end (or (next-single-property-change (point) 'muse-end-list) + (point-max)))) + (forward-line 1) + (if (re-search-forward pattern nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max))) + (when (> (point) next-list-end) + (goto-char next-list-end)))) + +(defun muse-forward-list-item-1 (type empty-line indented-line) + "Determine whether a nested list item is after point." + (if (match-beginning 1) + ;; if we are given a dl entry, skip past everything on the same + ;; level, except for other dl entries + (and (eq type 'dl-entry) + (not (eq (char-after (match-beginning 2)) ?\:))) + ;; blank line encountered with no list item on the same + ;; level after it + (let ((beg (point))) + (forward-line 1) + (if (save-match-data + (and (looking-at indented-line) + (not (looking-at empty-line)))) + ;; found that this blank line is followed by some + ;; indentation, plus other text, so we'll keep + ;; going + t + (goto-char beg) + nil)))) + +(defun muse-forward-list-item (type indent &optional no-skip-nested) + "Move forward to the next item of TYPE. +Return non-nil if successful, nil otherwise. +The beginning indentation is given by INDENT. + +If NO-SKIP-NESTED is non-nil, do not skip past nested items. +Note that if you desire this behavior, you will also need to +provide a very liberal INDENT value, such as +\(concat \"[\" muse-regexp-blank \"]*\")." + (let* ((list-item (format muse-list-item-regexp indent)) + (empty-line (concat "^[" muse-regexp-blank "]*\n")) + (indented-line (concat "^" indent "[" muse-regexp-blank "]")) + (list-pattern (concat "\\(?:" empty-line "\\)?" + "\\(" list-item "\\)"))) + (while (progn + (muse-forward-paragraph list-pattern) + ;; make sure we don't go past boundary + (and (not (or (get-text-property (point) 'muse-end-list) + (>= (point) (point-max)))) + ;; move past markup that is part of another construct + (or (and (match-beginning 1) + (or (get-text-property + (muse-list-item-critical-point 1) 'muse-link) + (and (derived-mode-p 'muse-mode) + (get-text-property + (muse-list-item-critical-point 1) + 'face)))) + ;; skip nested items + (and (not no-skip-nested) + (muse-forward-list-item-1 type empty-line + indented-line)))))) + (cond ((or (get-text-property (point) 'muse-end-list) + (>= (point) (point-max))) + ;; at a list boundary, so stop + nil) + ((let ((str (when (match-beginning 2) + ;; get the entire line + (save-excursion + (goto-char (match-beginning 2)) + (buffer-substring (muse-line-beginning-position) + (muse-line-end-position)))))) + (and str (eq type (muse-list-item-type str)))) + ;; same type, so indicate that there are more items to be + ;; parsed + (goto-char (match-beginning 1))) + (t + (when (match-beginning 1) + (goto-char (match-beginning 1))) + ;; move to just before foreign list item markup + nil)))) + +(defun muse-goto-tag-end (tag nested) + "Move forward past the end of TAG. + +If NESTED is non-nil, look for other instances of this tag that +may be nested inside of this tag, and skip past them." + (if (not nested) + (search-forward (concat "</" tag ">") nil t) + (let ((nesting 1) + (tag-regexp (concat "\\(<\\(/?\\)" tag "\\([ >]\\)\\)")) + (match-found nil)) + (while (and (> nesting 0) + (setq match-found (re-search-forward tag-regexp nil t))) + ;; for the sake of font-locking code, skip matches in comments + (unless (get-text-property (match-beginning 0) 'muse-comment) + (if (string-equal (match-string 2) "/") + (and (string-equal (match-string 3) ">") + (setq nesting (1- nesting))) + (setq nesting (1+ nesting))))) + match-found))) + +;;; muse.el ends here |