Big changes, last one before I wipe it all.
* Added muse * Added graphviz-dot-mode * Remove all trailing whitespace on save. This is the last commit I'm going to do before throwing it all away again.
This commit is contained in:
Tom Willemsen
parent
a502df33ce
commit
57366f385a
38 changed files with 15070 additions and 7 deletions
1
emacs.d/.gitignore
vendored
1
emacs.d/.gitignore
vendored
|
|
@ -1,2 +1,3 @@
|
|||
tramp
|
||||
elpa
|
||||
bookmarks
|
||||
|
|
|
|||
|
|
@ -2,3 +2,4 @@
|
|||
(add-to-list 'load-path "~/.emacs.d/naquadah-theme")
|
||||
(add-to-list 'load-path "~/.emacs.d/auto-complete-clang")
|
||||
(add-to-list 'load-path "~/.emacs.d/nxhtml")
|
||||
(add-to-list 'load-path "~/.emacs.d/elisp/muse")
|
||||
|
|
|
|||
|
|
@ -1,19 +1,25 @@
|
|||
(require 'minimap)
|
||||
(require 'naquadah-theme)
|
||||
;(require 'auto-complete-clang)
|
||||
(require 'muse-mode)
|
||||
(require 'muse-html)
|
||||
(require 'muse-project)
|
||||
|
||||
(load "autostart.el")
|
||||
|
||||
(autoload 'vala-mode
|
||||
"vala-mode" "A Major mode for editing Vala files" t)
|
||||
"vala-mode" "A Major mode for editing Vala files" t)
|
||||
(autoload 'csharp-mode
|
||||
"csharp-mode" "A Major mode for editing C# files" t)
|
||||
"csharp-mode" "A Major mode for editing C# files" t)
|
||||
(autoload 'javascript-mode
|
||||
"javascript" "A Major mode for editing JavaScript files" t)
|
||||
"javascript" "A Major mode for editing JavaScript files" t)
|
||||
(autoload 'sqlplus-mode
|
||||
"sqlplus" "A Major mode for communicating with Oracle" t)
|
||||
"sqlplus" "A Major mode for communicating with Oracle" t)
|
||||
(autoload 'batch-mode
|
||||
"batch-mode" "A Major mode for editing Batch files" t)
|
||||
"batch-mode" "A Major mode for editing Batch files" t)
|
||||
(autoload 'lua-mode
|
||||
"lua-mode" "A Major mode for editing Lua files" t)
|
||||
"lua-mode" "A Major mode for editing Lua files" t)
|
||||
(autoload 'php-mode
|
||||
"php-mode" "A Major mode for editing PHP files" t)
|
||||
"php-mode" "A Major mode for editing PHP files" t)
|
||||
(autoload 'graphviz-dot-mode
|
||||
"graphviz-dot-mode" "A Major mode for editing graphviz dot files" t)
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@
|
|||
(delete-selection-mode t) ; delete selection upon typing
|
||||
|
||||
;; Byte-compile elisp files on save
|
||||
(add-hook 'before-save-hook 'delete-trailing-whitespace)
|
||||
(add-hook 'after-save-hook
|
||||
(lambda ()
|
||||
(let ((fname (buffer-file-name)))
|
||||
|
|
|
|||
|
|
@ -13,6 +13,10 @@
|
|||
(setq org-crypt-key "33E8CC1CC4")
|
||||
; GPG key used for encryption
|
||||
(setq org-use-fast-todo-selection t)
|
||||
(setq org-default-notes-file (concat org-directory "/notes.org"))
|
||||
(setq org-refile-targets '((org-agenda-files :maxlevel . 5)
|
||||
(nil :maxlevel . 5)))
|
||||
(setq org-outline-path-complete-in-steps t)
|
||||
|
||||
(setq org-todo-keyword-faces
|
||||
'(("TODO" :foreground "red" :weight bold)
|
||||
|
|
|
|||
3
emacs.d/50-muse-projects.el
Normal file
3
emacs.d/50-muse-projects.el
Normal 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
13
emacs.d/50-org-projects.el
Normal 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
946
emacs.d/elisp/graphviz-dot-mode.el
Normal 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
99
emacs.d/elisp/muse/Makefile
Normal 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
303
emacs.d/elisp/muse/muse-autoloads.el
Normal 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
327
emacs.d/elisp/muse/muse-backlink.el
Normal 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
306
emacs.d/elisp/muse/muse-blosxom.el
Normal 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
284
emacs.d/elisp/muse/muse-book.el
Normal 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
1022
emacs.d/elisp/muse/muse-colors.el
Normal file
File diff suppressed because it is too large
Load diff
458
emacs.d/elisp/muse/muse-context.el
Normal file
458
emacs.d/elisp/muse/muse-context.el
Normal 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
352
emacs.d/elisp/muse/muse-docbook.el
Normal 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—%s")
|
||||
(comment-begin . "<!-- ")
|
||||
(comment-end . " -->")
|
||||
(rule . "")
|
||||
(no-break-space . " ")
|
||||
(enddots . "....")
|
||||
(dots . "...")
|
||||
(section . "<section><title>")
|
||||
(section-end . "</title>")
|
||||
(subsection . "<section><title>")
|
||||
(subsection-end . "</title>")
|
||||
(subsubsection . "<section><title>")
|
||||
(subsubsection-end . "</title>")
|
||||
(section-other . "<section><title>")
|
||||
(section-other-end . "</title>")
|
||||
(section-close . "</section>")
|
||||
(footnote . "<footnote><para>")
|
||||
(footnote-end . "</para></footnote>")
|
||||
(begin-underline . "")
|
||||
(end-underline . "")
|
||||
(begin-literal . "<systemitem>")
|
||||
(end-literal . "</systemitem>")
|
||||
(begin-emph . "<emphasis>")
|
||||
(end-emph . "</emphasis>")
|
||||
(begin-more-emph . "<emphasis role=\"strong\">")
|
||||
(end-more-emph . "</emphasis>")
|
||||
(begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
|
||||
(end-most-emph . "</emphasis></emphasis>")
|
||||
(begin-verse . "<literallayout>\n")
|
||||
(verse-space . " ")
|
||||
(end-verse . "</literallayout>")
|
||||
(begin-example . "<programlisting>")
|
||||
(end-example . "</programlisting>")
|
||||
(begin-center . "<para role=\"centered\">\n")
|
||||
(end-center . "\n</para>")
|
||||
(begin-quote . "<blockquote>\n")
|
||||
(end-quote . "\n</blockquote>")
|
||||
(begin-cite . "<citation role=\"%s\">")
|
||||
(begin-cite-author . "<citation role=\"%s\">A:")
|
||||
(begin-cite-year . "<citation role=\"%s\">Y:")
|
||||
(end-cite . "</citation>")
|
||||
(begin-quote-item . "<para>")
|
||||
(end-quote-item . "</para>")
|
||||
(begin-uli . "<itemizedlist mark=\"bullet\">\n")
|
||||
(end-uli . "\n</itemizedlist>")
|
||||
(begin-uli-item . "<listitem><para>")
|
||||
(end-uli-item . "</para></listitem>")
|
||||
(begin-oli . "<orderedlist>\n")
|
||||
(end-oli . "\n</orderedlist>")
|
||||
(begin-oli-item . "<listitem><para>")
|
||||
(end-oli-item . "</para></listitem>")
|
||||
(begin-dl . "<variablelist>\n")
|
||||
(end-dl . "\n</variablelist>")
|
||||
(begin-dl-item . "<varlistentry>\n")
|
||||
(end-dl-item . "\n</varlistentry>")
|
||||
(begin-ddt . "<term>")
|
||||
(end-ddt . "</term>")
|
||||
(begin-dde . "<listitem><para>")
|
||||
(end-dde . "</para></listitem>")
|
||||
(begin-table . "<informaltable>\n")
|
||||
(end-table . "</informaltable>")
|
||||
(begin-table-group . " <tgroup cols='%s'>\n")
|
||||
(end-table-group . " </tgroup>\n")
|
||||
(begin-table-row . " <row>\n")
|
||||
(end-table-row . " </row>\n")
|
||||
(begin-table-entry . " <entry>")
|
||||
(end-table-entry . "</entry>\n"))
|
||||
"Strings used for marking up text.
|
||||
These cover the most basic kinds of markup, the handling of which
|
||||
differs little between the various styles."
|
||||
:type '(alist :key-type symbol :value-type string)
|
||||
:group 'muse-docbook)
|
||||
|
||||
(defcustom muse-docbook-encoding-default 'utf-8
|
||||
"The default Emacs buffer encoding to use in published files.
|
||||
This will be used if no special characters are found."
|
||||
:type 'symbol
|
||||
:group 'muse-docbook)
|
||||
|
||||
(defcustom muse-docbook-charset-default "utf-8"
|
||||
"The default DocBook XML charset to use if no translation is
|
||||
found in `muse-docbook-encoding-map'."
|
||||
:type 'string
|
||||
:group 'muse-docbook)
|
||||
|
||||
(defun muse-docbook-encoding ()
|
||||
(muse-xml-transform-content-type
|
||||
(or (and (boundp 'buffer-file-coding-system)
|
||||
buffer-file-coding-system)
|
||||
muse-docbook-encoding-default)
|
||||
muse-docbook-charset-default))
|
||||
|
||||
(defun muse-docbook-markup-paragraph ()
|
||||
(catch 'bail-out
|
||||
(let ((end (copy-marker (match-end 0) t)))
|
||||
(goto-char (match-beginning 0))
|
||||
(when (save-excursion
|
||||
(save-match-data
|
||||
(and (not (get-text-property (max (point-min) (1- (point)))
|
||||
'muse-no-paragraph))
|
||||
(re-search-backward
|
||||
"<\\(/?\\)\\(para\\|footnote\\|literallayout\\)[ >]"
|
||||
nil t)
|
||||
(cond ((string= (match-string 2) "literallayout")
|
||||
(and (not (string= (match-string 1) "/"))
|
||||
(throw 'bail-out t)))
|
||||
((string= (match-string 2) "para")
|
||||
(and
|
||||
(not (string= (match-string 1) "/"))
|
||||
;; don't mess up nested lists
|
||||
(not (and (muse-looking-back "<listitem>")
|
||||
(throw 'bail-out t)))))
|
||||
((string= (match-string 2) "footnote")
|
||||
(string= (match-string 1) "/"))
|
||||
(t nil)))))
|
||||
(when (get-text-property (1- (point)) 'muse-end-list)
|
||||
(goto-char (previous-single-property-change (1- (point))
|
||||
'muse-end-list)))
|
||||
(muse-insert-markup "</para>"))
|
||||
(goto-char end))
|
||||
(cond
|
||||
((eobp)
|
||||
(unless (bolp)
|
||||
(insert "\n")))
|
||||
((get-text-property (point) 'muse-no-paragraph)
|
||||
(forward-char 1)
|
||||
nil)
|
||||
((eq (char-after) ?\<)
|
||||
(when (looking-at (concat "<\\(emphasis\\|systemitem\\|inlinemediaobject"
|
||||
"\\|u?link\\|anchor\\|email\\)[ >]"))
|
||||
(muse-insert-markup "<para>")))
|
||||
(t
|
||||
(muse-insert-markup "<para>")))))
|
||||
|
||||
(defun muse-docbook-get-author (&optional author)
|
||||
"Split the AUTHOR directive into separate fields.
|
||||
AUTHOR should be of the form: \"Firstname Other Names Lastname\",
|
||||
and anything after `Firstname' is optional."
|
||||
(setq author (save-match-data (split-string author)))
|
||||
(let ((num-el (length author)))
|
||||
(cond ((eq num-el 1)
|
||||
(concat "<firstname>" (car author) "</firstname>"))
|
||||
((eq num-el 2)
|
||||
(concat "<firstname>" (nth 0 author) "</firstname>"
|
||||
"<surname>" (nth 1 author) "</surname>"))
|
||||
((eq num-el 3)
|
||||
(concat "<firstname>" (nth 0 author) "</firstname>"
|
||||
"<othername>" (nth 1 author) "</othername>"
|
||||
"<surname>" (nth 2 author) "</surname>"))
|
||||
(t
|
||||
(let (first last)
|
||||
(setq first (car author))
|
||||
(setq author (nreverse (cdr author)))
|
||||
(setq last (car author))
|
||||
(setq author (nreverse (cdr author)))
|
||||
(concat "<firstname>" first "</firstname>"
|
||||
"<othername>"
|
||||
(mapconcat 'identity author " ")
|
||||
"</othername>"
|
||||
"<surname>" last "</surname>"))))))
|
||||
|
||||
(defun muse-docbook-fixup-images ()
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward (concat "<imagedata fileref=\"[^\"]+\""
|
||||
" format=\"\\([^\"]+\\)\" />$")
|
||||
nil t)
|
||||
(replace-match (upcase (match-string 1)) t t nil 1)))
|
||||
|
||||
(defun muse-docbook-fixup-citations ()
|
||||
;; remove the role attribute if there is no role
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "<\\(citation role=\"nil\"\\)>" nil t)
|
||||
(replace-match "citation" t t nil 1))
|
||||
;; replace colons in multi-head citations with semicolons
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "<citation.*>" nil t)
|
||||
(let ((start (point))
|
||||
(end (re-search-forward "</citation>")))
|
||||
(save-restriction
|
||||
(narrow-to-region start end)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "," nil t)
|
||||
(replace-match ";"))))))
|
||||
|
||||
(defun muse-docbook-munge-buffer ()
|
||||
(muse-docbook-fixup-images)
|
||||
(muse-docbook-fixup-citations))
|
||||
|
||||
(defun muse-docbook-entities ()
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "<citation" nil t)
|
||||
(concat
|
||||
" [\n<!ENTITY bibliography SYSTEM \""
|
||||
(if (string-match ".short$" (muse-page-name))
|
||||
(substring (muse-page-name) 0 -6)
|
||||
(muse-page-name))
|
||||
".bib.xml\">\n]")
|
||||
"")))
|
||||
|
||||
(defun muse-docbook-bibliography ()
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "<citation" nil t)
|
||||
"&bibliography;\n"
|
||||
"")))
|
||||
|
||||
(defun muse-docbook-finalize-buffer ()
|
||||
(when (boundp 'buffer-file-coding-system)
|
||||
(when (memq buffer-file-coding-system '(no-conversion undecided-unix))
|
||||
;; make it agree with the default charset
|
||||
(setq buffer-file-coding-system muse-docbook-encoding-default))))
|
||||
|
||||
;;; Register the Muse DocBook XML Publisher
|
||||
|
||||
(muse-define-style "docbook"
|
||||
:suffix 'muse-docbook-extension
|
||||
:regexps 'muse-docbook-markup-regexps
|
||||
:functions 'muse-docbook-markup-functions
|
||||
:strings 'muse-docbook-markup-strings
|
||||
:specials 'muse-xml-decide-specials
|
||||
:before-end 'muse-docbook-munge-buffer
|
||||
:after 'muse-docbook-finalize-buffer
|
||||
:header 'muse-docbook-header
|
||||
:footer 'muse-docbook-footer
|
||||
:browser 'find-file)
|
||||
|
||||
(provide 'muse-docbook)
|
||||
|
||||
;;; muse-docbook.el ends here
|
||||
274
emacs.d/elisp/muse/muse-groff.el
Normal file
274
emacs.d/elisp/muse/muse-groff.el
Normal 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
754
emacs.d/elisp/muse/muse-html.el
Normal 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—%s")
|
||||
(comment-begin . "<!-- ")
|
||||
(comment-end . " -->")
|
||||
(rule . "<hr>")
|
||||
(fn-sep . "<hr>\n")
|
||||
(no-break-space . " ")
|
||||
(line-break . "<br>")
|
||||
(enddots . "....")
|
||||
(dots . "...")
|
||||
(section . "<h2>")
|
||||
(section-end . "</h2>")
|
||||
(subsection . "<h3>")
|
||||
(subsection-end . "</h3>")
|
||||
(subsubsection . "<h4>")
|
||||
(subsubsection-end . "</h4>")
|
||||
(section-other . "<h5>")
|
||||
(section-other-end . "</h5>")
|
||||
(begin-underline . "<u>")
|
||||
(end-underline . "</u>")
|
||||
(begin-literal . "<code>")
|
||||
(end-literal . "</code>")
|
||||
(begin-cite . "<span class=\"citation\">")
|
||||
(begin-cite-author . "<span class=\"citation-author\">")
|
||||
(begin-cite-year . "<span class=\"citation-year\">")
|
||||
(end-cite . "</span>")
|
||||
(begin-emph . "<em>")
|
||||
(end-emph . "</em>")
|
||||
(begin-more-emph . "<strong>")
|
||||
(end-more-emph . "</strong>")
|
||||
(begin-most-emph . "<strong><em>")
|
||||
(end-most-emph . "</em></strong>")
|
||||
(begin-verse . "<p class=\"verse\">\n")
|
||||
(verse-space . " ")
|
||||
(end-verse-line . "<br>")
|
||||
(end-last-stanza-line . "<br>")
|
||||
(empty-verse-line . "<br>")
|
||||
(end-verse . "</p>")
|
||||
(begin-example . "<pre class=\"example\">")
|
||||
(end-example . "</pre>")
|
||||
(begin-center . "<center>\n<p>")
|
||||
(end-center . "</p>\n</center>")
|
||||
(begin-quote . "<blockquote>\n")
|
||||
(end-quote . "\n</blockquote>")
|
||||
(begin-quote-item . "<p class=\"quoted\">")
|
||||
(end-quote-item . "</p>")
|
||||
(begin-uli . "<ul>\n")
|
||||
(end-uli . "\n</ul>")
|
||||
(begin-uli-item . "<li>")
|
||||
(end-uli-item . "</li>")
|
||||
(begin-oli . "<ol>\n")
|
||||
(end-oli . "\n</ol>")
|
||||
(begin-oli-item . "<li>")
|
||||
(end-oli-item . "</li>")
|
||||
(begin-dl . "<dl>\n")
|
||||
(end-dl . "\n</dl>")
|
||||
(begin-ddt . "<dt><strong>")
|
||||
(end-ddt . "</strong></dt>")
|
||||
(begin-dde . "<dd>")
|
||||
(end-dde . "</dd>")
|
||||
(begin-table . "<table%s>\n")
|
||||
(end-table . "</table>")
|
||||
(begin-table-row . " <tr>\n")
|
||||
(end-table-row . " </tr>\n")
|
||||
(begin-table-entry . " <%s>")
|
||||
(end-table-entry . "</%s>\n"))
|
||||
"Strings used for marking up text as HTML.
|
||||
These cover the most basic kinds of markup, the handling of which
|
||||
differs little between the various styles."
|
||||
:type '(alist :key-type symbol :value-type string)
|
||||
:group 'muse-html)
|
||||
|
||||
(defcustom muse-xhtml-markup-strings
|
||||
'((image-with-desc . "<table class=\"image\" width=\"100%%\">
|
||||
<tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\" /></td></tr>
|
||||
<tr><td align=\"center\" class=\"image-caption\">%3%</td></tr>
|
||||
</table>")
|
||||
(image . "<img src=\"%s.%s\" alt=\"\" />")
|
||||
(image-link . "<a class=\"image-link\" href=\"%s\">
|
||||
<img src=\"%s.%s\" alt=\"\" /></a>")
|
||||
(rule . "<hr />")
|
||||
(fn-sep . "<hr />\n")
|
||||
(line-break . "<br />")
|
||||
(begin-underline . "<span style=\"text-decoration: underline;\">")
|
||||
(end-underline . "</span>")
|
||||
(begin-center . "<p style=\"text-align: center;\">\n")
|
||||
(end-center . "\n</p>")
|
||||
(end-verse-line . "<br />")
|
||||
(end-last-stanza-line . "<br />")
|
||||
(empty-verse-line . "<br />"))
|
||||
"Strings used for marking up text as XHTML.
|
||||
These cover the most basic kinds of markup, the handling of which
|
||||
differs little between the various styles.
|
||||
|
||||
If a markup rule is not found here, `muse-html-markup-strings' is
|
||||
searched."
|
||||
:type '(alist :key-type symbol :value-type string)
|
||||
:group 'muse-html)
|
||||
|
||||
(defcustom muse-xhtml1.1-markup-strings
|
||||
'((anchor . "<a id=\"%s\">"))
|
||||
"Strings used for marking up text as XHTML 1.1.
|
||||
These cover the most basic kinds of markup, the handling of which
|
||||
differs little between the various styles.
|
||||
|
||||
If a markup rule is not found here, `muse-xhtml-markup-strings'
|
||||
and `muse-html-markup-strings' are searched."
|
||||
:type '(alist :key-type symbol :value-type string)
|
||||
:group 'muse-html)
|
||||
|
||||
(defcustom muse-html-markup-tags
|
||||
'(("class" t t t muse-html-class-tag)
|
||||
("div" t t t muse-html-div-tag)
|
||||
("src" t t nil muse-html-src-tag))
|
||||
"A list of tag specifications, for specially marking up HTML."
|
||||
:type '(repeat (list (string :tag "Markup tag")
|
||||
(boolean :tag "Expect closing tag" :value t)
|
||||
(boolean :tag "Parse attributes" :value nil)
|
||||
(boolean :tag "Nestable" :value nil)
|
||||
function))
|
||||
:group 'muse-html)
|
||||
|
||||
(defcustom muse-html-meta-http-equiv "Content-Type"
|
||||
"The http-equiv attribute used for the HTML <meta> tag."
|
||||
:type 'string
|
||||
:group 'muse-html)
|
||||
|
||||
(defcustom muse-html-meta-content-type "text/html"
|
||||
"The content type used for the HTML <meta> tag.
|
||||
If you are striving for XHTML 1.1 compliance, you may want to
|
||||
change this to \"application/xhtml+xml\"."
|
||||
:type 'string
|
||||
:group 'muse-html)
|
||||
|
||||
(defcustom muse-html-meta-content-encoding (if (featurep 'mule)
|
||||
'detect
|
||||
"iso-8859-1")
|
||||
"The charset to append to the HTML <meta> tag.
|
||||
If set to the symbol 'detect, use `muse-html-encoding-map' to try
|
||||
and determine the HTML charset from emacs's coding. If set to a
|
||||
string, this string will be used to force a particular charset"
|
||||
:type '(choice string symbol)
|
||||
:group 'muse-html)
|
||||
|
||||
(defcustom muse-html-encoding-default 'iso-8859-1
|
||||
"The default Emacs buffer encoding to use in published files.
|
||||
This will be used if no special characters are found."
|
||||
:type 'symbol
|
||||
:group 'muse-html)
|
||||
|
||||
(defcustom muse-html-charset-default "iso-8859-1"
|
||||
"The default HTML meta charset to use if no translation is found in
|
||||
`muse-html-encoding-map'."
|
||||
:type 'string
|
||||
:group 'muse-html)
|
||||
|
||||
(defcustom muse-html-src-allowed-modes t
|
||||
"Modes that we allow the <src> tag to colorize.
|
||||
If t, permit the <src> tag to colorize any mode.
|
||||
|
||||
If a list of mode names, such as '(\"html\" \"latex\"), and the
|
||||
lang argument to <src> is not in the list, then use fundamental
|
||||
mode instead."
|
||||
:type '(choice (const :tag "Any" t)
|
||||
(repeat (string :tag "Mode")))
|
||||
:group 'muse-html)
|
||||
|
||||
(defun muse-html-insert-anchor (anchor)
|
||||
"Insert an anchor, either around the word at point, or within a tag."
|
||||
(skip-chars-forward (concat muse-regexp-blank "\n"))
|
||||
(if (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>"))
|
||||
(let ((tag (match-string 1)))
|
||||
(goto-char (match-end 0))
|
||||
(muse-insert-markup (muse-markup-text 'anchor anchor))
|
||||
(when muse-html-anchor-on-word
|
||||
(or (and (search-forward (format "</%s>" tag)
|
||||
(muse-line-end-position) t)
|
||||
(goto-char (match-beginning 0)))
|
||||
(forward-word 1)))
|
||||
(muse-insert-markup "</a>"))
|
||||
(muse-insert-markup (muse-markup-text 'anchor anchor))
|
||||
(when muse-html-anchor-on-word
|
||||
(forward-word 1))
|
||||
(muse-insert-markup "</a>\n")))
|
||||
|
||||
(defun muse-html-markup-anchor ()
|
||||
(unless (get-text-property (match-end 1) 'muse-link)
|
||||
(save-match-data
|
||||
(muse-html-insert-anchor (match-string 2)))
|
||||
(match-string 1)))
|
||||
|
||||
(defun muse-html-markup-paragraph ()
|
||||
(let ((end (copy-marker (match-end 0) t)))
|
||||
(goto-char (match-beginning 0))
|
||||
(when (save-excursion
|
||||
(save-match-data
|
||||
(and (not (get-text-property (max (point-min) (1- (point)))
|
||||
'muse-no-paragraph))
|
||||
(re-search-backward "<\\(/?\\)p[ >]" nil t)
|
||||
(not (string-equal (match-string 1) "/")))))
|
||||
(when (get-text-property (1- (point)) 'muse-end-list)
|
||||
(goto-char (previous-single-property-change (1- (point))
|
||||
'muse-end-list)))
|
||||
(muse-insert-markup "</p>"))
|
||||
(goto-char end))
|
||||
(cond
|
||||
((eobp)
|
||||
(unless (bolp)
|
||||
(insert "\n")))
|
||||
((get-text-property (point) 'muse-no-paragraph)
|
||||
(forward-char 1)
|
||||
nil)
|
||||
((eq (char-after) ?\<)
|
||||
(cond
|
||||
((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]")
|
||||
(muse-insert-markup "<p>"))
|
||||
((looking-at "<a ")
|
||||
(if (looking-at "<a[^>\n]+><img")
|
||||
(muse-insert-markup "<p class=\"image-link\">")
|
||||
(muse-insert-markup "<p>")))
|
||||
((looking-at "<img[ >]")
|
||||
(muse-insert-markup "<p class=\"image\">"))
|
||||
(t
|
||||
(forward-char 1)
|
||||
nil)))
|
||||
((muse-looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n")
|
||||
(muse-insert-markup "<p class=\"first\">"))
|
||||
(t
|
||||
(muse-insert-markup "<p>"))))
|
||||
|
||||
(defun muse-html-markup-footnote ()
|
||||
(cond
|
||||
((get-text-property (match-beginning 0) 'muse-link)
|
||||
nil)
|
||||
((= (muse-line-beginning-position) (match-beginning 0))
|
||||
(prog1
|
||||
(let ((text (match-string 1)))
|
||||
(muse-insert-markup
|
||||
(concat "<p class=\"footnote\">"
|
||||
"<a class=\"footnum\" name=\"fn." text
|
||||
"\" href=\"#fnr." text "\">"
|
||||
text ".</a>")))
|
||||
(save-excursion
|
||||
(save-match-data
|
||||
(let* ((beg (goto-char (match-end 0)))
|
||||
(end (and (search-forward "\n\n" nil t)
|
||||
(prog1
|
||||
(copy-marker (match-beginning 0))
|
||||
(goto-char beg)))))
|
||||
(while (re-search-forward (concat "^["
|
||||
muse-regexp-blank
|
||||
"]+\\([^\n]\\)")
|
||||
end t)
|
||||
(replace-match "\\1" t)))))
|
||||
(replace-match "")))
|
||||
(t (let ((text (match-string 1)))
|
||||
(muse-insert-markup
|
||||
(concat "<sup><a class=\"footref\" name=\"fnr." text
|
||||
"\" href=\"#fn." text "\">"
|
||||
text "</a></sup>")))
|
||||
(replace-match ""))))
|
||||
|
||||
(defun muse-html-markup-table ()
|
||||
(muse-xml-markup-table muse-html-table-attributes))
|
||||
|
||||
;; Handling of tags for HTML
|
||||
|
||||
(defun muse-html-strip-links (string)
|
||||
"Remove all HTML links from STRING."
|
||||
(muse-replace-regexp-in-string "\\(<a .*?>\\|</a>\\)" "" string nil t))
|
||||
|
||||
(defun muse-html-insert-contents (depth)
|
||||
"Scan the current document and generate a table of contents at point.
|
||||
DEPTH indicates how many levels of headings to include. The default is 2."
|
||||
(let ((max-depth (or depth 2))
|
||||
(index 1)
|
||||
base contents l end)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward "Page published by Emacs Muse begins here" nil t)
|
||||
(catch 'done
|
||||
(while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
|
||||
(unless (and (get-text-property (point) 'read-only)
|
||||
(not (get-text-property (match-beginning 0)
|
||||
'muse-contents)))
|
||||
(remove-text-properties (match-beginning 0) (match-end 0)
|
||||
'(muse-contents nil))
|
||||
(setq l (1- (string-to-number (match-string 1))))
|
||||
(if (null base)
|
||||
(setq base l)
|
||||
(if (< l base)
|
||||
(throw 'done t)))
|
||||
(when (<= l max-depth)
|
||||
;; escape specials now before copying the text, so that we
|
||||
;; can deal sanely with both emphasis in titles and
|
||||
;; special characters
|
||||
(goto-char (match-end 2))
|
||||
(setq end (point-marker))
|
||||
(muse-publish-escape-specials (match-beginning 2) end
|
||||
nil 'document)
|
||||
(muse-publish-mark-read-only (match-beginning 2) end)
|
||||
(setq contents (cons (cons l (buffer-substring-no-properties
|
||||
(match-beginning 2) end))
|
||||
contents))
|
||||
(set-marker end nil)
|
||||
(goto-char (match-beginning 2))
|
||||
(muse-html-insert-anchor (concat "sec" (int-to-string index)))
|
||||
(setq index (1+ index)))))))
|
||||
(setq index 1 contents (nreverse contents))
|
||||
(let ((depth 1) (sub-open 0) (p (point)))
|
||||
(muse-insert-markup "<div class=\"contents\">\n<dl>\n")
|
||||
(while contents
|
||||
(muse-insert-markup "<dt>\n"
|
||||
"<a href=\"#sec" (int-to-string index) "\">"
|
||||
(muse-html-strip-links (cdar contents))
|
||||
"</a>\n"
|
||||
"</dt>\n")
|
||||
(setq index (1+ index)
|
||||
depth (caar contents)
|
||||
contents (cdr contents))
|
||||
(when contents
|
||||
(cond
|
||||
((< (caar contents) depth)
|
||||
(let ((idx (caar contents)))
|
||||
(while (< idx depth)
|
||||
(muse-insert-markup "</dl>\n</dd>\n")
|
||||
(setq sub-open (1- sub-open)
|
||||
idx (1+ idx)))))
|
||||
((> (caar contents) depth) ; can't jump more than one ahead
|
||||
(muse-insert-markup "<dd>\n<dl>\n")
|
||||
(setq sub-open (1+ sub-open))))))
|
||||
(while (> sub-open 0)
|
||||
(muse-insert-markup "</dl>\n</dd>\n")
|
||||
(setq sub-open (1- sub-open)))
|
||||
(muse-insert-markup "</dl>\n</div>\n")
|
||||
(muse-publish-mark-read-only p (point)))))
|
||||
|
||||
(defun muse-html-denote-headings ()
|
||||
"Place a text property on any headings in the current buffer.
|
||||
This allows the headings to be picked up later on if publishing a
|
||||
table of contents."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward "Page published by Emacs Muse begins here" nil t)
|
||||
(while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
|
||||
(unless (get-text-property (point) 'read-only)
|
||||
(add-text-properties (match-beginning 0) (match-end 0)
|
||||
'(muse-contents t))))))
|
||||
|
||||
(defun muse-html-class-tag (beg end attrs)
|
||||
(let ((name (cdr (assoc "name" attrs))))
|
||||
(when name
|
||||
(goto-char beg)
|
||||
(muse-insert-markup "<span class=\"" name "\">")
|
||||
(save-excursion
|
||||
(goto-char end)
|
||||
(muse-insert-markup "</span>")))))
|
||||
|
||||
(defun muse-html-div-tag (beg end attrs)
|
||||
"Publish a <div> tag for HTML."
|
||||
(let ((id (cdr (assoc "id" attrs)))
|
||||
(style (cdr (assoc "style" attrs))))
|
||||
(when (or id style)
|
||||
(goto-char beg)
|
||||
(if (null id)
|
||||
(muse-insert-markup "<div style=\"" style "\">")
|
||||
(muse-insert-markup "<div id=\"" id "\">"))
|
||||
(save-excursion
|
||||
(goto-char end)
|
||||
(muse-insert-markup "</div>")))))
|
||||
|
||||
(defun muse-html-src-tag (beg end attrs)
|
||||
"Publish the region using htmlize.
|
||||
The language to use may be specified by the \"lang\" attribute.
|
||||
|
||||
Muse will look for a function named LANG-mode, where LANG is the
|
||||
value of the \"lang\" attribute.
|
||||
|
||||
This tag requires htmlize 1.34 or later in order to work."
|
||||
(if (condition-case nil
|
||||
(progn
|
||||
(require 'htmlize)
|
||||
(if (fboundp 'htmlize-region-for-paste)
|
||||
nil
|
||||
(muse-display-warning
|
||||
(concat "The `htmlize-region-for-paste' function was not"
|
||||
" found.\nThis is available in htmlize.el 1.34"
|
||||
" or later."))
|
||||
t))
|
||||
(error nil t))
|
||||
;; if htmlize.el was not found, treat this like an example tag
|
||||
(muse-publish-example-tag beg end)
|
||||
(muse-publish-ensure-block beg end)
|
||||
(let* ((lang (cdr (assoc "lang" attrs)))
|
||||
(mode (or (and (not (eq muse-html-src-allowed-modes t))
|
||||
(not (member lang muse-html-src-allowed-modes))
|
||||
'fundamental-mode)
|
||||
(intern-soft (concat lang "-mode"))))
|
||||
(text (muse-delete-and-extract-region beg end))
|
||||
(htmltext
|
||||
(with-temp-buffer
|
||||
(insert text)
|
||||
(if (functionp mode)
|
||||
(funcall mode)
|
||||
(fundamental-mode))
|
||||
(font-lock-fontify-buffer)
|
||||
;; silence the byte-compiler
|
||||
(when (fboundp 'htmlize-region-for-paste)
|
||||
;; transform the region to HTML
|
||||
(htmlize-region-for-paste (point-min) (point-max))))))
|
||||
(save-restriction
|
||||
(narrow-to-region (point) (point))
|
||||
(insert htmltext)
|
||||
(goto-char (point-min))
|
||||
(re-search-forward "<pre\\([^>]*\\)>\n?" nil t)
|
||||
(replace-match "<pre class=\"src\">")
|
||||
(goto-char (point-max))
|
||||
(muse-publish-mark-read-only (point-min) (point-max))))))
|
||||
|
||||
;; Register the Muse HTML Publisher
|
||||
|
||||
(defun muse-html-browse-file (file)
|
||||
(browse-url (concat "file:" file)))
|
||||
|
||||
(defun muse-html-encoding ()
|
||||
(if (stringp muse-html-meta-content-encoding)
|
||||
muse-html-meta-content-encoding
|
||||
(muse-xml-transform-content-type
|
||||
(or (and (boundp 'buffer-file-coding-system)
|
||||
buffer-file-coding-system)
|
||||
muse-html-encoding-default)
|
||||
muse-html-charset-default)))
|
||||
|
||||
(defun muse-html-prepare-buffer ()
|
||||
(make-local-variable 'muse-html-meta-http-equiv)
|
||||
(set (make-local-variable 'muse-html-meta-content-type)
|
||||
(if (save-match-data
|
||||
(string-match "charset=" muse-html-meta-content-type))
|
||||
muse-html-meta-content-type
|
||||
(concat muse-html-meta-content-type "; charset="
|
||||
(muse-html-encoding)))))
|
||||
|
||||
(defun muse-html-munge-buffer ()
|
||||
(if muse-publish-generate-contents
|
||||
(progn
|
||||
(goto-char (car muse-publish-generate-contents))
|
||||
(muse-html-insert-contents (cdr muse-publish-generate-contents))
|
||||
(setq muse-publish-generate-contents nil))
|
||||
(muse-html-denote-headings)))
|
||||
|
||||
(defun muse-html-finalize-buffer ()
|
||||
(when (and (boundp 'buffer-file-coding-system)
|
||||
(memq buffer-file-coding-system '(no-conversion undecided-unix)))
|
||||
;; make it agree with the default charset
|
||||
(setq buffer-file-coding-system muse-html-encoding-default)))
|
||||
|
||||
;;; Register the Muse HTML and XHTML Publishers
|
||||
|
||||
(muse-define-style "html"
|
||||
:suffix 'muse-html-extension
|
||||
:regexps 'muse-html-markup-regexps
|
||||
:functions 'muse-html-markup-functions
|
||||
:strings 'muse-html-markup-strings
|
||||
:tags 'muse-html-markup-tags
|
||||
:specials 'muse-xml-decide-specials
|
||||
:before 'muse-html-prepare-buffer
|
||||
:before-end 'muse-html-munge-buffer
|
||||
:after 'muse-html-finalize-buffer
|
||||
:header 'muse-html-header
|
||||
:footer 'muse-html-footer
|
||||
:style-sheet 'muse-html-style-sheet
|
||||
:browser 'muse-html-browse-file)
|
||||
|
||||
(muse-derive-style "xhtml" "html"
|
||||
:suffix 'muse-xhtml-extension
|
||||
:strings 'muse-xhtml-markup-strings
|
||||
:header 'muse-xhtml-header
|
||||
:footer 'muse-xhtml-footer
|
||||
:style-sheet 'muse-xhtml-style-sheet)
|
||||
|
||||
;; xhtml1.0 is an alias for xhtml
|
||||
(muse-derive-style "xhtml1.0" "xhtml")
|
||||
|
||||
;; xhtml1.1 has some quirks that need attention from us
|
||||
(muse-derive-style "xhtml1.1" "xhtml"
|
||||
:strings 'muse-xhtml1.1-markup-strings)
|
||||
|
||||
(provide 'muse-html)
|
||||
|
||||
;;; muse-html.el ends here
|
||||
239
emacs.d/elisp/muse/muse-http.el
Normal file
239
emacs.d/elisp/muse/muse-http.el
Normal 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
219
emacs.d/elisp/muse/muse-ikiwiki.el
Normal 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
137
emacs.d/elisp/muse/muse-import-docbook.el
Normal 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
149
emacs.d/elisp/muse/muse-import-latex.el
Normal 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
88
emacs.d/elisp/muse/muse-import-xml.el
Normal 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
194
emacs.d/elisp/muse/muse-ipc.el
Normal 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
774
emacs.d/elisp/muse/muse-journal.el
Normal 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\"> </a>
|
||||
<div class=\"entry-body\">
|
||||
<div class=\"entry-head\">
|
||||
<div class=\"entry-date\">
|
||||
<span class=\"date\">%date%</span>
|
||||
</div>
|
||||
<div class=\"entry-title\">
|
||||
<h2>%title%</h2>
|
||||
</div>
|
||||
</div>
|
||||
<div class=\"entry-text\">
|
||||
<div class=\"entry-qotd\">
|
||||
<p>%qotd%</p>
|
||||
</div>
|
||||
%text%
|
||||
</div>
|
||||
</div>
|
||||
</div>\n\n"
|
||||
"Template used to publish individual journal entries as HTML.
|
||||
This may be text or a filename."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-latex-section
|
||||
"\\section*{%title% \\hfill {\\normalsize %date%}}
|
||||
\\addcontentsline{toc}{chapter}{%title%}"
|
||||
"Template used to publish a LaTeX section."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-latex-subsection
|
||||
"\\subsection*{%title%}
|
||||
\\addcontentsline{toc}{section}{%title%}"
|
||||
"Template used to publish a LaTeX subsection."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-markup-tags
|
||||
'(("qotd" t nil nil muse-journal-qotd-tag))
|
||||
"A list of tag specifications, for specially marking up Journal entries.
|
||||
See `muse-publish-markup-tags' for more info.
|
||||
|
||||
This is used by journal-latex and its related styles, as well as
|
||||
the journal-rss-entry style, which both journal-rdf and
|
||||
journal-rss use."
|
||||
:type '(repeat (list (string :tag "Markup tag")
|
||||
(boolean :tag "Expect closing tag" :value t)
|
||||
(boolean :tag "Parse attributes" :value nil)
|
||||
(boolean :tag "Nestable" :value nil)
|
||||
function))
|
||||
:group 'muse-journal)
|
||||
|
||||
;; FIXME: This doesn't appear to be used.
|
||||
(defun muse-journal-generate-pages ()
|
||||
(let ((output-dir (muse-style-element :path)))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward muse-journal-heading-regexp nil t)
|
||||
(let* ((date (match-string 1))
|
||||
(category (match-string 1))
|
||||
(category-file (concat output-dir category "/index.html"))
|
||||
(heading (match-string 1)))
|
||||
t))))
|
||||
|
||||
(defcustom muse-journal-rdf-extension ".rdf"
|
||||
"Default file extension for publishing RDF (RSS 1.0) files."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rdf-base-url ""
|
||||
"The base URL of the website referenced by the RDF file."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rdf-header
|
||||
"<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
|
||||
xmlns=\"http://purl.org/rss/1.0/\"
|
||||
xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
|
||||
<channel rdf:about=\"<lisp>(concat (muse-style-element :base-url)
|
||||
(muse-publish-link-name))</lisp>\">
|
||||
<title><lisp>(muse-publishing-directive \"title\")</lisp></title>
|
||||
<link><lisp>(concat (muse-style-element :base-url)
|
||||
(concat (muse-page-name)
|
||||
muse-html-extension))</lisp></link>
|
||||
<description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
|
||||
<items>
|
||||
<rdf:Seq>
|
||||
<rdf:li resource=\"<lisp>
|
||||
(concat (muse-style-element :base-url)
|
||||
(concat (muse-page-name)
|
||||
muse-html-extension))</lisp>\"/>
|
||||
</rdf:Seq>
|
||||
</items>
|
||||
</channel>\n"
|
||||
"Header used for publishing RDF (RSS 1.0) files.
|
||||
This may be text or a filename."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rdf-footer
|
||||
"</rdf:RDF>\n"
|
||||
"Footer used for publishing RDF (RSS 1.0) files.
|
||||
This may be text or a filename."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rdf-date-format
|
||||
"%Y-%m-%dT%H:%M:%S"
|
||||
"Date format to use for RDF entries."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rdf-entry-template
|
||||
"\n <item rdf:about=\"%link%#%anchor%\">
|
||||
<title>%title%</title>
|
||||
<description>
|
||||
%desc%
|
||||
</description>
|
||||
<link>%link%#%anchor%</link>
|
||||
<dc:date>%date%</dc:date>
|
||||
<dc:creator>%maintainer%</dc:creator>
|
||||
</item>\n"
|
||||
"Template used to publish individual journal entries as RDF.
|
||||
This may be text or a filename."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rdf-summarize-entries nil
|
||||
"If non-nil, include only summaries in the RDF file, not the full data.
|
||||
|
||||
The default is nil, because this annoys some subscribers."
|
||||
:type 'boolean
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-extension ".xml"
|
||||
"Default file extension for publishing RSS 2.0 files."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-base-url ""
|
||||
"The base URL of the website referenced by the RSS file."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-header
|
||||
"<\?xml version=\"1.0\" encoding=\"<lisp>
|
||||
(muse-html-encoding)</lisp>\"?>
|
||||
<rss version=\"2.0\">
|
||||
<channel>
|
||||
<title><lisp>(muse-publishing-directive \"title\")</lisp></title>
|
||||
<link><lisp>(concat (muse-style-element :base-url)
|
||||
(concat (muse-page-name)
|
||||
muse-html-extension))</lisp></link>
|
||||
<description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
|
||||
<language>en-us</language>
|
||||
<generator>Emacs Muse</generator>\n\n"
|
||||
"Header used for publishing RSS 2.0 files. This may be text or a filename."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-footer
|
||||
"\n\n </channel>
|
||||
</rss>\n"
|
||||
"Footer used for publishing RSS 2.0 files. This may be text or a filename."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-date-format
|
||||
"%a, %d %b %Y %H:%M:%S %Z"
|
||||
"Date format to use for RSS 2.0 entries."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-entry-template
|
||||
"\n <item>
|
||||
<title>%title%</title>
|
||||
<link>%link%#%anchor%</link>
|
||||
<description>%desc%</description>
|
||||
<author><lisp>(muse-publishing-directive \"author\")</lisp></author>
|
||||
<pubDate>%date%</pubDate>
|
||||
<guid>%link%#%anchor%</guid>
|
||||
%enclosure%
|
||||
</item>\n"
|
||||
"Template used to publish individual journal entries as RSS 2.0.
|
||||
This may be text or a filename."
|
||||
:type 'string
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-enclosure-types-alist
|
||||
'(("mp3" . "audio/mpeg"))
|
||||
"File types that are accepted as RSS enclosures.
|
||||
This is an alist that maps file extension to content type.
|
||||
Useful for podcasting."
|
||||
:type '(alist :key-type string :value-type string)
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-summarize-entries nil
|
||||
"If non-nil, include only summaries in the RSS file, not the full data.
|
||||
|
||||
The default is nil, because this annoys some subscribers."
|
||||
:type 'boolean
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-markup-regexps
|
||||
'((10000 muse-explicit-link-regexp 0 "\\2"))
|
||||
"List of markup rules for publishing a Muse journal page to RSS 2.0.
|
||||
For more information on the structure of this list, see
|
||||
`muse-publish-markup-regexps'."
|
||||
:type '(repeat (choice
|
||||
(list :tag "Markup rule"
|
||||
integer
|
||||
(choice regexp symbol)
|
||||
integer
|
||||
(choice string function symbol))
|
||||
function))
|
||||
:group 'muse-journal)
|
||||
|
||||
(defcustom muse-journal-rss-markup-functions
|
||||
'((email . ignore)
|
||||
(link . ignore)
|
||||
(url . ignore))
|
||||
"An alist of style types to custom functions for that kind of text.
|
||||
For more on the structure of this list, see
|
||||
`muse-publish-markup-functions'."
|
||||
:type '(alist :key-type symbol :value-type function)
|
||||
:group 'muse-journal)
|
||||
|
||||
(defun muse-journal-anchorize-title (title)
|
||||
"This strips tags from TITLE, truncates TITLE at begin parenthesis,
|
||||
and escapes any remaining non-alphanumeric characters."
|
||||
(save-match-data
|
||||
(if (string-match "(" title)
|
||||
(setq title (substring title 0 (match-beginning 0))))
|
||||
(if (string-match "<[^>]+>" title)
|
||||
(setq title (replace-match "" nil nil title)))
|
||||
(let (pos code len ch)
|
||||
(while (setq pos (string-match (concat "[^" muse-regexp-alnum "_]")
|
||||
title pos))
|
||||
(setq ch (aref title pos)
|
||||
code (format "%%%02X" (cond ((fboundp 'char-to-ucs)
|
||||
(char-to-ucs ch))
|
||||
((fboundp 'char-to-int)
|
||||
(char-to-int ch))
|
||||
(t ch)))
|
||||
len (length code)
|
||||
title (concat (substring title 0 pos)
|
||||
code
|
||||
(when (< pos (length title))
|
||||
(substring title (1+ pos) nil)))
|
||||
pos (+ len pos)))
|
||||
title)))
|
||||
|
||||
(defun muse-journal-sort-entries (&optional direction)
|
||||
(interactive "P")
|
||||
(sort-subr
|
||||
direction
|
||||
(function
|
||||
(lambda ()
|
||||
(if (re-search-forward "^\\* [0-9]+" nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(goto-char (point-max)))))
|
||||
(function
|
||||
(lambda ()
|
||||
(if (re-search-forward "^\\* [0-9]+" nil t)
|
||||
(goto-char (1- (match-beginning 0)))
|
||||
(goto-char (point-max)))))
|
||||
(function
|
||||
(lambda ()
|
||||
(forward-char 2)))
|
||||
(function
|
||||
(lambda ()
|
||||
(end-of-line)))))
|
||||
|
||||
(defun muse-journal-qotd-tag (beg end)
|
||||
(muse-publish-ensure-block beg end)
|
||||
(muse-insert-markup (muse-markup-text 'begin-quote))
|
||||
(muse-insert-markup (muse-markup-text 'begin-quote-item))
|
||||
(goto-char end)
|
||||
(muse-insert-markup (muse-markup-text 'end-quote-item))
|
||||
(muse-insert-markup (muse-markup-text 'end-quote)))
|
||||
|
||||
(defun muse-journal-html-munge-buffer ()
|
||||
(goto-char (point-min))
|
||||
(let ((heading-regexp muse-journal-html-heading-regexp)
|
||||
(inhibit-read-only t))
|
||||
(while (re-search-forward heading-regexp nil t)
|
||||
(let* ((date (match-string 1))
|
||||
(orig-date date)
|
||||
(title (match-string 2))
|
||||
(clean-title title)
|
||||
datestamp qotd text)
|
||||
(delete-region (match-beginning 0) (match-end 0))
|
||||
(if clean-title
|
||||
(save-match-data
|
||||
(while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title)
|
||||
(setq clean-title (replace-match "" nil nil clean-title)))))
|
||||
(save-match-data
|
||||
(when (and date
|
||||
(string-match
|
||||
(concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?"
|
||||
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
|
||||
(setq datestamp
|
||||
(encode-time
|
||||
0 0 0
|
||||
(string-to-number (match-string 3 date))
|
||||
(string-to-number (match-string 2 date))
|
||||
(string-to-number (match-string 1 date))
|
||||
nil)
|
||||
date (concat (format-time-string
|
||||
muse-journal-date-format datestamp)
|
||||
(substring date (match-end 0))))))
|
||||
(save-restriction
|
||||
(narrow-to-region
|
||||
(point) (if (re-search-forward
|
||||
(concat "\\(^<hr>$\\|"
|
||||
heading-regexp "\\)") nil t)
|
||||
(match-beginning 0)
|
||||
(point-max)))
|
||||
(goto-char (point-max))
|
||||
(while (and (not (bobp))
|
||||
(eq ?\ (char-syntax (char-before))))
|
||||
(delete-char -1))
|
||||
(goto-char (point-min))
|
||||
(while (and (not (eobp))
|
||||
(eq ?\ (char-syntax (char-after))))
|
||||
(delete-char 1))
|
||||
(save-excursion
|
||||
(when (search-forward "<qotd>" nil t)
|
||||
(let ((tag-beg (match-beginning 0))
|
||||
(beg (match-end 0))
|
||||
end)
|
||||
(re-search-forward "</qotd>\n*")
|
||||
(setq end (point-marker))
|
||||
(save-restriction
|
||||
(narrow-to-region beg (match-beginning 0))
|
||||
(muse-publish-escape-specials (point-min) (point-max)
|
||||
nil 'document)
|
||||
(setq qotd (buffer-substring-no-properties
|
||||
(point-min) (point-max))))
|
||||
(delete-region tag-beg end)
|
||||
(set-marker end nil))))
|
||||
(setq text (buffer-string))
|
||||
(delete-region (point-min) (point-max))
|
||||
(let ((entry muse-journal-html-entry-template))
|
||||
(muse-insert-file-or-string entry)
|
||||
(muse-publish-mark-read-only (point-min) (point-max))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%date%" nil t)
|
||||
(remove-text-properties (match-beginning 0) (match-end 0)
|
||||
'(read-only nil rear-nonsticky nil))
|
||||
(replace-match (or date "") nil t))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%title%" nil t)
|
||||
(remove-text-properties (match-beginning 0) (match-end 0)
|
||||
'(read-only nil rear-nonsticky nil))
|
||||
(replace-match (or title " ") nil t))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%anchor%" nil t)
|
||||
(replace-match (muse-journal-anchorize-title
|
||||
(or clean-title orig-date))
|
||||
nil t))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%qotd%" nil t)
|
||||
(save-restriction
|
||||
(narrow-to-region (match-beginning 0) (match-end 0))
|
||||
(delete-region (point-min) (point-max))
|
||||
(when qotd (muse-insert-markup qotd))))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%text%" nil t)
|
||||
(remove-text-properties (match-beginning 0) (match-end 0)
|
||||
'(read-only nil rear-nonsticky nil))
|
||||
(replace-match text nil t))
|
||||
(when (null qotd)
|
||||
(goto-char (point-min))
|
||||
(when (search-forward "<div class=\"entry-qotd\">" nil t)
|
||||
(let ((beg (match-beginning 0)))
|
||||
(re-search-forward "</div>\n*" nil t)
|
||||
(delete-region beg (point))))))))))
|
||||
;; indicate that we are to continue the :before-end processing
|
||||
nil)
|
||||
|
||||
(defun muse-journal-latex-munge-buffer ()
|
||||
(goto-char (point-min))
|
||||
(let ((heading-regexp
|
||||
(concat "^" (regexp-quote (muse-markup-text 'section))
|
||||
muse-journal-heading-regexp
|
||||
(regexp-quote (muse-markup-text 'section-end)) "$"))
|
||||
(inhibit-read-only t))
|
||||
(when (re-search-forward heading-regexp nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(sort-subr nil
|
||||
(function
|
||||
(lambda ()
|
||||
(if (re-search-forward heading-regexp nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(goto-char (point-max)))))
|
||||
(function
|
||||
(lambda ()
|
||||
(if (re-search-forward heading-regexp nil t)
|
||||
(goto-char (1- (match-beginning 0)))
|
||||
(goto-char (point-max)))))
|
||||
(function
|
||||
(lambda ()
|
||||
(forward-char 2)))
|
||||
(function
|
||||
(lambda ()
|
||||
(end-of-line)))))
|
||||
(while (re-search-forward heading-regexp nil t)
|
||||
(let ((date (match-string 1))
|
||||
(title (match-string 2))
|
||||
;; FIXME: Nothing is done with qotd
|
||||
qotd section)
|
||||
(save-match-data
|
||||
(when (and date
|
||||
(string-match
|
||||
(concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
|
||||
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
|
||||
(setq date (encode-time
|
||||
0 0 0
|
||||
(string-to-number (match-string 3 date))
|
||||
(string-to-number (match-string 2 date))
|
||||
(string-to-number (match-string 1 date))
|
||||
nil)
|
||||
date (format-time-string
|
||||
muse-journal-date-format date))))
|
||||
(save-restriction
|
||||
(narrow-to-region (match-beginning 0) (match-end 0))
|
||||
(delete-region (point-min) (point-max))
|
||||
(muse-insert-markup muse-journal-latex-section)
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%title%" nil t)
|
||||
(replace-match (or title "Untitled") nil t))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%date%" nil t)
|
||||
(replace-match (or date "") nil t))))))
|
||||
(goto-char (point-min))
|
||||
(let ((subheading-regexp
|
||||
(concat "^" (regexp-quote (muse-markup-text 'subsection))
|
||||
"\\([^\n}]+\\)"
|
||||
(regexp-quote (muse-markup-text 'subsection-end)) "$"))
|
||||
(inhibit-read-only t))
|
||||
(while (re-search-forward subheading-regexp nil t)
|
||||
(let ((title (match-string 1)))
|
||||
(save-restriction
|
||||
(narrow-to-region (match-beginning 0) (match-end 0))
|
||||
(delete-region (point-min) (point-max))
|
||||
(muse-insert-markup muse-journal-latex-subsection)
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%title%" nil t)
|
||||
(replace-match title nil t))))))
|
||||
;; indicate that we are to continue the :before-end processing
|
||||
nil)
|
||||
|
||||
(defun muse-journal-rss-munge-buffer ()
|
||||
(goto-char (point-min))
|
||||
(let ((heading-regexp muse-journal-rss-heading-regexp)
|
||||
(inhibit-read-only t))
|
||||
(while (re-search-forward heading-regexp nil t)
|
||||
(let* ((date (match-string 1))
|
||||
(orig-date date)
|
||||
(title (match-string 2))
|
||||
;; FIXME: Nothing is done with qotd
|
||||
enclosure qotd desc)
|
||||
(if title
|
||||
(save-match-data
|
||||
(if (string-match muse-explicit-link-regexp title)
|
||||
(setq enclosure (muse-get-link title)
|
||||
title (muse-get-link-desc title)))))
|
||||
(save-match-data
|
||||
(when (and date
|
||||
(string-match
|
||||
(concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
|
||||
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
|
||||
(setq date (encode-time 0 0 0
|
||||
(string-to-number (match-string 3 date))
|
||||
(string-to-number (match-string 2 date))
|
||||
(string-to-number (match-string 1 date))
|
||||
nil)
|
||||
;; make sure that date is in a format that RSS
|
||||
;; readers can handle
|
||||
date (let ((system-time-locale "C"))
|
||||
(format-time-string
|
||||
(muse-style-element :date-format) date)))))
|
||||
(save-restriction
|
||||
(narrow-to-region
|
||||
(match-beginning 0)
|
||||
(if (re-search-forward heading-regexp nil t)
|
||||
(match-beginning 0)
|
||||
(if (re-search-forward "^Footnotes:" nil t)
|
||||
(match-beginning 0)
|
||||
(point-max))))
|
||||
(goto-char (point-min))
|
||||
(delete-region (point) (muse-line-end-position))
|
||||
(re-search-forward "</qotd>\n+" nil t)
|
||||
(while (and (char-after)
|
||||
(eq ?\ (char-syntax (char-after))))
|
||||
(delete-char 1))
|
||||
(let ((beg (point)))
|
||||
(if (muse-style-element :summarize)
|
||||
(progn
|
||||
(forward-sentence 2)
|
||||
(setq desc (concat (buffer-substring beg (point)) "...")))
|
||||
(save-restriction
|
||||
(muse-publish-markup-buffer "rss-entry" "journal-rss-entry")
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "Page published by Emacs Muse" nil t)
|
||||
(goto-char (muse-line-end-position))
|
||||
(muse-display-warning
|
||||
(concat
|
||||
"Cannot find 'Page published by Emacs Muse begins here'.\n"
|
||||
"You will probably need this text in your header."))
|
||||
(goto-char (point-min)))
|
||||
(setq beg (point))
|
||||
(if (re-search-forward "Page published by Emacs Muse" nil t)
|
||||
(goto-char (muse-line-beginning-position))
|
||||
(muse-display-warning
|
||||
(concat
|
||||
"Cannot find 'Page published by Emacs Muse ends here'.\n"
|
||||
"You will probably need this text in your footer."))
|
||||
(goto-char (point-max)))
|
||||
(setq desc (buffer-substring beg (point))))))
|
||||
(unless (string= desc "")
|
||||
(setq desc (concat "<![CDATA[" desc "]]>")))
|
||||
(delete-region (point-min) (point-max))
|
||||
(let ((entry (muse-style-element :entry-template)))
|
||||
(muse-insert-file-or-string entry)
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%date%" nil t)
|
||||
(replace-match (or date "") nil t))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%title%" nil t)
|
||||
(replace-match "")
|
||||
(save-restriction
|
||||
(narrow-to-region (point) (point))
|
||||
(insert (or title "Untitled"))
|
||||
(remove-text-properties (match-beginning 0) (match-end 0)
|
||||
'(read-only nil rear-nonsticky nil))
|
||||
(let ((muse-publishing-current-style (muse-style "html")))
|
||||
(muse-publish-escape-specials (point-min) (point-max)
|
||||
nil 'document))))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%desc%" nil t)
|
||||
(replace-match desc nil t))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%enclosure%" nil t)
|
||||
(replace-match
|
||||
(if (null enclosure)
|
||||
""
|
||||
(save-match-data
|
||||
(format
|
||||
"<enclosure url=\"%s\" %stype=\"%s\"/>"
|
||||
(if (string-match "//" enclosure)
|
||||
enclosure
|
||||
(concat (muse-style-element :base-url)
|
||||
enclosure))
|
||||
(let ((file
|
||||
(expand-file-name enclosure
|
||||
(muse-style-element :path))))
|
||||
(if (file-readable-p file)
|
||||
(format "length=\"%d\" "
|
||||
(nth 7 (file-attributes file)))
|
||||
""))
|
||||
(if (string-match "\\.\\([^.]+\\)$" enclosure)
|
||||
(let* ((ext (match-string 1 enclosure))
|
||||
(type
|
||||
(assoc
|
||||
ext muse-journal-rss-enclosure-types-alist)))
|
||||
(if type
|
||||
(cdr type)
|
||||
"application/octet-stream"))))))
|
||||
nil t))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%link%" nil t)
|
||||
(replace-match
|
||||
(concat (muse-style-element :base-url)
|
||||
(concat (muse-page-name)
|
||||
muse-html-extension))
|
||||
nil t))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%anchor%" nil t)
|
||||
(replace-match
|
||||
(muse-journal-anchorize-title (or title orig-date))
|
||||
nil t))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "%maintainer%" nil t)
|
||||
(replace-match
|
||||
(or (muse-style-element :maintainer)
|
||||
(concat "webmaster@" (system-name)))
|
||||
nil t)))))))
|
||||
;; indicate that we are to continue the :before-end processing
|
||||
nil)
|
||||
|
||||
|
||||
;;; Register the Muse Journal Publishers
|
||||
|
||||
(muse-derive-style "journal-html" "html"
|
||||
:before-end 'muse-journal-html-munge-buffer)
|
||||
|
||||
(muse-derive-style "journal-xhtml" "xhtml"
|
||||
:before-end 'muse-journal-html-munge-buffer)
|
||||
|
||||
(muse-derive-style "journal-latex" "latex"
|
||||
:tags 'muse-journal-markup-tags
|
||||
:before-end 'muse-journal-latex-munge-buffer)
|
||||
|
||||
(muse-derive-style "journal-pdf" "pdf"
|
||||
:tags 'muse-journal-markup-tags
|
||||
:before-end 'muse-journal-latex-munge-buffer)
|
||||
|
||||
(muse-derive-style "journal-book-latex" "book-latex"
|
||||
;;:nochapters
|
||||
:tags 'muse-journal-markup-tags
|
||||
:before-end 'muse-journal-latex-munge-buffer)
|
||||
|
||||
(muse-derive-style "journal-book-pdf" "book-pdf"
|
||||
;;:nochapters
|
||||
:tags 'muse-journal-markup-tags
|
||||
:before-end 'muse-journal-latex-munge-buffer)
|
||||
|
||||
(muse-define-style "journal-rdf"
|
||||
:suffix 'muse-journal-rdf-extension
|
||||
:regexps 'muse-journal-rss-markup-regexps
|
||||
:functions 'muse-journal-rss-markup-functions
|
||||
:before 'muse-journal-rss-munge-buffer
|
||||
:header 'muse-journal-rdf-header
|
||||
:footer 'muse-journal-rdf-footer
|
||||
:date-format 'muse-journal-rdf-date-format
|
||||
:entry-template 'muse-journal-rdf-entry-template
|
||||
:base-url 'muse-journal-rdf-base-url
|
||||
:summarize 'muse-journal-rdf-summarize-entries)
|
||||
|
||||
(muse-define-style "journal-rss"
|
||||
:suffix 'muse-journal-rss-extension
|
||||
:regexps 'muse-journal-rss-markup-regexps
|
||||
:functions 'muse-journal-rss-markup-functions
|
||||
:before 'muse-journal-rss-munge-buffer
|
||||
:header 'muse-journal-rss-header
|
||||
:footer 'muse-journal-rss-footer
|
||||
:date-format 'muse-journal-rss-date-format
|
||||
:entry-template 'muse-journal-rss-entry-template
|
||||
:base-url 'muse-journal-rss-base-url
|
||||
:summarize 'muse-journal-rss-summarize-entries)
|
||||
|
||||
;; Used by `muse-journal-rss-munge-buffer' to mark up individual entries
|
||||
(muse-derive-style "journal-rss-entry" "html"
|
||||
:tags 'muse-journal-markup-tags)
|
||||
|
||||
(provide 'muse-journal)
|
||||
|
||||
;;; muse-journal.el ends here
|
||||
669
emacs.d/elisp/muse/muse-latex.el
Normal file
669
emacs.d/elisp/muse/muse-latex.el
Normal 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
277
emacs.d/elisp/muse/muse-latex2png.el
Normal 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
1013
emacs.d/elisp/muse/muse-mode.el
Normal file
File diff suppressed because it is too large
Load diff
263
emacs.d/elisp/muse/muse-poem.el
Normal file
263
emacs.d/elisp/muse/muse-poem.el
Normal 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
973
emacs.d/elisp/muse/muse-project.el
Normal 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
251
emacs.d/elisp/muse/muse-protocols.el
Normal 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
2193
emacs.d/elisp/muse/muse-publish.el
Normal file
File diff suppressed because it is too large
Load diff
270
emacs.d/elisp/muse/muse-regexps.el
Normal file
270
emacs.d/elisp/muse/muse-regexps.el
Normal 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
346
emacs.d/elisp/muse/muse-texinfo.el
Normal 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
498
emacs.d/elisp/muse/muse-wiki.el
Normal 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
201
emacs.d/elisp/muse/muse-xml-common.el
Normal 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
|
||||
'((?\" . """)
|
||||
(?\< . "<")
|
||||
(?\> . ">")
|
||||
(?\& . "&"))
|
||||
"A table of characters which must be represented specially."
|
||||
:type '(alist :key-type character :value-type string)
|
||||
:group 'muse-xml)
|
||||
|
||||
(defcustom muse-xml-markup-specials-url-extra
|
||||
'((?\" . """)
|
||||
(?\< . "<")
|
||||
(?\> . ">")
|
||||
(?\& . "&")
|
||||
(?\ . "%20")
|
||||
(?\n . "%0D%0A"))
|
||||
"A table of characters which must be represented specially.
|
||||
These are extra characters that are escaped within URLs."
|
||||
:type '(alist :key-type character :value-type string)
|
||||
:group 'muse-xml)
|
||||
|
||||
(defun muse-xml-decide-specials (context)
|
||||
"Determine the specials to escape, depending on CONTEXT."
|
||||
(cond ((memq context '(email url image))
|
||||
'muse-xml-escape-url)
|
||||
((eq context 'url-extra)
|
||||
muse-xml-markup-specials-url-extra)
|
||||
(t muse-xml-markup-specials)))
|
||||
|
||||
(defun muse-xml-escape-url (str)
|
||||
"Convert to character entities any non-alphanumeric characters
|
||||
outside a few punctuation symbols, that risk being misinterpreted
|
||||
if not escaped."
|
||||
(when str
|
||||
(setq str (muse-publish-escape-specials-in-string str 'url-extra))
|
||||
(let (pos code len ch)
|
||||
(save-match-data
|
||||
(while (setq pos (string-match (concat "[^-"
|
||||
muse-regexp-alnum
|
||||
"/:._=@\\?~#%\"\\+<>()&;]")
|
||||
str pos))
|
||||
(setq ch (aref str pos)
|
||||
code (concat "&#" (int-to-string
|
||||
(cond ((fboundp 'char-to-ucs)
|
||||
(char-to-ucs ch))
|
||||
((fboundp 'char-to-int)
|
||||
(char-to-int ch))
|
||||
(t ch)))
|
||||
";")
|
||||
len (length code)
|
||||
str (concat (substring str 0 pos)
|
||||
code
|
||||
(when (< pos (length str))
|
||||
(substring str (1+ pos) nil)))
|
||||
pos (+ len pos)))
|
||||
str))))
|
||||
|
||||
(defun muse-xml-markup-anchor ()
|
||||
(unless (get-text-property (match-end 1) 'muse-link)
|
||||
(let ((text (muse-markup-text 'anchor (match-string 2))))
|
||||
(save-match-data
|
||||
(skip-chars-forward (concat muse-regexp-blank "\n"))
|
||||
(when (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>"))
|
||||
(goto-char (match-end 0)))
|
||||
(muse-insert-markup text)))
|
||||
(match-string 1)))
|
||||
|
||||
(defun muse-xml-sort-table (table)
|
||||
"Sort the given table structure so that it validates properly."
|
||||
;; Note that the decision matrix must have a nil diagonal, or else
|
||||
;; elements with the same type will be reversed with respect to each
|
||||
;; other.
|
||||
(let ((decisions '((nil nil nil) ; body < header, body < footer
|
||||
(t nil t) ; header stays where it is
|
||||
(t nil nil)))) ; footer < header
|
||||
(sort table #'(lambda (l r)
|
||||
(and (integerp (car l)) (integerp (car r))
|
||||
(nth (1- (car r))
|
||||
(nth (1- (car l)) decisions)))))))
|
||||
|
||||
(defun muse-xml-markup-table (&optional attributes)
|
||||
"Publish the matched region into a table.
|
||||
If a string ATTRIBUTES is given, pass it to the markup string begin-table."
|
||||
(let* ((table-info (muse-publish-table-fields (match-beginning 0)
|
||||
(match-end 0)))
|
||||
(row-len (car table-info))
|
||||
(supports-group (not (string= (muse-markup-text 'begin-table-group
|
||||
row-len)
|
||||
"")))
|
||||
(field-list (muse-xml-sort-table (cdr table-info)))
|
||||
last-part)
|
||||
(when table-info
|
||||
(let ((beg (point)))
|
||||
(muse-publish-ensure-block beg))
|
||||
(muse-insert-markup (muse-markup-text 'begin-table (or attributes "")))
|
||||
(muse-insert-markup (muse-markup-text 'begin-table-group row-len))
|
||||
(dolist (fields field-list)
|
||||
(let* ((type (car fields))
|
||||
(part (cond ((eq type 'hline) nil)
|
||||
((= type 1) "tbody")
|
||||
((= type 2) "thead")
|
||||
((= type 3) "tfoot")))
|
||||
(col (cond ((eq type 'hline) nil)
|
||||
((= type 1) "td")
|
||||
((= type 2) "th")
|
||||
((= type 3) "td"))))
|
||||
(setq fields (cdr fields))
|
||||
(unless (and part last-part (string= part last-part))
|
||||
(when last-part
|
||||
(muse-insert-markup " </" last-part ">\n")
|
||||
(when (eq type 'hline)
|
||||
;; horizontal separators are represented by closing
|
||||
;; the current table group and opening a new one
|
||||
(muse-insert-markup (muse-markup-text 'end-table-group))
|
||||
(muse-insert-markup (muse-markup-text 'begin-table-group
|
||||
row-len))))
|
||||
(when part
|
||||
(muse-insert-markup " <" part ">\n"))
|
||||
(setq last-part part))
|
||||
(unless (eq type 'hline)
|
||||
(muse-insert-markup (muse-markup-text 'begin-table-row))
|
||||
(dolist (field fields)
|
||||
(muse-insert-markup (muse-markup-text 'begin-table-entry col))
|
||||
(insert field)
|
||||
(muse-insert-markup (muse-markup-text 'end-table-entry col)))
|
||||
(muse-insert-markup (muse-markup-text 'end-table-row)))))
|
||||
(when last-part
|
||||
(muse-insert-markup " </" last-part ">\n"))
|
||||
(muse-insert-markup (muse-markup-text 'end-table-group))
|
||||
(muse-insert-markup (muse-markup-text 'end-table))
|
||||
(insert ?\n))))
|
||||
|
||||
(defun muse-xml-prepare-buffer ()
|
||||
(set (make-local-variable 'muse-publish-url-transforms)
|
||||
(cons 'muse-xml-escape-string muse-publish-url-transforms)))
|
||||
|
||||
(provide 'muse-xml-common)
|
||||
|
||||
;;; muse-xml-common.el ends here
|
||||
274
emacs.d/elisp/muse/muse-xml.el
Normal file
274
emacs.d/elisp/muse/muse-xml.el
Normal 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 . " ")
|
||||
(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
881
emacs.d/elisp/muse/muse.el
Normal 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
|
||||
Loading…
Reference in a new issue