ryuslash/legacy-dotfiles
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Big changes, last one before I wipe it all.

Browse source 
* 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.
This commit is contained in:
Tom Willemsen 2011-03-17 11:23:07 +01:00
parent a502df33ce
commit 57366f385a
38 changed files with 15070 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
emacs.d/.gitignore vendored
View file

@ -1,2 +1,3 @@
tramp tramp
elpa elpa
bookmarks

1
emacs.d/00-paths.el
View file

@ -2,3 +2,4 @@
(add-to-list 'load-path "~/.emacs.d/naquadah-theme") (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/auto-complete-clang")
(add-to-list 'load-path "~/.emacs.d/nxhtml") (add-to-list 'load-path "~/.emacs.d/nxhtml")
(add-to-list 'load-path "~/.emacs.d/elisp/muse")

6
emacs.d/10-modules.el
View file

@ -1,6 +1,10 @@
(require 'minimap) (require 'minimap)
(require 'naquadah-theme) (require 'naquadah-theme)
;(require 'auto-complete-clang) ;(require 'auto-complete-clang)
(require 'muse-mode)
(require 'muse-html)
(require 'muse-project)
(load "autostart.el") (load "autostart.el")
(autoload 'vala-mode (autoload 'vala-mode
@ -17,3 +21,5 @@
"lua-mode" "A Major mode for editing Lua files" t) "lua-mode" "A Major mode for editing Lua files" t)
(autoload 'php-mode (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)

1
emacs.d/10-settings.el
View file

@ -24,6 +24,7 @@
(delete-selection-mode t) ; delete selection upon typing (delete-selection-mode t) ; delete selection upon typing
;; Byte-compile elisp files on save ;; Byte-compile elisp files on save
(add-hook 'before-save-hook 'delete-trailing-whitespace)
(add-hook 'after-save-hook (add-hook 'after-save-hook
(lambda () (lambda ()
(let ((fname (buffer-file-name))) (let ((fname (buffer-file-name)))

4
emacs.d/20-org.el
View file

@ -13,6 +13,10 @@
(setq org-crypt-key "33E8CC1CC4") (setq org-crypt-key "33E8CC1CC4")
; GPG key used for encryption ; GPG key used for encryption
(setq org-use-fast-todo-selection t) (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 (setq org-todo-keyword-faces
'(("TODO" :foreground "red" :weight bold) '(("TODO" :foreground "red" :weight bold)

3
emacs.d/50-muse-projects.el Normal file
View file

@ -0,0 +1,3 @@
(setq muse-project-alist
'(("lxcoding-docs" ("~/prj/lxcoding-docs" :default "index")
(:base "html" :path "~/devel/mnt/lxcoding/www/docs"))))

13
emacs.d/50-org-projects.el Normal file
View file

@ -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")))

946
emacs.d/elisp/graphviz-dot-mode.el Normal file
View file

@ -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

99
emacs.d/elisp/muse/Makefile Normal file
View file

@ -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

303
emacs.d/elisp/muse/muse-autoloads.el Normal file
View file

@ -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:

327
emacs.d/elisp/muse/muse-backlink.el Normal file
View file

@ -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

306
emacs.d/elisp/muse/muse-blosxom.el Normal file
View file

@ -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

284
emacs.d/elisp/muse/muse-book.el Normal file
View file

@ -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

1022
emacs.d/elisp/muse/muse-colors.el Normal file
View file

File diff suppressed because it is too large Load diff

458
emacs.d/elisp/muse/muse-context.el Normal file
View file

@ -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

352
emacs.d/elisp/muse/muse-docbook.el Normal file
View file

@ -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&mdash;%s")
(comment-begin . "<!-- ")
(comment-end . " -->")
(rule . "")
(no-break-space . "&nbsp;")
(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

274
emacs.d/elisp/muse/muse-groff.el Normal file
View file

@ -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:

754
emacs.d/elisp/muse/muse-html.el Normal file
View file

@ -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&mdash;%s")
(comment-begin . "<!-- ")
(comment-end . " -->")
(rule . "<hr>")
(fn-sep . "<hr>\n")
(no-break-space . "&nbsp;")
(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 . "&nbsp;&nbsp;")
(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

239
emacs.d/elisp/muse/muse-http.el Normal file
View file

@ -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

219
emacs.d/elisp/muse/muse-ikiwiki.el Normal file
View file

@ -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

137
emacs.d/elisp/muse/muse-import-docbook.el Normal file
View file

@ -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

149
emacs.d/elisp/muse/muse-import-latex.el Normal file
View file

@ -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

88
emacs.d/elisp/muse/muse-import-xml.el Normal file
View file

@ -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

194
emacs.d/elisp/muse/muse-ipc.el Normal file
View file

@ -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

774
emacs.d/elisp/muse/muse-journal.el Normal file
View file

@ -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\">&nbsp;</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 "&nbsp;") 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

669
emacs.d/elisp/muse/muse-latex.el Normal file
View file

@ -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

277
emacs.d/elisp/muse/muse-latex2png.el Normal file
View file

@ -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

1013
emacs.d/elisp/muse/muse-mode.el Normal file
View file

File diff suppressed because it is too large Load diff

263
emacs.d/elisp/muse/muse-poem.el Normal file
View file

@ -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

973
emacs.d/elisp/muse/muse-project.el Normal file
View file

@ -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

251
emacs.d/elisp/muse/muse-protocols.el Normal file
View file

@ -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

2193
emacs.d/elisp/muse/muse-publish.el Normal file
View file

File diff suppressed because it is too large Load diff

270
emacs.d/elisp/muse/muse-regexps.el Normal file
View file

@ -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

346
emacs.d/elisp/muse/muse-texinfo.el Normal file
View file

@ -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

498
emacs.d/elisp/muse/muse-wiki.el Normal file
View file

@ -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

201
emacs.d/elisp/muse/muse-xml-common.el Normal file
View file

@ -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
'((?\" . "&quot;")
(?\< . "&lt;")
(?\> . "&gt;")
(?\& . "&amp;"))
"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
'((?\" . "&quot;")
(?\< . "&lt;")
(?\> . "&gt;")
(?\& . "&amp;")
(?\ . "%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

274
emacs.d/elisp/muse/muse-xml.el Normal file
View file

@ -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 . "&nbsp;")
(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

881
emacs.d/elisp/muse/muse.el Normal file
View file

@ -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