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

Big emacs cleanup, must be lighter

Browse source
This commit is contained in:
Tom Willemsen 2011-03-17 11:36:56 +01:00
parent 04b349e8e0
commit 82b8ca2809
48 changed files with 2 additions and 23194 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1,9 +1,5 @@
(require 'minimap)
(require 'naquadah-theme)
;(require 'auto-complete-clang)
(require 'muse-mode)
(require 'muse-html)
(require 'muse-project)
(require 'autopair)
(load "autostart.el")

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

@ -22,6 +22,7 @@
(global-font-lock-mode t) ; show syntax highlighting, old
(show-paren-mode t) ; show matching parens
(delete-selection-mode t) ; delete selection upon typing
(autopair-global-mode)
;; Byte-compile elisp files on save
(add-hook 'before-save-hook 'delete-trailing-whitespace)

12
emacs.d/20-auto-complete.el
View file

@ -1,12 +0,0 @@
(require 'auto-complete-config)
(add-to-list 'ac-dictionary-directories "~/.emacs.d/ac-dict")
(ac-config-default)
(global-auto-complete-mode -1)
(add-hook 'emacs-lisp-mode-hook
(lambda()
(auto-complete-mode t)))
(add-hook 'lisp-interaction-mode-hook
(lambda ()
(auto-complete-mode t)))

3
emacs.d/20-autopair.el
View file

@ -1,3 +0,0 @@
(require 'autopair)
(autopair-global-mode)

2
emacs.d/20-flymake.el
View file

@ -1,2 +0,0 @@
(require 'flymake)
(add-hook 'find-file-hook 'flymake-find-file-hook)

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

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

1
emacs.d/auto-complete-clang

@ -1 +0,0 @@
Subproject commit 9db79f4a88e22041c6cc1acfa834bb7ff8bec459

480
emacs.d/elisp/auto-complete-config.el
View file

@ -1,480 +0,0 @@
;;; auto-complete-config.el --- auto-complete additional configuations
;; Copyright (C) 2009, 2010 Tomohiro Matsuyama
;; Author: Tomohiro Matsuyama <m2ym.pub@gmail.com>
;; Keywords: convenience
;; Version: 1.3
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(eval-when-compile
(require 'cl))
(require 'auto-complete)
;;;; Additional sources
;; imenu
(defvar ac-imenu-index nil)
(ac-clear-variable-every-10-minutes 'ac-imenu-index)
(defun ac-imenu-candidates ()
(loop with i = 0
with stack = (progn
(unless (local-variable-p 'ac-imenu-index)
(make-local-variable 'ac-imenu-index))
(or ac-imenu-index
(setq ac-imenu-index
(ignore-errors
(with-no-warnings
(imenu--make-index-alist))))))
with result
while (and stack (or (not (integerp ac-limit))
(< i ac-limit)))
for node = (pop stack)
if (consp node)
do
(let ((car (car node))
(cdr (cdr node)))
(if (consp cdr)
(mapc (lambda (child)
(push child stack))
cdr)
(when (and (stringp car)
(string-match (concat "^" (regexp-quote ac-prefix)) car))
;; Remove extra characters
(if (string-match "^.*\\(()\\|=\\|<>\\)$" car)
(setq car (substring car 0 (match-beginning 1))))
(push car result)
(incf i))))
finally return (nreverse result)))
(ac-define-source imenu
'((depends imenu)
(candidates . ac-imenu-candidates)
(symbol . "s")))
;; gtags
(defface ac-gtags-candidate-face
'((t (:background "lightgray" :foreground "navy")))
"Face for gtags candidate"
:group 'auto-complete)
(defface ac-gtags-selection-face
'((t (:background "navy" :foreground "white")))
"Face for the gtags selected candidate."
:group 'auto-complete)
(defun ac-gtags-candidate ()
(ignore-errors
(split-string (shell-command-to-string (format "global -ci %s" ac-prefix)) "\n")))
(ac-define-source gtags
'((candidates . ac-gtags-candidate)
(candidate-face . ac-gtags-candidate-face)
(selection-face . ac-gtags-selection-face)
(requires . 3)
(symbol . "s")))
;; yasnippet
(defface ac-yasnippet-candidate-face
'((t (:background "sandybrown" :foreground "black")))
"Face for yasnippet candidate."
:group 'auto-complete)
(defface ac-yasnippet-selection-face
'((t (:background "coral3" :foreground "white")))
"Face for the yasnippet selected candidate."
:group 'auto-complete)
(defun ac-yasnippet-table-hash (table)
(cond
((fboundp 'yas/snippet-table-hash)
(yas/snippet-table-hash table))
((fboundp 'yas/table-hash)
(yas/table-hash table))))
(defun ac-yasnippet-table-parent (table)
(cond
((fboundp 'yas/snippet-table-parent)
(yas/snippet-table-parent table))
((fboundp 'yas/table-parent)
(yas/table-parent table))))
(defun ac-yasnippet-candidate-1 (table)
(with-no-warnings
(let ((hashtab (ac-yasnippet-table-hash table))
(parent (ac-yasnippet-table-parent table))
candidates)
(maphash (lambda (key value)
(push key candidates))
hashtab)
(setq candidates (all-completions ac-prefix (nreverse candidates)))
(if parent
(setq candidates
(append candidates (ac-yasnippet-candidate-1 parent))))
candidates)))
(defun ac-yasnippet-candidates ()
(with-no-warnings
(if (fboundp 'yas/get-snippet-tables)
;; >0.6.0
(apply 'append (mapcar 'ac-yasnippet-candidate-1 (yas/get-snippet-tables major-mode)))
(let ((table
(if (fboundp 'yas/snippet-table)
;; <0.6.0
(yas/snippet-table major-mode)
;; 0.6.0
(yas/current-snippet-table))))
(if table
(ac-yasnippet-candidate-1 table))))))
(ac-define-source yasnippet
'((depends yasnippet)
(candidates . ac-yasnippet-candidates)
(action . yas/expand)
(candidate-face . ac-yasnippet-candidate-face)
(selection-face . ac-yasnippet-selection-face)
(symbol . "a")))
;; semantic
(defun ac-semantic-candidates (prefix)
(with-no-warnings
(delete "" ; semantic sometimes returns an empty string
(mapcar 'semantic-tag-name
(ignore-errors
(or (semantic-analyze-possible-completions
(semantic-analyze-current-context))
(senator-find-tag-for-completion prefix)))))))
(ac-define-source semantic
'((available . (or (require 'semantic-ia nil t)
(require 'semantic/ia nil t)))
(candidates . (ac-semantic-candidates ac-prefix))
(prefix . c-dot-ref)
(requires . 0)
(symbol . "m")))
(ac-define-source semantic-raw
'((available . (or (require 'semantic-ia nil t)
(require 'semantic/ia nil t)))
(candidates . (ac-semantic-candidates ac-prefix))
(symbol . "s")))
;; eclim
(defun ac-eclim-candidates ()
(with-no-warnings
(loop for c in (eclim/java-complete)
collect (nth 1 c))))
(ac-define-source eclim
'((candidates . ac-eclim-candidates)
(prefix . c-dot)
(requires . 0)
(symbol . "f")))
;; css
;; Copied from company-css.el
(defconst ac-css-property-alist
;; see http://www.w3.org/TR/CSS21/propidx.html
'(("azimuth" angle "left-side" "far-left" "left" "center-left" "center"
"center-right" "right" "far-right" "right-side" "behind" "leftwards"
"rightwards")
("background" background-color background-image background-repeat
background-attachment background-position)
("background-attachment" "scroll" "fixed")
("background-color" color "transparent")
("background-image" uri "none")
("background-position" percentage length "left" "center" "right" percentage
length "top" "center" "bottom" "left" "center" "right" "top" "center"
"bottom")
("background-repeat" "repeat" "repeat-x" "repeat-y" "no-repeat")
("border" border-width border-style border-color)
("border-bottom" border)
("border-bottom-color" border-color)
("border-bottom-style" border-style)
("border-bottom-width" border-width)
("border-collapse" "collapse" "separate")
("border-color" color "transparent")
("border-left" border)
("border-left-color" border-color)
("border-left-style" border-style)
("border-left-width" border-width)
("border-right" border)
("border-right-color" border-color)
("border-right-style" border-style)
("border-right-width" border-width)
("border-spacing" length length)
("border-style" border-style)
("border-top" border)
("border-top-color" border-color)
("border-top-style" border-style)
("border-top-width" border-width)
("border-width" border-width)
("bottom" length percentage "auto")
("caption-side" "top" "bottom")
("clear" "none" "left" "right" "both")
("clip" shape "auto")
("color" color)
("content" "normal" "none" string uri counter "attr()" "open-quote"
"close-quote" "no-open-quote" "no-close-quote")
("counter-increment" identifier integer "none")
("counter-reset" identifier integer "none")
("cue" cue-before cue-after)
("cue-after" uri "none")
("cue-before" uri "none")
("cursor" uri "*" "auto" "crosshair" "default" "pointer" "move" "e-resize"
"ne-resize" "nw-resize" "n-resize" "se-resize" "sw-resize" "s-resize"
"w-resize" "text" "wait" "help" "progress")
("direction" "ltr" "rtl")
("display" "inline" "block" "list-item" "run-in" "inline-block" "table"
"inline-table" "table-row-group" "table-header-group" "table-footer-group"
"table-row" "table-column-group" "table-column" "table-cell"
"table-caption" "none")
("elevation" angle "below" "level" "above" "higher" "lower")
("empty-cells" "show" "hide")
("float" "left" "right" "none")
("font" font-style font-variant font-weight font-size "/" line-height
font-family "caption" "icon" "menu" "message-box" "small-caption"
"status-bar")
("font-family" family-name generic-family)
("font-size" absolute-size relative-size length percentage)
("font-style" "normal" "italic" "oblique")
("font-variant" "normal" "small-caps")
("font-weight" "normal" "bold" "bolder" "lighter" "100" "200" "300" "400"
"500" "600" "700" "800" "900")
("height" length percentage "auto")
("left" length percentage "auto")
("letter-spacing" "normal" length)
("line-height" "normal" number length percentage)
("list-style" list-style-type list-style-position list-style-image)
("list-style-image" uri "none")
("list-style-position" "inside" "outside")
("list-style-type" "disc" "circle" "square" "decimal" "decimal-leading-zero"
"lower-roman" "upper-roman" "lower-greek" "lower-latin" "upper-latin"
"armenian" "georgian" "lower-alpha" "upper-alpha" "none")
("margin" margin-width)
("margin-bottom" margin-width)
("margin-left" margin-width)
("margin-right" margin-width)
("margin-top" margin-width)
("max-height" length percentage "none")
("max-width" length percentage "none")
("min-height" length percentage)
("min-width" length percentage)
("orphans" integer)
("outline" outline-color outline-style outline-width)
("outline-color" color "invert")
("outline-style" border-style)
("outline-width" border-width)
("overflow" "visible" "hidden" "scroll" "auto")
("padding" padding-width)
("padding-bottom" padding-width)
("padding-left" padding-width)
("padding-right" padding-width)
("padding-top" padding-width)
("page-break-after" "auto" "always" "avoid" "left" "right")
("page-break-before" "auto" "always" "avoid" "left" "right")
("page-break-inside" "avoid" "auto")
("pause" time percentage)
("pause-after" time percentage)
("pause-before" time percentage)
("pitch" frequency "x-low" "low" "medium" "high" "x-high")
("pitch-range" number)
("play-during" uri "mix" "repeat" "auto" "none")
("position" "static" "relative" "absolute" "fixed")
("quotes" string string "none")
("richness" number)
("right" length percentage "auto")
("speak" "normal" "none" "spell-out")
("speak-header" "once" "always")
("speak-numeral" "digits" "continuous")
("speak-punctuation" "code" "none")
("speech-rate" number "x-slow" "slow" "medium" "fast" "x-fast" "faster"
"slower")
("stress" number)
("table-layout" "auto" "fixed")
("text-align" "left" "right" "center" "justify")
("text-decoration" "none" "underline" "overline" "line-through" "blink")
("text-indent" length percentage)
("text-transform" "capitalize" "uppercase" "lowercase" "none")
("top" length percentage "auto")
("unicode-bidi" "normal" "embed" "bidi-override")
("vertical-align" "baseline" "sub" "super" "top" "text-top" "middle"
"bottom" "text-bottom" percentage length)
("visibility" "visible" "hidden" "collapse")
("voice-family" specific-voice generic-voice "*" specific-voice
generic-voice)
("volume" number percentage "silent" "x-soft" "soft" "medium" "loud"
"x-loud")
("white-space" "normal" "pre" "nowrap" "pre-wrap" "pre-line")
("widows" integer)
("width" length percentage "auto")
("word-spacing" "normal" length)
("z-index" "auto" integer))
"A list of CSS properties and their possible values.")
(defconst ac-css-value-classes
'((absolute-size "xx-small" "x-small" "small" "medium" "large" "x-large"
"xx-large")
(border-style "none" "hidden" "dotted" "dashed" "solid" "double" "groove"
"ridge" "inset" "outset")
(color "aqua" "black" "blue" "fuchsia" "gray" "green" "lime" "maroon" "navy"
"olive" "orange" "purple" "red" "silver" "teal" "white" "yellow"
"rgb")
(counter "counter")
(family-name "Courier" "Helvetica" "Times")
(generic-family "serif" "sans-serif" "cursive" "fantasy" "monospace")
(generic-voice "male" "female" "child")
(margin-width "auto") ;; length percentage
(relative-size "larger" "smaller")
(shape "rect")
(uri "url"))
"A list of CSS property value classes and their contents.")
(defconst ac-css-pseudo-classes
'("active" "after" "before" "first" "first-child" "first-letter" "first-line"
"focus" "hover" "lang" "left" "link" "right" "visited")
"Identifiers for CSS pseudo-elements and pseudo-classes.")
(defvar ac-css-property nil
"Current editing property.")
(defun ac-css-prefix ()
(when (save-excursion (re-search-backward "\\_<\\(.+?\\)\\_>\\s *:.*\\=" nil t))
(setq ac-css-property (match-string 1))
(or (ac-prefix-symbol) (point))))
(defun ac-css-property-candidates ()
(or (loop with list = (assoc-default ac-css-property ac-css-property-alist)
with value
while (setq value (pop list))
if (symbolp value)
do (setq list
(append list
(or (assoc-default value ac-css-value-classes)
(assoc-default (symbol-name value) ac-css-property-alist))))
else collect value)
ac-css-pseudo-classes))
(defvar ac-source-css-property
'((candidates . ac-css-property-candidates)
(prefix . ac-css-prefix)
(requires . 0)))
;;;; Not maintained sources
;; ropemacs
(defvar ac-ropemacs-loaded nil)
(defun ac-ropemacs-require ()
(with-no-warnings
(unless ac-ropemacs-loaded
(pymacs-load "ropemacs" "rope-")
(if (boundp 'ropemacs-enable-autoimport)
(setq ropemacs-enable-autoimport t))
(setq ac-ropemacs-loaded t))))
(defun ac-ropemacs-setup ()
(ac-ropemacs-require)
;(setq ac-sources (append (list 'ac-source-ropemacs) ac-sources))
(setq ac-omni-completion-sources '(("\\." ac-source-ropemacs))))
(defun ac-ropemacs-initialize ()
(autoload 'pymacs-apply "pymacs")
(autoload 'pymacs-call "pymacs")
(autoload 'pymacs-eval "pymacs" nil t)
(autoload 'pymacs-exec "pymacs" nil t)
(autoload 'pymacs-load "pymacs" nil t)
(add-hook 'python-mode-hook 'ac-ropemacs-setup)
t)
(defvar ac-ropemacs-completions-cache nil)
(defvar ac-source-ropemacs
'((init
. (lambda ()
(setq ac-ropemacs-completions-cache
(mapcar
(lambda (completion)
(concat ac-prefix completion))
(ignore-errors
(rope-completions))))))
(candidates . ac-ropemacs-completions-cache)))
;; rcodetools
(defvar ac-source-rcodetools
'((init . (lambda ()
(require 'rcodetools)
(condition-case x
(save-excursion
(rct-exec-and-eval rct-complete-command-name "--completion-emacs-icicles"))
(error) (setq rct-method-completion-table nil))))
(candidates . (lambda ()
(all-completions
ac-prefix
(mapcar
(lambda (completion)
(replace-regexp-in-string "\t.*$" "" (car completion)))
rct-method-completion-table))))))
;;;; Default settings
(defun ac-common-setup ()
(add-to-list 'ac-sources 'ac-source-filename))
(defun ac-emacs-lisp-mode-setup ()
(setq ac-sources (append '(ac-source-features ac-source-functions ac-source-yasnippet ac-source-variables ac-source-symbols) ac-sources)))
(defun ac-cc-mode-setup ()
(setq ac-sources (append '(ac-source-yasnippet ac-source-gtags) ac-sources)))
(defun ac-ruby-mode-setup ()
(make-local-variable 'ac-ignores)
(add-to-list 'ac-ignores "end"))
(defun ac-css-mode-setup ()
(setq ac-sources (append '(ac-source-css-property) ac-sources)))
(defun ac-config-default ()
(setq-default ac-sources '(ac-source-abbrev ac-source-dictionary ac-source-words-in-same-mode-buffers))
(add-hook 'emacs-lisp-mode-hook 'ac-emacs-lisp-mode-setup)
(add-hook 'c-mode-common-hook 'ac-cc-mode-setup)
(add-hook 'ruby-mode-hook 'ac-ruby-mode-setup)
(add-hook 'css-mode-hook 'ac-css-mode-setup)
(add-hook 'auto-complete-mode-hook 'ac-common-setup)
(global-auto-complete-mode t))
(provide 'auto-complete-config)
;;; auto-complete-config.el ends here

1897
emacs.d/elisp/auto-complete.el
View file

File diff suppressed because it is too large Load diff

101
emacs.d/elisp/color-theme-gruber-darker.el
View file

@ -1,101 +0,0 @@
;; color-theme-gruber-dark.el
;; Revision 1
;;
;; Copyright (C) 2009-2010 Jason R. Blevins
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use,
;; copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following
;; conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE.
(require 'color-theme)
(defun color-theme-gruber-darker ()
"Gruber Darker color theme for Emacs by Jason Blevins.
A darker variant of the Gruber Dark theme for BBEdit
by John Gruber."
(interactive)
(color-theme-install
'(color-theme-gruber-darker
((foreground-color . "#e4e4ef")
(background-color . "#181818")
(background-mode . dark)
(cursor-color . "#ffdd33")
(mouse-color . "#ffdd33"))
;; Standard font lock faces
(default ((t (nil))))
(font-lock-comment-face ((t (:foreground "#cc8c3c"))))
(font-lock-comment-delimiter-face ((t (:foreground "#cc8c3c"))))
(font-lock-doc-face ((t (:foreground "#73c936"))))
(font-lock-doc-string-face ((t (:foreground "#73c936"))))
(font-lock-string-face ((t (:foreground "#73c936"))))
(font-lock-keyword-face ((t (:foreground "#ffdd33"))))
(font-lock-builtin-face ((t (:foreground "#ffdd33"))))
(font-lock-function-name-face ((t (:foreground "#96a6c8"))))
(font-lock-variable-name-face ((t (:foreground "#f4f4ff"))))
(font-lock-preprocessor-face ((t (:foreground "#95a99f"))))
(font-lock-constant-face ((t (:foreground "#95a99f"))))
(font-lock-type-face ((t (:foreground "#95a99f"))))
(font-lock-warning-face ((t (:foreground "#f43841"))))
(font-lock-reference-face ((t (:foreground "#95a99f"))))
(trailing-whitespace ((t (:foreground "#000" :background "#f43841"))))
(link ((t (:foreground "#96A6C8" :underline t))))
;; Search
(isearch ((t (:foreground "#000" :background "#f5f5f5"))))
(isearch-lazy-highlight-face ((t (:foreground "#f4f4ff" :background "#5f627f"))))
(isearch-fail ((t (:foreground "#000" :background "#f43841"))))
;; User interface
(fringe ((t (:background "#111" :foreground "#444"))))
(border ((t (:background "#111" :foreground "#444"))))
(mode-line ((t (:background "#453d41" :foreground "#fff"))))
(mode-line-buffer-id ((t (:background "#453d41" :foreground "#fff"))))
(mode-line-inactive ((t (:background "#453d41" :foreground "#999"))))
(minibuffer-prompt ((t (:foreground "#96A6C8"))))
(region ((t (:background "#484848"))))
(secondary-selection ((t (:background "#484951" :foreground "#F4F4FF"))))
(tooltip ((t (:background "#52494e" :foreground "#fff"))))
;; Parenthesis matching
(show-paren-match-face ((t (:background "#52494e" :foreground "#f4f4ff"))))
(show-paren-mismatch-face ((t (:foreground "#f4f4ff" :background "#c73c3f"))))
;; Line highlighting
(highlight ((t (:background "#282828" :foreground nil))))
(highlight-current-line-face ((t (:background "#282828" :foreground nil))))
;; Calendar
(holiday-face ((t (:foreground "#f43841"))))
;; Info
(info-xref ((t (:foreground "#96a6c8"))))
(info-visited ((t (:foreground "#9e95c7"))))
;; AUCTeX
(font-latex-sectioning-5-face ((t (:foreground "#96a6c8" :bold t))))
(font-latex-bold-face ((t (:foreground "#95a99f" :bold t))))
(font-latex-italic-face ((t (:foreground "#95a99f" :italic t))))
(font-latex-math-face ((t (:foreground "#73c936"))))
(font-latex-string-face ((t (:foreground "#73c936"))))
(font-latex-warning-face ((t (:foreground "#f43841"))))
(font-latex-slide-title-face ((t (:foreground "#96a6c8"))))
)))
(provide 'color-theme-gruber-darker)

18
emacs.d/elisp/color-theme-vibrant-ink.el
View file

@ -1,18 +0,0 @@
(require 'color-theme)
;; vibrant-ink color theme
(defun color-theme-vibrant-ink ()
(interactive)
(color-theme-install
'(color-theme-ryrobes
((background-color . "#000000")
(background-mode . dark)
(border-color . "#000000")
(cursor-color . "#FFFFFF")
(foreground-color . "#FFFFFF")
(mouse-color . "#FFFFFF"))
(font-lock-comment-face ((t (:foreground "#9933CC" :italic t))))
(font-lock-keyword-face ((t (:foreground "#FF6600"))))
(font-lock-type-face ((t (:foreground "#FFCC00"))))
(font-lock-string-face ((t (:foreground "#66FF00")))))))
(provide 'color-theme-vibrant-ink)

74
emacs.d/elisp/color-theme-weirdness.el
View file

@ -1,74 +0,0 @@
(require 'color-theme)
;; weirdness color-theme
(defun color-theme-weirdness ()
(interactive)
(color-theme-install
'(color-theme-weirdness
((background-color . "#000000")
(background-mode . dark)
(border-color . "#000000")
(cursor-color . "#FFFFFF")
(foreground-color . "#FFFFFF")
(mouse-color . "#000000"))
(org-level-1 ((t (:foreground "#5BFD5B" :weight normal))))
(org-level-2 ((t (:foreground "#379A37" :weight normal))))
(org-level-3 ((t (:foreground "#757575" :weight normal))))
(org-level-4 ((t (:foreground "#778899" :weight normal))))
(org-level-5 ((t (:foreground "#9898FF" :weight normal))))
(org-level-6 ((t (:foreground "#0000B0" :weight normal))))
(org-level-7 ((t (:foreground "#740091" :weight normal))))
(org-level-8 ((t (:foreground "#B275C1" :weight normal))))
(fringe ((t (:background "#000000"))))
(mode-line ((t (:foreground "#B3B3B3" :background "#43527A" :background "#000000" :box nil))))
(region ((t (:background "#3D3D3D"))))
(minibuffer-prompt ((t (:foreground "#72F3FF" :bold t))))
(flymake-warnline ((t (:background "#000060"))))
(flymake-errline ((t (:background "#600000"))))
(font-lock-builtin-face ((t (:foreground "#C436C4"))))
(font-lock-comment-face ((t (:foreground "#00AC00" :background "#004000" :bold t :box (:line-width 1 :color "#006000" :style nil)))))
(font-lock-comment-delimiter-face ((t (:inherit 'font-lock-comment-face))))
(font-lock-function-name-face ((t (:foreground "#0FFF28"))))
(font-lock-keyword-face ((t (:foreground "#4E61BB" :bold t))))
(font-lock-string-face ((t (:foreground "#E00900"))))
(font-lock-type-face ((t (:foreground "#8522DD"))))
(font-lock-variable-name-face ((t (:foreground "#18EFF2"))))
(font-lock-warning-face ((t (:foreground "#FF0000" :bold t)))))))
;; weirdnes color-theme 2
;; thinking of improving it.
(defun color-theme-weirdness2 ()
(interactive)
(color-theme-install
'(color-theme-weirdness
((background-color . "#000000")
(background-mode . dark)
(border-color . "#000000")
(cursor-color . "#FFFFFF")
(foreground-color . "#FFFFFF")
(mouse-color . "#000000"))
(org-level-1 ((t (:foreground "#5BFD5B" :weight normal))))
(org-level-2 ((t (:foreground "#379A37" :weight normal))))
(org-level-3 ((t (:foreground "#757575" :weight normal))))
(org-level-4 ((t (:foreground "#778899" :weight normal))))
(org-level-5 ((t (:foreground "#9898FF" :weight normal))))
(org-level-6 ((t (:foreground "#0000B0" :weight normal))))
(org-level-7 ((t (:foreground "#740091" :weight normal))))
(org-level-8 ((t (:foreground "#B275C1" :weight normal))))
(fringe ((t (:background "#000000"))))
(mode-line ((t (:foreground "#B3B3B3" :background "#43527A" :background "#000000" :box nil))))
(region ((t (:background "#3D3D3D"))))
(minibuffer-prompt ((t (:foreground "#72F3FF" :bold t))))
(flymake-warnline ((t (:background "#000060"))))
(flymake-errline ((t (:background "#600000"))))
(font-lock-builtin-face ((t (:foreground "#C436C4"))))
(font-lock-comment-face ((t (:foreground "#00AC00" :background "#004000" :bold t :box (:line-width 1 :color "#006000" :style nil)))))
(font-lock-comment-delimiter-face ((t (:inherit 'font-lock-comment-face))))
(font-lock-function-name-face ((t (:foreground "#8522DD"))))
(font-lock-keyword-face ((t (:foreground "royal blue"))))
(font-lock-string-face ((t (:foreground "#E00900"))))
(font-lock-type-face ((t (:foreground "#FF9800"))))
(font-lock-variable-name-face ((t (:foreground "#18EFF2"))))
(font-lock-warning-face ((t (:foreground "#FF0000" :bold t)))))))
(provide 'color-theme-weirdness)

1668
emacs.d/elisp/color-theme.el
View file

File diff suppressed because it is too large Load diff

40
emacs.d/elisp/manage-org.el
View file

@ -1,40 +0,0 @@
(defun clone-org-files ()
(interactive)
(if (= (shell-command
"git clone git@82.170.172.156:private/org.git ~/prj/org"
"*Messages*" "*Messages*") 0)
(message "success!")
(message "failed!")))
(defun get-org-files ()
(interactive)
(let ((prev-dir (getenv "PWD")))
(if (= (shell-command
(format "cd ~/prj/org/; git pull origin master; cd %s" prev-dir)
"*Messages*" "*Messages*") 0)
(message "success!")
(message "failed!"))))
(defun save-org-files ()
(interactive)
(let ((prev-dir (getenv "PWD")))
(if (= (shell-command
(format
"cd ~/prj/org/; git add .; git commit -m \"Change for %s\"; cd %s"
(format-time-string "%Y-%m-%d at %H:%M:%S")
prev-dir)
"*Messages*" "*Messages*") 0)
(message "success!")
(message "failed!"))))
(defun push-org-files ()
(interactive)
(let ((prev-dir (getenv "PWD")))
(if (= (shell-command
(format
"cd ~/prj/org/; git push origin master; cd %s" prev-dir)
"*Messages*" "*Messages*") 0)
(message "success!")
(message "failed!"))))
(provide 'manage-org)

630
emacs.d/elisp/minimap.el
View file

@ -1,630 +0,0 @@
;;; minimap.el --- Minimap sidebar for Emacs
;; Copyright (C) 2009, 2010 David Engster
;; Author: David Engster <dengste@eml.cc>
;; Keywords:
;; Version: 0.7
;; This file is NOT part of GNU Emacs.
;; 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file is an implementation of a minimap sidebar, i.e., a
;; smaller display of the current buffer on the left side. It
;; highlights the currently shown region and updates its position
;; automatically. You can navigate in the minibar by dragging the
;; active region with the mouse, which will scroll the corresponding
;; edit buffer.
;; Usage:
;; * Put minimap.el in your load path.
;; * (require 'minimap)
;; * Use 'M-x minimap-create' in a buffer you're currently editing.
;; * Use 'M-x minimap-kill' to kill the minimap.
;; * Use 'M-x customize-group RET minimap RET' to adapt minimap to your needs.
;; Download:
;; You can always get the latest version from the git repository:
;; git://randomsample.de/minimap.git
;; or http://randomsample.de/minimap.git
;;; KNOWN BUGS:
;; * Currently cannot deal with images.
;; * Display/movement can be a bit erratic at times.
;;; TODO:
;; * Fix known bugs.
;; * Make sidebar permanently visible. This requires something like a
;; 'window group' feature in Emacs, which is currently being worked on.
;; * Moving the active region with the keyboard / mouse-wheel ?
;;; Customizable variables:
(defgroup minimap nil
"A minimap sidebar for Emacs."
:group 'convenience)
(defface minimap-font-face
'((default :family "DejaVu Sans Mono" :height 30))
"Face used for text in minimap buffer, notably the font family and height.
This height should be really small. You probably want to use a
TrueType font for this. After changing this, you should
recreate the minimap to avoid problems with recentering."
:group 'minimap)
(defface minimap-active-region-background
'((((background dark)) (:background "#4517305D0000"))
(t (:background "#C847D8FEFFFF")))
"Face for the active region in the minimap.
By default, this is only a different background color."
:group 'minimap)
(defface minimap-semantic-function-face
'((((background dark))
(:box (:line-width 1 :color "white")
:inherit (font-lock-function-name-face minimap-font-face)
:height 2.5 :background "gray10"))
(t (:box (:line-width 1 :color "black")
:inherit (font-lock-function-name-face minimap-font-face)
:height 2.5 :background "gray90")))
"Face used for functions in the semantic overlay.")
(defface minimap-semantic-variable-face
'((((background dark))
(:box (:line-width 1 :color "white")
:inherit (font-lock-variable-name-face minimap-font-face)
:height 2.5 :background "gray10"))
(t (:box (:line-width 1 :color "black")
:inherit (font-lock-function-name-face minimap-font-face)
:height 2.5 :background "gray90")))
"Face used for variables in the semantic overlay.")
(defface minimap-semantic-type-face
'((((background dark))
(:box (:line-width 1 :color "white")
:inherit (font-lock-type-face minimap-font-face)
:height 2.5 :background "gray10"))
(t (:box (:line-width 1 :color "black")
:inherit (font-lock-function-name-face minimap-font-face)
:height 2.5 :background "gray90")))
"Face used for types in the semantic overlay.")
(defcustom minimap-width-fraction 0.2
"Fraction of width which should be used for minimap sidebar."
:type 'number
:group 'minimap)
(defcustom minimap-window-location 'left
"Location of the minimap window.
Can be either the symbol `left' or `right'."
:type '(choice (const :tag "Left" left)
(const :tag "Right" right))
:group 'minimap)
(defcustom minimap-buffer-name-prefix "*MINIMAP* "
"Prefix for buffer names of minimap sidebar."
:type 'string
:group 'minimap)
(defcustom minimap-update-delay 0.2
"Delay in seconds after which sidebar gets updated.
Setting this to 0 will let the minimap react immediately, but
this will slow down scrolling."
:type 'number
:set (lambda (sym value)
(set sym value)
(when (and (boundp 'minimap-timer-object)
minimap-timer-object)
(cancel-timer minimap-timer-object)
(setq minimap-timer-object
(run-with-idle-timer
minimap-update-delay t 'minimap-update))))
:group 'minimap)
(defcustom minimap-always-recenter nil
"Whether minimap sidebar should be recentered after every point movement."
:type 'boolean
:group 'minimap)
(defcustom minimap-recenter-type 'relative
"Specifies the type of recentering the minimap should use.
The minimap can use different types of recentering, i.e., how the
minimap should behave when you scroll in the main window or when
you drag the active region with the mouse. The following
explanations will probably not help much, so simply try them and
choose the one which suits you best.
`relative' -- The position of the active region in the minimap
corresponds with the relative position of this region in the
buffer. This the default.
`middle' -- The active region will stay fixed in the middle of
the minimap.
`free' -- The position will be more or less free. When dragging
the active region, the minimap will scroll when you reach the
bottom or top."
:type '(choice (const :tag "Relative" relative)
(const :tag "Middle" middle)
(const :tag "Free" free))
:group 'minimap)
(defcustom minimap-hide-scroll-bar t
"Whether the minimap should hide the vertical scrollbar."
:type 'boolean
:group 'minimap)
(defcustom minimap-hide-fringes t
"Whether the minimap should hide the fringes."
:type 'boolean
:group 'minimap)
(defcustom minimap-dedicated-window nil
"Whether the minimap should create a dedicated window."
:type 'boolean
:group 'minimap)
(defcustom minimap-display-semantic-overlays t
"Display overlays from CEDET's semantic analyzer.
If you use CEDET and the buffer's major-mode is supported, the
minimap can display overlays generated by the semantic analyzer.
By default, it will apply the faces `minimap-semantic-<X>-face',
with <X> being \"function\", \"variable\" and \"type\". Also, it
will display the name of the tag in the middle of the overlay in
the corresponding font-lock face.
See also `minimap-enlarge-certain-faces', which can be used as
fallback."
:type 'boolean
:group 'minimap)
(defcustom minimap-enlarge-certain-faces 'as-fallback
"Whether certain faces should be enlarged in the minimap.
All faces listed in `minimap-normal-height-faces' will be
displayed using the default font height, allowing you to still
read text using those faces. By default, this should enlarge all
function names in the minimap, given you have font locking
enabled. This variable can have the following values:
'as-fallback (the default) -- The feature will only be activated
if information from CEDET's semantic analyzer isn't available
(see: `minimap-display-semantic-overlays').
'always -- Always active.
nil -- Inactive."
:type '(choice (const :tag "Fallback if CEDET unavailable." 'as-fallback)
(const :tag "Always active." 'always)
(const :tag "Inactive." nil))
:group 'minimap)
(defcustom minimap-normal-height-faces '(font-lock-function-name-face)
"List of faces which should be displayed with normal height.
When `minimap-enlarge-certain-faces' is non-nil, all faces in
this list will be displayed using the default font height. By
default, this list contains `font-lock-function-name-face', so
you can still read function names in the minimap."
:type '(repeat face)
:group 'minimap)
(defcustom minimap-sync-overlay-properties '(face invisible)
"Specifies which overlay properties should be synced.
Unlike text properties, overlays are not applied automatically to
the minimap and must be explicitly synced. This variable
specifies which overlay properties should be synced by
`minimap-sync-overlays'. Most importantly, this variable should
include 'invisible', so that hidden text does not appear in the
minimap buffer."
:type '(repeat symbol)
:group 'minimap)
;;; Internal variables
(defvar minimap-start nil)
(defvar minimap-end nil)
(defvar minimap-active-overlay nil)
(defvar minimap-bufname nil)
(defvar minimap-timer-object nil)
(defvar minimap-active-minimaps 0)
(defvar minimap-base-overlay nil)
(defvar minimap-numlines nil)
(defvar minimap-pointmin-overlay nil)
(make-variable-buffer-local 'minimap-start)
(make-variable-buffer-local 'minimap-end)
(make-variable-buffer-local 'minimap-active-overlay)
(make-variable-buffer-local 'minimap-bufname)
(make-variable-buffer-local 'minimap-base-overlay)
(make-variable-buffer-local 'minimap-numlines)
(make-variable-buffer-local 'minimap-pointmin-overlay)
;;; Minimap creation / killing
;;;###autoload
(defun minimap-create ()
"Create a minimap sidebar for the current window."
(interactive)
;; If minimap is visible, do nothing.
(unless (and minimap-bufname
(get-buffer minimap-bufname)
(get-buffer-window (get-buffer minimap-bufname)))
(let ((bufname (concat minimap-buffer-name-prefix
(buffer-name (current-buffer))))
(new-win (if (eq minimap-window-location 'left)
(split-window-horizontally
(round (* (window-width)
minimap-width-fraction)))
(split-window-horizontally
(round (* (window-width)
(- 1 minimap-width-fraction))))
(other-window 1))))
;; If minimap exists but isn't visible, reuse it.
(if (and minimap-bufname
(get-buffer minimap-bufname))
(switch-to-buffer minimap-bufname t)
;; Otherwise create new minimap
(minimap-new-minimap bufname)
;; If this is the first minimap, create the idle timer.
(when (zerop minimap-active-minimaps)
(setq minimap-timer-object
(run-with-idle-timer minimap-update-delay t 'minimap-update)))
(setq minimap-active-minimaps
(1+ minimap-active-minimaps))))
(other-window 1)
(minimap-sync-overlays)))
(defun minimap-new-minimap (bufname)
"Create new minimap BUFNAME for current buffer and window."
(let ((indbuf (make-indirect-buffer (current-buffer) bufname t))
(edges (window-pixel-edges)))
(setq minimap-bufname bufname)
(set-buffer indbuf)
(when minimap-hide-scroll-bar
(setq vertical-scroll-bar nil))
(switch-to-buffer indbuf)
(setq minimap-base-overlay (make-overlay (point-min) (point-max) nil t t))
(overlay-put minimap-base-overlay 'face 'minimap-font-face)
(overlay-put minimap-base-overlay 'priority 1)
(setq minimap-pointmin-overlay (make-overlay (point-min) (1+ (point-min))))
(setq minimap-start (window-start)
minimap-end (window-end)
minimap-active-overlay (make-overlay minimap-start minimap-end)
line-spacing 0)
(overlay-put minimap-active-overlay 'face
'minimap-active-region-background)
(overlay-put minimap-active-overlay 'priority 5)
(minimap-mode 1)
(when (and (boundp 'linum-mode)
linum-mode)
(linum-mode 0))
(when minimap-hide-fringes
(set-window-fringes nil 0 0))
(when minimap-dedicated-window
(set-window-dedicated-p nil t))
(setq buffer-read-only t)
;; Calculate the actual number of lines displayable with the minimap face.
(setq minimap-numlines
(floor
(/
(- (nth 3 edges) (nth 1 edges))
(car (progn (redisplay) (window-line-height))))))))
;;;###autoload
(defun minimap-kill ()
"Kill minimap for current buffer.
Cancel the idle timer if no more minimaps are active."
(interactive)
(if (null minimap-bufname)
(message "No minimap associated with %s." (buffer-name (current-buffer)))
(let ((curname (buffer-name (current-buffer)))
(buf (get-buffer minimap-bufname))
(win (get-buffer-window minimap-bufname)))
(setq minimap-bufname nil)
(if (null buf)
(message "No minimap associated with %s." curname)
(when win
(delete-window win))
(kill-buffer buf)
(when (zerop
(setq minimap-active-minimaps
(1- minimap-active-minimaps)))
(cancel-timer minimap-timer-object)
(setq minimap-timer-object nil))
(message "Minimap for %s killed." curname)))))
;;; Minimap update
(defun minimap-update (&optional force)
"Update minimap sidebar if necessary.
This is meant to be called from the idle-timer or the post command hook.
When FORCE, enforce update of the active region."
(when minimap-bufname
(let ((win (get-buffer-window minimap-bufname))
start end pt ov)
(when win
(setq start (window-start)
end (window-end)
pt (point)
ov)
(with-selected-window win
(unless (and (not force)
(= minimap-start start)
(= minimap-end end))
(move-overlay minimap-active-overlay start end)
(setq minimap-start start
minimap-end end)
(minimap-recenter (line-number-at-pos (/ (+ end start) 2))
(/ (- (line-number-at-pos end)
(line-number-at-pos start))
2)))
(goto-char pt)
(when minimap-always-recenter
(recenter (round (/ (window-height) 2)))))))))
;;; Overlay movement
(defun minimap-move-overlay-mouse (start-event)
"Move overlay by tracking mouse movement."
(interactive "e")
(mouse-set-point start-event)
(when (get-buffer-window (buffer-base-buffer (current-buffer)))
(let* ((echo-keystrokes 0)
(end-posn (event-end start-event))
(start-point (posn-point end-posn))
(make-cursor-line-fully-visible nil)
(cursor-type nil)
(pcselmode pc-selection-mode)
pt ev)
(when pcselmode
(pc-selection-mode -1))
(move-overlay minimap-active-overlay start-point minimap-end)
(track-mouse
(minimap-set-overlay start-point)
(while (and
(consp (setq ev (read-event)))
(eq (car ev) 'mouse-movement))
(setq pt (posn-point (event-start ev)))
(when (numberp pt)
(minimap-set-overlay pt))))
(select-window (get-buffer-window (buffer-base-buffer)))
(minimap-update)
(when pcselmode
(pc-selection-mode 1)))))
(defun minimap-set-overlay (pt)
"Set overlay position, with PT being the middle."
(goto-char pt)
(let* ((ovstartline (line-number-at-pos minimap-start))
(ovendline (line-number-at-pos minimap-end))
(ovheight (round (/ (- ovendline ovstartline) 2)))
(line (line-number-at-pos))
(winstart (window-start))
(winend (window-end))
newstart newend)
(setq pt (point-at-bol))
(setq newstart (minimap-line-to-pos (- line ovheight)))
;; Perform recentering
(minimap-recenter line ovheight)
;; Set new position in main buffer and redisplay
(with-selected-window (get-buffer-window (buffer-base-buffer))
(goto-char pt)
(set-window-start nil newstart)
(redisplay t)
(setq newend (window-end)))
(when (eq minimap-recenter-type 'free)
(while (> newend winend)
(scroll-up 5)
(redisplay t)
(setq winend (window-end))))
(move-overlay minimap-active-overlay newstart newend)))
(defun minimap-line-to-pos (line)
"Return point position of line number LINE."
(save-excursion
(goto-char 1)
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))
(point)))
(defun minimap-recenter (middle height)
"Recenter the minimap according to `minimap-recenter-type'.
MIDDLE is the line number in the middle of the active region.
HEIGHT is the number of lines from MIDDLE to begin/end of the
active region."
(cond
;; Relative recentering
((eq minimap-recenter-type 'relative)
(let* ((maxlines (line-number-at-pos (point-max)))
percentage relpos newline start numlines)
(setq numlines (count-lines (window-start) (window-end)))
(setq percentage (/ (float middle) (float maxlines)))
(setq newline (ceiling (* percentage numlines)))
(setq start (minimap-line-to-pos
(- middle height
(floor (* percentage
(- numlines height height))))))
(or (> start (point-min))
(setq start (point-min)))
;; If (point-max) already visible, don't go further
(if (and (> start (window-start))
(with-selected-window (get-buffer-window (buffer-base-buffer))
(= (point-max) (window-end))))
(save-excursion
(goto-char (point-max))
(recenter -1))
(unless (and (> start (window-start))
(= (point-max) (window-end)))
(set-window-start nil start)))))
;; Middle recentering
((eq minimap-recenter-type 'middle)
(let ((start (- middle height
(floor (* 0.5
(- minimap-numlines height height))))))
(if (< start 1)
(progn
;; Hack: Emacs cannot scroll down any further, so we fake
;; it using an overlay. Otherwise, the active region
;; would move to the top.
(overlay-put minimap-pointmin-overlay
'display (concat
(make-string (abs start) 10)
(buffer-substring (point-min) (1+ (point-min)))))
(overlay-put minimap-pointmin-overlay
'face `(:background ,(face-background 'default)))
(overlay-put minimap-pointmin-overlay
'priority 10)
(setq start 1))
(overlay-put minimap-pointmin-overlay 'display "")
(overlay-put minimap-pointmin-overlay 'face nil))
(set-window-start nil (minimap-line-to-pos start))))
;; Free recentering
((eq minimap-recenter-type 'free)
(let ((newstart (minimap-line-to-pos (- middle height)))
(winstart (window-start)))
(while (< newstart winstart)
(scroll-down 5)
(redisplay t)
(setq winstart (window-start)))))))
;;; Minimap minor mode
(defvar minimap-mode-map (make-sparse-keymap)
"Keymap used by `minimap-mode'.")
(define-key minimap-mode-map [down-mouse-1] 'minimap-move-overlay-mouse)
(define-key minimap-mode-map [down-mouse-2] 'minimap-move-overlay-mouse)
(define-key minimap-mode-map [down-mouse-3] 'minimap-move-overlay-mouse)
(define-minor-mode minimap-mode
"Minor mode for minimap sidebar."
nil "minimap" minimap-mode-map)
;;; Sync minimap with modes which create/delete overlays.
(defun minimap-sync-overlays ()
"Synchronize overlays between base and minimap buffer.
Apply semantic overlays or face enlargement if necessary."
(interactive)
(when minimap-bufname
(let ((baseov (overlays-in (point-min) (point-max)))
(semantic (and (boundp 'semantic-version)
(semantic-active-p)))
ov props p)
(with-current-buffer minimap-bufname
(remove-overlays)
(while baseov
(when (setq props (minimap-get-sync-properties (car baseov)))
(setq ov (make-overlay (overlay-start (car baseov))
(overlay-end (car baseov))))
(while (setq p (car props))
(overlay-put ov (car p) (cadr p))
(setq props (cdr props))))
(setq baseov (cdr baseov)))
(move-overlay minimap-pointmin-overlay (point-min) (1+ (point-min)))
;; Re-apply font overlay
(move-overlay minimap-base-overlay (point-min) (point-max)))
;; Face enlargement
(when (and font-lock-mode
(or (eq minimap-enlarge-certain-faces 'always)
(and (eq minimap-enlarge-certain-faces 'as-fallback)
(or (not minimap-display-semantic-overlays)
(not semantic)))))
(when (eq font-lock-support-mode 'jit-lock-mode)
(jit-lock-fontify-now))
(with-current-buffer minimap-bufname
(minimap-enlarge-faces)))
;; Semantic overlays
(when (and semantic
minimap-display-semantic-overlays)
(minimap-apply-semantic-overlays)))
(minimap-update t)))
(defun minimap-get-sync-properties (ov)
"Get properties from overlay OV which should be synced.
You can specify those properties with
`minimap-sync-overlay-properties'."
(delq nil
(mapcar
(lambda (p)
(let ((val (overlay-get ov p)))
(if val
(list p val)
nil)))
minimap-sync-overlay-properties)))
(defun minimap-enlarge-faces ()
"Apply default font to all faces in `minimap-normal-height-faces'.
This has to be called in the minimap buffer."
(let ((pos (next-single-property-change (point-min) 'face))
next ov face)
(while pos
(setq face (get-text-property pos 'face))
(when (delq nil (mapcar (lambda (x) (equal x face))
minimap-normal-height-faces))
(setq ov
(make-overlay pos
(setq pos (next-single-property-change pos 'face))))
(overlay-put ov 'face `(:family ,(face-font 'default)))
(overlay-put ov 'priority 5))
(setq pos (next-single-property-change pos 'face)))))
(defun minimap-apply-semantic-overlays ()
"Apply semantic overlays to the minimap.
This has to be called from the base buffer."
(let ((tags (semantic-fetch-tags))
tag class ov ovnew)
(while tags
(setq tag (car tags))
(setq class (semantic-tag-class tag))
(setq ov (semantic-tag-overlay tag))
(when (and (overlayp ov)
(or (eq class 'function)
(eq class 'type)
(eq class 'variable)))
(with-current-buffer minimap-bufname
(let ((start (overlay-start ov))
(end (overlay-end ov))
(name (semantic-tag-name tag)))
(overlay-put
(setq ovnew (make-overlay start end))
'face `(:background ,(face-background
(intern (format "minimap-semantic-%s-face"
(symbol-name class))))))
(overlay-put ovnew 'priority 1)
(setq start
(minimap-line-to-pos (/ (+ (line-number-at-pos start)
(line-number-at-pos end)) 2)))
(setq end (progn (goto-char start) (point-at-eol)))
(setq ovnew (make-overlay start end))
(overlay-put ovnew 'face (format "minimap-semantic-%s-face"
(symbol-name class)))
(overlay-put ovnew 'display (concat " " name " "))
(overlay-put ovnew 'priority 6))))
(setq tags (cdr tags)))))
;; outline-(minor-)mode
(add-hook 'outline-view-change-hook 'minimap-sync-overlays)
;; hideshow
(add-hook 'hs-hide-hook 'minimap-sync-overlays)
(add-hook 'hs-show-hook 'minimap-sync-overlays)
(provide 'minimap)
;;; minimap.el ends here

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

@ -1,99 +0,0 @@
.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
View file

@ -1,303 +0,0 @@
;;; 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
View file

@ -1,327 +0,0 @@
;;; 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
View file

@ -1,306 +0,0 @@
;;; 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
View file

@ -1,284 +0,0 @@
;;; 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
View file

File diff suppressed because it is too large Load diff

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

@ -1,458 +0,0 @@
;;; 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
View file

@ -1,352 +0,0 @@
;;; muse-docbook.el --- publish DocBook files
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 3, or (at your
;; option) any later version.
;; Emacs Muse is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;; Dale P. Smith (dpsm AT en DOT com) improved the markup
;; significantly and made many valuable suggestions.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse DocBook XML Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-regexps)
(require 'muse-xml-common)
(defgroup muse-docbook nil
"Options controlling the behavior of Muse DocBook XML publishing.
See `muse-docbook' for more information."
:group 'muse-publish)
(defcustom muse-docbook-extension ".xml"
"Default file extension for publishing DocBook XML files."
:type 'string
:group 'muse-docbook)
(defcustom muse-docbook-header
"<?xml version=\"1.0\" encoding=\"<lisp>
(muse-docbook-encoding)</lisp>\"?>
<!DOCTYPE article PUBLIC \"-//OASIS//DTD DocBook V4.2//EN\"
\"http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd\"<lisp>(muse-docbook-entities)</lisp>>
<article>
<articleinfo>
<title><lisp>(muse-publishing-directive \"title\")</lisp></title>
<author><lisp>(muse-docbook-get-author
(muse-publishing-directive \"author\"))</lisp></author>
<pubdate><lisp>(muse-publishing-directive \"date\")</lisp></pubdate>
</articleinfo>
<!-- Page published by Emacs Muse begins here -->\n"
"Header used for publishing DocBook XML files.
This may be text or a filename."
:type 'string
:group 'muse-docbook)
(defcustom muse-docbook-footer "
<!-- Page published by Emacs Muse ends here -->
<lisp>(muse-docbook-bibliography)</lisp></article>\n"
"Footer used for publishing DocBook XML files.
This may be text or a filename."
:type 'string
:group 'muse-docbook)
(defcustom muse-docbook-markup-regexps
`(;; Beginning of doc, end of doc, or plain paragraph separator
(10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*"
"\\([" muse-regexp-blank "]*\n\\)\\)"
"\\|\\`\\s-*\\|\\s-*\\'\\)")
3 muse-docbook-markup-paragraph))
"List of markup rules for publishing a Muse page to DocBook XML.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-docbook)
(defcustom muse-docbook-markup-functions
'((anchor . muse-xml-markup-anchor)
(table . muse-xml-markup-table))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-docbook)
(defcustom muse-docbook-markup-strings
'((image-with-desc . "<mediaobject>
<imageobject>
<imagedata fileref=\"%1%.%2%\" format=\"%2%\" />
</imageobject>
<caption><para>%3%</para></caption>
</mediaobject>")
(image . "<inlinemediaobject><imageobject>
<imagedata fileref=\"%1%.%2%\" format=\"%2%\" />
</imageobject></inlinemediaobject>")
(image-link . "<ulink url=\"%1%\"><inlinemediaobject><imageobject>
<imagedata fileref=\"%2%.%3%\" format=\"%3%\" />
</imageobject></inlinemediaobject></ulink>")
(anchor-ref . "<link linkend=\"%s\">%s</link>")
(url . "<ulink url=\"%s\">%s</ulink>")
(link . "<ulink url=\"%s\">%s</ulink>")
(link-and-anchor . "<ulink url=\"%s#%s\">%s</ulink>")
(email-addr . "<email>%s</email>")
(anchor . "<anchor id=\"%s\" />\n")
(emdash . "%s&mdash;%s")
(comment-begin . "<!-- ")
(comment-end . " -->")
(rule . "")
(no-break-space . "&nbsp;")
(enddots . "....")
(dots . "...")
(section . "<section><title>")
(section-end . "</title>")
(subsection . "<section><title>")
(subsection-end . "</title>")
(subsubsection . "<section><title>")
(subsubsection-end . "</title>")
(section-other . "<section><title>")
(section-other-end . "</title>")
(section-close . "</section>")
(footnote . "<footnote><para>")
(footnote-end . "</para></footnote>")
(begin-underline . "")
(end-underline . "")
(begin-literal . "<systemitem>")
(end-literal . "</systemitem>")
(begin-emph . "<emphasis>")
(end-emph . "</emphasis>")
(begin-more-emph . "<emphasis role=\"strong\">")
(end-more-emph . "</emphasis>")
(begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
(end-most-emph . "</emphasis></emphasis>")
(begin-verse . "<literallayout>\n")
(verse-space . " ")
(end-verse . "</literallayout>")
(begin-example . "<programlisting>")
(end-example . "</programlisting>")
(begin-center . "<para role=\"centered\">\n")
(end-center . "\n</para>")
(begin-quote . "<blockquote>\n")
(end-quote . "\n</blockquote>")
(begin-cite . "<citation role=\"%s\">")
(begin-cite-author . "<citation role=\"%s\">A:")
(begin-cite-year . "<citation role=\"%s\">Y:")
(end-cite . "</citation>")
(begin-quote-item . "<para>")
(end-quote-item . "</para>")
(begin-uli . "<itemizedlist mark=\"bullet\">\n")
(end-uli . "\n</itemizedlist>")
(begin-uli-item . "<listitem><para>")
(end-uli-item . "</para></listitem>")
(begin-oli . "<orderedlist>\n")
(end-oli . "\n</orderedlist>")
(begin-oli-item . "<listitem><para>")
(end-oli-item . "</para></listitem>")
(begin-dl . "<variablelist>\n")
(end-dl . "\n</variablelist>")
(begin-dl-item . "<varlistentry>\n")
(end-dl-item . "\n</varlistentry>")
(begin-ddt . "<term>")
(end-ddt . "</term>")
(begin-dde . "<listitem><para>")
(end-dde . "</para></listitem>")
(begin-table . "<informaltable>\n")
(end-table . "</informaltable>")
(begin-table-group . " <tgroup cols='%s'>\n")
(end-table-group . " </tgroup>\n")
(begin-table-row . " <row>\n")
(end-table-row . " </row>\n")
(begin-table-entry . " <entry>")
(end-table-entry . "</entry>\n"))
"Strings used for marking up text.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-docbook)
(defcustom muse-docbook-encoding-default 'utf-8
"The default Emacs buffer encoding to use in published files.
This will be used if no special characters are found."
:type 'symbol
:group 'muse-docbook)
(defcustom muse-docbook-charset-default "utf-8"
"The default DocBook XML charset to use if no translation is
found in `muse-docbook-encoding-map'."
:type 'string
:group 'muse-docbook)
(defun muse-docbook-encoding ()
(muse-xml-transform-content-type
(or (and (boundp 'buffer-file-coding-system)
buffer-file-coding-system)
muse-docbook-encoding-default)
muse-docbook-charset-default))
(defun muse-docbook-markup-paragraph ()
(catch 'bail-out
(let ((end (copy-marker (match-end 0) t)))
(goto-char (match-beginning 0))
(when (save-excursion
(save-match-data
(and (not (get-text-property (max (point-min) (1- (point)))
'muse-no-paragraph))
(re-search-backward
"<\\(/?\\)\\(para\\|footnote\\|literallayout\\)[ >]"
nil t)
(cond ((string= (match-string 2) "literallayout")
(and (not (string= (match-string 1) "/"))
(throw 'bail-out t)))
((string= (match-string 2) "para")
(and
(not (string= (match-string 1) "/"))
;; don't mess up nested lists
(not (and (muse-looking-back "<listitem>")
(throw 'bail-out t)))))
((string= (match-string 2) "footnote")
(string= (match-string 1) "/"))
(t nil)))))
(when (get-text-property (1- (point)) 'muse-end-list)
(goto-char (previous-single-property-change (1- (point))
'muse-end-list)))
(muse-insert-markup "</para>"))
(goto-char end))
(cond
((eobp)
(unless (bolp)
(insert "\n")))
((get-text-property (point) 'muse-no-paragraph)
(forward-char 1)
nil)
((eq (char-after) ?\<)
(when (looking-at (concat "<\\(emphasis\\|systemitem\\|inlinemediaobject"
"\\|u?link\\|anchor\\|email\\)[ >]"))
(muse-insert-markup "<para>")))
(t
(muse-insert-markup "<para>")))))
(defun muse-docbook-get-author (&optional author)
"Split the AUTHOR directive into separate fields.
AUTHOR should be of the form: \"Firstname Other Names Lastname\",
and anything after `Firstname' is optional."
(setq author (save-match-data (split-string author)))
(let ((num-el (length author)))
(cond ((eq num-el 1)
(concat "<firstname>" (car author) "</firstname>"))
((eq num-el 2)
(concat "<firstname>" (nth 0 author) "</firstname>"
"<surname>" (nth 1 author) "</surname>"))
((eq num-el 3)
(concat "<firstname>" (nth 0 author) "</firstname>"
"<othername>" (nth 1 author) "</othername>"
"<surname>" (nth 2 author) "</surname>"))
(t
(let (first last)
(setq first (car author))
(setq author (nreverse (cdr author)))
(setq last (car author))
(setq author (nreverse (cdr author)))
(concat "<firstname>" first "</firstname>"
"<othername>"
(mapconcat 'identity author " ")
"</othername>"
"<surname>" last "</surname>"))))))
(defun muse-docbook-fixup-images ()
(goto-char (point-min))
(while (re-search-forward (concat "<imagedata fileref=\"[^\"]+\""
" format=\"\\([^\"]+\\)\" />$")
nil t)
(replace-match (upcase (match-string 1)) t t nil 1)))
(defun muse-docbook-fixup-citations ()
;; remove the role attribute if there is no role
(goto-char (point-min))
(while (re-search-forward "<\\(citation role=\"nil\"\\)>" nil t)
(replace-match "citation" t t nil 1))
;; replace colons in multi-head citations with semicolons
(goto-char (point-min))
(while (re-search-forward "<citation.*>" nil t)
(let ((start (point))
(end (re-search-forward "</citation>")))
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(while (re-search-forward "," nil t)
(replace-match ";"))))))
(defun muse-docbook-munge-buffer ()
(muse-docbook-fixup-images)
(muse-docbook-fixup-citations))
(defun muse-docbook-entities ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "<citation" nil t)
(concat
" [\n<!ENTITY bibliography SYSTEM \""
(if (string-match ".short$" (muse-page-name))
(substring (muse-page-name) 0 -6)
(muse-page-name))
".bib.xml\">\n]")
"")))
(defun muse-docbook-bibliography ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "<citation" nil t)
"&bibliography;\n"
"")))
(defun muse-docbook-finalize-buffer ()
(when (boundp 'buffer-file-coding-system)
(when (memq buffer-file-coding-system '(no-conversion undecided-unix))
;; make it agree with the default charset
(setq buffer-file-coding-system muse-docbook-encoding-default))))
;;; Register the Muse DocBook XML Publisher
(muse-define-style "docbook"
:suffix 'muse-docbook-extension
:regexps 'muse-docbook-markup-regexps
:functions 'muse-docbook-markup-functions
:strings 'muse-docbook-markup-strings
:specials 'muse-xml-decide-specials
:before-end 'muse-docbook-munge-buffer
:after 'muse-docbook-finalize-buffer
:header 'muse-docbook-header
:footer 'muse-docbook-footer
:browser 'find-file)
(provide 'muse-docbook)
;;; muse-docbook.el ends here

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

@ -1,274 +0,0 @@
;;; 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
View file

@ -1,754 +0,0 @@
;;; muse-html.el --- publish to HTML and XHTML
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 3, or (at your
;; option) any later version.
;; Emacs Muse is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;; Zhiqiang Ye (yezq AT mail DOT cbi DOT pku DOT edu DOT cn) suggested
;; appending an 'encoding="..."' fragment to the first line of the
;; sample publishing header so that when editing the resulting XHTML
;; file, Emacs would use the proper encoding.
;; Sun Jiyang (sunyijiang AT gmail DOT com) came up with the idea for
;; the <src> tag and provided an implementation for emacs-wiki.
;; Charles Wang (wcy123 AT gmail DOT com) provided an initial
;; implementation of the <src> tag for Muse.
;; Clinton Ebadi (clinton AT unknownlamer DOT org) provided further
;; ideas for the implementation of the <src> tag.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse HTML Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-regexps)
(require 'muse-xml-common)
(defgroup muse-html nil
"Options controlling the behavior of Muse HTML publishing."
:group 'muse-publish)
(defcustom muse-html-extension ".html"
"Default file extension for publishing HTML files."
:type 'string
:group 'muse-html)
(defcustom muse-xhtml-extension ".html"
"Default file extension for publishing XHTML files."
:type 'string
:group 'muse-html)
(defcustom muse-html-style-sheet
"<style type=\"text/css\">
body {
background: white; color: black;
margin-left: 3%; margin-right: 7%;
}
p { margin-top: 1% }
p.verse { margin-left: 3% }
.example { margin-left: 3% }
h2 {
margin-top: 25px;
margin-bottom: 0px;
}
h3 { margin-bottom: 0px; }
</style>"
"Store your stylesheet definitions here.
This is used in `muse-html-header'.
You can put raw CSS in here or a <link> tag to an external stylesheet.
This text may contain <lisp> markup tags.
An example of using <link> is as follows.
<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\">"
:type 'string
:group 'muse-html)
(defcustom muse-xhtml-style-sheet
"<style type=\"text/css\">
body {
background: white; color: black;
margin-left: 3%; margin-right: 7%;
}
p { margin-top: 1% }
p.verse { margin-left: 3% }
.example { margin-left: 3% }
h2 {
margin-top: 25px;
margin-bottom: 0px;
}
h3 { margin-bottom: 0px; }
</style>"
"Store your stylesheet definitions here.
This is used in `muse-xhtml-header'.
You can put raw CSS in here or a <link> tag to an external stylesheet.
This text may contain <lisp> markup tags.
An example of using <link> is as follows.
<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\" href=\"/default.css\" />"
:type 'string
:group 'muse-html)
(defcustom muse-html-header
"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">
<html>
<head>
<title><lisp>
(concat (muse-publishing-directive \"title\")
(let ((author (muse-publishing-directive \"author\")))
(if (not (string= author (user-full-name)))
(concat \" (by \" author \")\"))))</lisp></title>
<meta name=\"generator\" content=\"muse.el\">
<meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
content=\"<lisp>muse-html-meta-content-type</lisp>\">
<lisp>
(let ((maintainer (muse-style-element :maintainer)))
(when maintainer
(concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\">\")))
</lisp><lisp>
(muse-style-element :style-sheet muse-publishing-current-style)
</lisp>
</head>
<body>
<h1><lisp>
(concat (muse-publishing-directive \"title\")
(let ((author (muse-publishing-directive \"author\")))
(if (not (string= author (user-full-name)))
(concat \" (by \" author \")\"))))</lisp></h1>
<!-- Page published by Emacs Muse begins here -->\n"
"Header used for publishing HTML files. This may be text or a filename."
:type 'string
:group 'muse-html)
(defcustom muse-html-footer "
<!-- Page published by Emacs Muse ends here -->
</body>
</html>\n"
"Footer used for publishing HTML files. This may be text or a filename."
:type 'string
:group 'muse-html)
(defcustom muse-xhtml-header
"<?xml version=\"1.0\" encoding=\"<lisp>
(muse-html-encoding)</lisp>\"?>
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
<html xmlns=\"http://www.w3.org/1999/xhtml\">
<head>
<title><lisp>
(concat (muse-publishing-directive \"title\")
(let ((author (muse-publishing-directive \"author\")))
(if (not (string= author (user-full-name)))
(concat \" (by \" author \")\"))))</lisp></title>
<meta name=\"generator\" content=\"muse.el\" />
<meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
content=\"<lisp>muse-html-meta-content-type</lisp>\" />
<lisp>
(let ((maintainer (muse-style-element :maintainer)))
(when maintainer
(concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\" />\")))
</lisp><lisp>
(muse-style-element :style-sheet muse-publishing-current-style)
</lisp>
</head>
<body>
<h1><lisp>
(concat (muse-publishing-directive \"title\")
(let ((author (muse-publishing-directive \"author\")))
(if (not (string= author (user-full-name)))
(concat \" (by \" author \")\"))))</lisp></h1>
<!-- Page published by Emacs Muse begins here -->\n"
"Header used for publishing XHTML files. This may be text or a filename."
:type 'string
:group 'muse-html)
(defcustom muse-xhtml-footer "
<!-- Page published by Emacs Muse ends here -->
</body>
</html>\n"
"Footer used for publishing XHTML files. This may be text or a filename."
:type 'string
:group 'muse-html)
(defcustom muse-html-anchor-on-word nil
"When true, anchors surround the closest word. This allows you
to select them in a browser (i.e. for pasting), but has the
side-effect of marking up headers in multiple colors if your
header style is different from your link style."
:type 'boolean
:group 'muse-html)
(defcustom muse-html-table-attributes
" class=\"muse-table\" border=\"2\" cellpadding=\"5\""
"The attribute to be used with HTML <table> tags.
Note that Muse supports insertion of raw HTML tags, as long
as you wrap the region in <literal></literal>."
:type 'string
:group 'muse-html)
(defcustom muse-html-markup-regexps
`(;; Beginning of doc, end of doc, or plain paragraph separator
(10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*"
"\\([" muse-regexp-blank "]*\n\\)\\)"
"\\|\\`\\s-*\\|\\s-*\\'\\)")
;; this is somewhat repetitive because we only require the
;; line just before the paragraph beginning to be not
;; read-only
3 muse-html-markup-paragraph))
"List of markup rules for publishing a Muse page to HTML.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-html)
(defcustom muse-html-markup-functions
'((anchor . muse-html-markup-anchor)
(table . muse-html-markup-table)
(footnote . muse-html-markup-footnote))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-html)
(defcustom muse-html-markup-strings
'((image-with-desc . "<table class=\"image\" width=\"100%%\">
<tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\"></td></tr>
<tr><td align=\"center\" class=\"image-caption\">%3%</td></tr>
</table>")
(image . "<img src=\"%s.%s\" alt=\"\">")
(image-link . "<a class=\"image-link\" href=\"%s\">
<img src=\"%s.%s\"></a>")
(anchor-ref . "<a href=\"#%s\">%s</a>")
(url . "<a href=\"%s\">%s</a>")
(link . "<a href=\"%s\">%s</a>")
(link-and-anchor . "<a href=\"%s#%s\">%s</a>")
(email-addr . "<a href=\"mailto:%s\">%s</a>")
(anchor . "<a name=\"%1%\" id=\"%1%\">")
(emdash . "%s&mdash;%s")
(comment-begin . "<!-- ")
(comment-end . " -->")
(rule . "<hr>")
(fn-sep . "<hr>\n")
(no-break-space . "&nbsp;")
(line-break . "<br>")
(enddots . "....")
(dots . "...")
(section . "<h2>")
(section-end . "</h2>")
(subsection . "<h3>")
(subsection-end . "</h3>")
(subsubsection . "<h4>")
(subsubsection-end . "</h4>")
(section-other . "<h5>")
(section-other-end . "</h5>")
(begin-underline . "<u>")
(end-underline . "</u>")
(begin-literal . "<code>")
(end-literal . "</code>")
(begin-cite . "<span class=\"citation\">")
(begin-cite-author . "<span class=\"citation-author\">")
(begin-cite-year . "<span class=\"citation-year\">")
(end-cite . "</span>")
(begin-emph . "<em>")
(end-emph . "</em>")
(begin-more-emph . "<strong>")
(end-more-emph . "</strong>")
(begin-most-emph . "<strong><em>")
(end-most-emph . "</em></strong>")
(begin-verse . "<p class=\"verse\">\n")
(verse-space . "&nbsp;&nbsp;")
(end-verse-line . "<br>")
(end-last-stanza-line . "<br>")
(empty-verse-line . "<br>")
(end-verse . "</p>")
(begin-example . "<pre class=\"example\">")
(end-example . "</pre>")
(begin-center . "<center>\n<p>")
(end-center . "</p>\n</center>")
(begin-quote . "<blockquote>\n")
(end-quote . "\n</blockquote>")
(begin-quote-item . "<p class=\"quoted\">")
(end-quote-item . "</p>")
(begin-uli . "<ul>\n")
(end-uli . "\n</ul>")
(begin-uli-item . "<li>")
(end-uli-item . "</li>")
(begin-oli . "<ol>\n")
(end-oli . "\n</ol>")
(begin-oli-item . "<li>")
(end-oli-item . "</li>")
(begin-dl . "<dl>\n")
(end-dl . "\n</dl>")
(begin-ddt . "<dt><strong>")
(end-ddt . "</strong></dt>")
(begin-dde . "<dd>")
(end-dde . "</dd>")
(begin-table . "<table%s>\n")
(end-table . "</table>")
(begin-table-row . " <tr>\n")
(end-table-row . " </tr>\n")
(begin-table-entry . " <%s>")
(end-table-entry . "</%s>\n"))
"Strings used for marking up text as HTML.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-html)
(defcustom muse-xhtml-markup-strings
'((image-with-desc . "<table class=\"image\" width=\"100%%\">
<tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\" /></td></tr>
<tr><td align=\"center\" class=\"image-caption\">%3%</td></tr>
</table>")
(image . "<img src=\"%s.%s\" alt=\"\" />")
(image-link . "<a class=\"image-link\" href=\"%s\">
<img src=\"%s.%s\" alt=\"\" /></a>")
(rule . "<hr />")
(fn-sep . "<hr />\n")
(line-break . "<br />")
(begin-underline . "<span style=\"text-decoration: underline;\">")
(end-underline . "</span>")
(begin-center . "<p style=\"text-align: center;\">\n")
(end-center . "\n</p>")
(end-verse-line . "<br />")
(end-last-stanza-line . "<br />")
(empty-verse-line . "<br />"))
"Strings used for marking up text as XHTML.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles.
If a markup rule is not found here, `muse-html-markup-strings' is
searched."
:type '(alist :key-type symbol :value-type string)
:group 'muse-html)
(defcustom muse-xhtml1.1-markup-strings
'((anchor . "<a id=\"%s\">"))
"Strings used for marking up text as XHTML 1.1.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles.
If a markup rule is not found here, `muse-xhtml-markup-strings'
and `muse-html-markup-strings' are searched."
:type '(alist :key-type symbol :value-type string)
:group 'muse-html)
(defcustom muse-html-markup-tags
'(("class" t t t muse-html-class-tag)
("div" t t t muse-html-div-tag)
("src" t t nil muse-html-src-tag))
"A list of tag specifications, for specially marking up HTML."
:type '(repeat (list (string :tag "Markup tag")
(boolean :tag "Expect closing tag" :value t)
(boolean :tag "Parse attributes" :value nil)
(boolean :tag "Nestable" :value nil)
function))
:group 'muse-html)
(defcustom muse-html-meta-http-equiv "Content-Type"
"The http-equiv attribute used for the HTML <meta> tag."
:type 'string
:group 'muse-html)
(defcustom muse-html-meta-content-type "text/html"
"The content type used for the HTML <meta> tag.
If you are striving for XHTML 1.1 compliance, you may want to
change this to \"application/xhtml+xml\"."
:type 'string
:group 'muse-html)
(defcustom muse-html-meta-content-encoding (if (featurep 'mule)
'detect
"iso-8859-1")
"The charset to append to the HTML <meta> tag.
If set to the symbol 'detect, use `muse-html-encoding-map' to try
and determine the HTML charset from emacs's coding. If set to a
string, this string will be used to force a particular charset"
:type '(choice string symbol)
:group 'muse-html)
(defcustom muse-html-encoding-default 'iso-8859-1
"The default Emacs buffer encoding to use in published files.
This will be used if no special characters are found."
:type 'symbol
:group 'muse-html)
(defcustom muse-html-charset-default "iso-8859-1"
"The default HTML meta charset to use if no translation is found in
`muse-html-encoding-map'."
:type 'string
:group 'muse-html)
(defcustom muse-html-src-allowed-modes t
"Modes that we allow the <src> tag to colorize.
If t, permit the <src> tag to colorize any mode.
If a list of mode names, such as '(\"html\" \"latex\"), and the
lang argument to <src> is not in the list, then use fundamental
mode instead."
:type '(choice (const :tag "Any" t)
(repeat (string :tag "Mode")))
:group 'muse-html)
(defun muse-html-insert-anchor (anchor)
"Insert an anchor, either around the word at point, or within a tag."
(skip-chars-forward (concat muse-regexp-blank "\n"))
(if (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>"))
(let ((tag (match-string 1)))
(goto-char (match-end 0))
(muse-insert-markup (muse-markup-text 'anchor anchor))
(when muse-html-anchor-on-word
(or (and (search-forward (format "</%s>" tag)
(muse-line-end-position) t)
(goto-char (match-beginning 0)))
(forward-word 1)))
(muse-insert-markup "</a>"))
(muse-insert-markup (muse-markup-text 'anchor anchor))
(when muse-html-anchor-on-word
(forward-word 1))
(muse-insert-markup "</a>\n")))
(defun muse-html-markup-anchor ()
(unless (get-text-property (match-end 1) 'muse-link)
(save-match-data
(muse-html-insert-anchor (match-string 2)))
(match-string 1)))
(defun muse-html-markup-paragraph ()
(let ((end (copy-marker (match-end 0) t)))
(goto-char (match-beginning 0))
(when (save-excursion
(save-match-data
(and (not (get-text-property (max (point-min) (1- (point)))
'muse-no-paragraph))
(re-search-backward "<\\(/?\\)p[ >]" nil t)
(not (string-equal (match-string 1) "/")))))
(when (get-text-property (1- (point)) 'muse-end-list)
(goto-char (previous-single-property-change (1- (point))
'muse-end-list)))
(muse-insert-markup "</p>"))
(goto-char end))
(cond
((eobp)
(unless (bolp)
(insert "\n")))
((get-text-property (point) 'muse-no-paragraph)
(forward-char 1)
nil)
((eq (char-after) ?\<)
(cond
((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]")
(muse-insert-markup "<p>"))
((looking-at "<a ")
(if (looking-at "<a[^>\n]+><img")
(muse-insert-markup "<p class=\"image-link\">")
(muse-insert-markup "<p>")))
((looking-at "<img[ >]")
(muse-insert-markup "<p class=\"image\">"))
(t
(forward-char 1)
nil)))
((muse-looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n")
(muse-insert-markup "<p class=\"first\">"))
(t
(muse-insert-markup "<p>"))))
(defun muse-html-markup-footnote ()
(cond
((get-text-property (match-beginning 0) 'muse-link)
nil)
((= (muse-line-beginning-position) (match-beginning 0))
(prog1
(let ((text (match-string 1)))
(muse-insert-markup
(concat "<p class=\"footnote\">"
"<a class=\"footnum\" name=\"fn." text
"\" href=\"#fnr." text "\">"
text ".</a>")))
(save-excursion
(save-match-data
(let* ((beg (goto-char (match-end 0)))
(end (and (search-forward "\n\n" nil t)
(prog1
(copy-marker (match-beginning 0))
(goto-char beg)))))
(while (re-search-forward (concat "^["
muse-regexp-blank
"]+\\([^\n]\\)")
end t)
(replace-match "\\1" t)))))
(replace-match "")))
(t (let ((text (match-string 1)))
(muse-insert-markup
(concat "<sup><a class=\"footref\" name=\"fnr." text
"\" href=\"#fn." text "\">"
text "</a></sup>")))
(replace-match ""))))
(defun muse-html-markup-table ()
(muse-xml-markup-table muse-html-table-attributes))
;; Handling of tags for HTML
(defun muse-html-strip-links (string)
"Remove all HTML links from STRING."
(muse-replace-regexp-in-string "\\(<a .*?>\\|</a>\\)" "" string nil t))
(defun muse-html-insert-contents (depth)
"Scan the current document and generate a table of contents at point.
DEPTH indicates how many levels of headings to include. The default is 2."
(let ((max-depth (or depth 2))
(index 1)
base contents l end)
(save-excursion
(goto-char (point-min))
(search-forward "Page published by Emacs Muse begins here" nil t)
(catch 'done
(while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
(unless (and (get-text-property (point) 'read-only)
(not (get-text-property (match-beginning 0)
'muse-contents)))
(remove-text-properties (match-beginning 0) (match-end 0)
'(muse-contents nil))
(setq l (1- (string-to-number (match-string 1))))
(if (null base)
(setq base l)
(if (< l base)
(throw 'done t)))
(when (<= l max-depth)
;; escape specials now before copying the text, so that we
;; can deal sanely with both emphasis in titles and
;; special characters
(goto-char (match-end 2))
(setq end (point-marker))
(muse-publish-escape-specials (match-beginning 2) end
nil 'document)
(muse-publish-mark-read-only (match-beginning 2) end)
(setq contents (cons (cons l (buffer-substring-no-properties
(match-beginning 2) end))
contents))
(set-marker end nil)
(goto-char (match-beginning 2))
(muse-html-insert-anchor (concat "sec" (int-to-string index)))
(setq index (1+ index)))))))
(setq index 1 contents (nreverse contents))
(let ((depth 1) (sub-open 0) (p (point)))
(muse-insert-markup "<div class=\"contents\">\n<dl>\n")
(while contents
(muse-insert-markup "<dt>\n"
"<a href=\"#sec" (int-to-string index) "\">"
(muse-html-strip-links (cdar contents))
"</a>\n"
"</dt>\n")
(setq index (1+ index)
depth (caar contents)
contents (cdr contents))
(when contents
(cond
((< (caar contents) depth)
(let ((idx (caar contents)))
(while (< idx depth)
(muse-insert-markup "</dl>\n</dd>\n")
(setq sub-open (1- sub-open)
idx (1+ idx)))))
((> (caar contents) depth) ; can't jump more than one ahead
(muse-insert-markup "<dd>\n<dl>\n")
(setq sub-open (1+ sub-open))))))
(while (> sub-open 0)
(muse-insert-markup "</dl>\n</dd>\n")
(setq sub-open (1- sub-open)))
(muse-insert-markup "</dl>\n</div>\n")
(muse-publish-mark-read-only p (point)))))
(defun muse-html-denote-headings ()
"Place a text property on any headings in the current buffer.
This allows the headings to be picked up later on if publishing a
table of contents."
(save-excursion
(goto-char (point-min))
(search-forward "Page published by Emacs Muse begins here" nil t)
(while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
(unless (get-text-property (point) 'read-only)
(add-text-properties (match-beginning 0) (match-end 0)
'(muse-contents t))))))
(defun muse-html-class-tag (beg end attrs)
(let ((name (cdr (assoc "name" attrs))))
(when name
(goto-char beg)
(muse-insert-markup "<span class=\"" name "\">")
(save-excursion
(goto-char end)
(muse-insert-markup "</span>")))))
(defun muse-html-div-tag (beg end attrs)
"Publish a <div> tag for HTML."
(let ((id (cdr (assoc "id" attrs)))
(style (cdr (assoc "style" attrs))))
(when (or id style)
(goto-char beg)
(if (null id)
(muse-insert-markup "<div style=\"" style "\">")
(muse-insert-markup "<div id=\"" id "\">"))
(save-excursion
(goto-char end)
(muse-insert-markup "</div>")))))
(defun muse-html-src-tag (beg end attrs)
"Publish the region using htmlize.
The language to use may be specified by the \"lang\" attribute.
Muse will look for a function named LANG-mode, where LANG is the
value of the \"lang\" attribute.
This tag requires htmlize 1.34 or later in order to work."
(if (condition-case nil
(progn
(require 'htmlize)
(if (fboundp 'htmlize-region-for-paste)
nil
(muse-display-warning
(concat "The `htmlize-region-for-paste' function was not"
" found.\nThis is available in htmlize.el 1.34"
" or later."))
t))
(error nil t))
;; if htmlize.el was not found, treat this like an example tag
(muse-publish-example-tag beg end)
(muse-publish-ensure-block beg end)
(let* ((lang (cdr (assoc "lang" attrs)))
(mode (or (and (not (eq muse-html-src-allowed-modes t))
(not (member lang muse-html-src-allowed-modes))
'fundamental-mode)
(intern-soft (concat lang "-mode"))))
(text (muse-delete-and-extract-region beg end))
(htmltext
(with-temp-buffer
(insert text)
(if (functionp mode)
(funcall mode)
(fundamental-mode))
(font-lock-fontify-buffer)
;; silence the byte-compiler
(when (fboundp 'htmlize-region-for-paste)
;; transform the region to HTML
(htmlize-region-for-paste (point-min) (point-max))))))
(save-restriction
(narrow-to-region (point) (point))
(insert htmltext)
(goto-char (point-min))
(re-search-forward "<pre\\([^>]*\\)>\n?" nil t)
(replace-match "<pre class=\"src\">")
(goto-char (point-max))
(muse-publish-mark-read-only (point-min) (point-max))))))
;; Register the Muse HTML Publisher
(defun muse-html-browse-file (file)
(browse-url (concat "file:" file)))
(defun muse-html-encoding ()
(if (stringp muse-html-meta-content-encoding)
muse-html-meta-content-encoding
(muse-xml-transform-content-type
(or (and (boundp 'buffer-file-coding-system)
buffer-file-coding-system)
muse-html-encoding-default)
muse-html-charset-default)))
(defun muse-html-prepare-buffer ()
(make-local-variable 'muse-html-meta-http-equiv)
(set (make-local-variable 'muse-html-meta-content-type)
(if (save-match-data
(string-match "charset=" muse-html-meta-content-type))
muse-html-meta-content-type
(concat muse-html-meta-content-type "; charset="
(muse-html-encoding)))))
(defun muse-html-munge-buffer ()
(if muse-publish-generate-contents
(progn
(goto-char (car muse-publish-generate-contents))
(muse-html-insert-contents (cdr muse-publish-generate-contents))
(setq muse-publish-generate-contents nil))
(muse-html-denote-headings)))
(defun muse-html-finalize-buffer ()
(when (and (boundp 'buffer-file-coding-system)
(memq buffer-file-coding-system '(no-conversion undecided-unix)))
;; make it agree with the default charset
(setq buffer-file-coding-system muse-html-encoding-default)))
;;; Register the Muse HTML and XHTML Publishers
(muse-define-style "html"
:suffix 'muse-html-extension
:regexps 'muse-html-markup-regexps
:functions 'muse-html-markup-functions
:strings 'muse-html-markup-strings
:tags 'muse-html-markup-tags
:specials 'muse-xml-decide-specials
:before 'muse-html-prepare-buffer
:before-end 'muse-html-munge-buffer
:after 'muse-html-finalize-buffer
:header 'muse-html-header
:footer 'muse-html-footer
:style-sheet 'muse-html-style-sheet
:browser 'muse-html-browse-file)
(muse-derive-style "xhtml" "html"
:suffix 'muse-xhtml-extension
:strings 'muse-xhtml-markup-strings
:header 'muse-xhtml-header
:footer 'muse-xhtml-footer
:style-sheet 'muse-xhtml-style-sheet)
;; xhtml1.0 is an alias for xhtml
(muse-derive-style "xhtml1.0" "xhtml")
;; xhtml1.1 has some quirks that need attention from us
(muse-derive-style "xhtml1.1" "xhtml"
:strings 'muse-xhtml1.1-markup-strings)
(provide 'muse-html)
;;; muse-html.el ends here

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

@ -1,239 +0,0 @@
;;; 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
View file

@ -1,219 +0,0 @@
;;; 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
View file

@ -1,137 +0,0 @@
;;; 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
View file

@ -1,149 +0,0 @@
;;; 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
View file

@ -1,88 +0,0 @@
;;; 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
View file

@ -1,194 +0,0 @@
;;; 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
View file

@ -1,774 +0,0 @@
;;; muse-journal.el --- keep and publish a journal
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 3, or (at your
;; option) any later version.
;; Emacs Muse is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; The module facilitates the keeping and publication of a journal.
;; When publishing to HTML, it assumes the form of a web log, or blog.
;;
;; The input format for each entry is as follows:
;;
;; * 20040317: Title of entry
;;
;; Text for the entry.
;;
;; <qotd>
;; "You know who you are. It comes down to a simple gut check: You
;; either love what you do or you don't. Period." -- P. Bronson
;; </qotd>
;;
;; The "qotd", or Quote of the Day, is entirely optional. When
;; generated to HTML, this entry is rendered as:
;;
;; <div class="entry">
;; <div class="entry-qotd">
;; <h3>Quote of the Day:</h3>
;; <p>"You know who you are. It comes down to a simple gut
;; check: You either love what you do or you don't. Period."
;; -- P. Bronson</p>
;; </div>
;; <div class="entry-body">
;; <div class="entry-head">
;; <div class="entry-date">
;; <span class="date">March 17, 2004</span>
;; </div>
;; <div class="entry-title">
;; <h2>Title of entry</h2>
;; </div>
;; </div>
;; <div class="entry-text">
;; <p>Text for the entry.</p>
;; </div>
;; </div>
;; </div>
;;
;; The plurality of "div" tags makes it possible to display the
;; entries in any form you wish, using a CSS style.
;;
;; Also, an .RDF file can be generated from your journal by publishing
;; it with the "rdf" style. It uses the first two sentences of the
;; first paragraph of each entry as its "description", and
;; autogenerates tags for linking to the various entries.
;;; Contributors:
;; René Stadler (mail AT renestadler DOT de) provided a patch that
;; causes dates in RSS feeds to be generated in a format that RSS
;; readers can parse.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse Journal Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-html)
(require 'muse-latex)
(require 'muse-book)
(defgroup muse-journal nil
"Rules for transforming a journal into its final form."
:group 'muse-publish)
(defcustom muse-journal-heading-regexp
"\\(?:\\([0-9]+\\)\\(?:: \\)?\\)?\\(.+?\\)?"
"A regexp that matches a journal heading.
Paren group 1 is the ISO date, group 2 is the optional category,
and group 3 is the optional heading for the entry."
:type 'regexp
:group 'muse-journal)
(defcustom muse-journal-date-format "%a, %e %b %Y"
"Date format to use for journal entries."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-html-heading-regexp
(concat "^<h2[^>\n]*>" muse-journal-heading-regexp "</h2>$")
"A regexp that matches a journal heading from an HTML document.
Paren group 1 is the ISO date, group 2 is the optional category,
and group 3 is the optional heading for the entry."
:type 'regexp
:group 'muse-journal)
(defcustom muse-journal-rss-heading-regexp
(concat "^\\* " muse-journal-heading-regexp "$")
"A regexp that matches a journal heading from an HTML document.
Paren group 1 is the ISO date, group 2 is the optional category,
and group 3 is the optional heading for the entry."
:type 'regexp
:group 'muse-journal)
(defcustom muse-journal-html-entry-template
"<div class=\"entry\">
<a name=\"%anchor%\" style=\"text-decoration: none\">&nbsp;</a>
<div class=\"entry-body\">
<div class=\"entry-head\">
<div class=\"entry-date\">
<span class=\"date\">%date%</span>
</div>
<div class=\"entry-title\">
<h2>%title%</h2>
</div>
</div>
<div class=\"entry-text\">
<div class=\"entry-qotd\">
<p>%qotd%</p>
</div>
%text%
</div>
</div>
</div>\n\n"
"Template used to publish individual journal entries as HTML.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-latex-section
"\\section*{%title% \\hfill {\\normalsize %date%}}
\\addcontentsline{toc}{chapter}{%title%}"
"Template used to publish a LaTeX section."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-latex-subsection
"\\subsection*{%title%}
\\addcontentsline{toc}{section}{%title%}"
"Template used to publish a LaTeX subsection."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-markup-tags
'(("qotd" t nil nil muse-journal-qotd-tag))
"A list of tag specifications, for specially marking up Journal entries.
See `muse-publish-markup-tags' for more info.
This is used by journal-latex and its related styles, as well as
the journal-rss-entry style, which both journal-rdf and
journal-rss use."
:type '(repeat (list (string :tag "Markup tag")
(boolean :tag "Expect closing tag" :value t)
(boolean :tag "Parse attributes" :value nil)
(boolean :tag "Nestable" :value nil)
function))
:group 'muse-journal)
;; FIXME: This doesn't appear to be used.
(defun muse-journal-generate-pages ()
(let ((output-dir (muse-style-element :path)))
(goto-char (point-min))
(while (re-search-forward muse-journal-heading-regexp nil t)
(let* ((date (match-string 1))
(category (match-string 1))
(category-file (concat output-dir category "/index.html"))
(heading (match-string 1)))
t))))
(defcustom muse-journal-rdf-extension ".rdf"
"Default file extension for publishing RDF (RSS 1.0) files."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-base-url ""
"The base URL of the website referenced by the RDF file."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-header
"<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
xmlns=\"http://purl.org/rss/1.0/\"
xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
<channel rdf:about=\"<lisp>(concat (muse-style-element :base-url)
(muse-publish-link-name))</lisp>\">
<title><lisp>(muse-publishing-directive \"title\")</lisp></title>
<link><lisp>(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))</lisp></link>
<description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
<items>
<rdf:Seq>
<rdf:li resource=\"<lisp>
(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))</lisp>\"/>
</rdf:Seq>
</items>
</channel>\n"
"Header used for publishing RDF (RSS 1.0) files.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-footer
"</rdf:RDF>\n"
"Footer used for publishing RDF (RSS 1.0) files.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-date-format
"%Y-%m-%dT%H:%M:%S"
"Date format to use for RDF entries."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-entry-template
"\n <item rdf:about=\"%link%#%anchor%\">
<title>%title%</title>
<description>
%desc%
</description>
<link>%link%#%anchor%</link>
<dc:date>%date%</dc:date>
<dc:creator>%maintainer%</dc:creator>
</item>\n"
"Template used to publish individual journal entries as RDF.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rdf-summarize-entries nil
"If non-nil, include only summaries in the RDF file, not the full data.
The default is nil, because this annoys some subscribers."
:type 'boolean
:group 'muse-journal)
(defcustom muse-journal-rss-extension ".xml"
"Default file extension for publishing RSS 2.0 files."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-base-url ""
"The base URL of the website referenced by the RSS file."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-header
"<\?xml version=\"1.0\" encoding=\"<lisp>
(muse-html-encoding)</lisp>\"?>
<rss version=\"2.0\">
<channel>
<title><lisp>(muse-publishing-directive \"title\")</lisp></title>
<link><lisp>(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))</lisp></link>
<description><lisp>(muse-publishing-directive \"desc\")</lisp></description>
<language>en-us</language>
<generator>Emacs Muse</generator>\n\n"
"Header used for publishing RSS 2.0 files. This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-footer
"\n\n </channel>
</rss>\n"
"Footer used for publishing RSS 2.0 files. This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-date-format
"%a, %d %b %Y %H:%M:%S %Z"
"Date format to use for RSS 2.0 entries."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-entry-template
"\n <item>
<title>%title%</title>
<link>%link%#%anchor%</link>
<description>%desc%</description>
<author><lisp>(muse-publishing-directive \"author\")</lisp></author>
<pubDate>%date%</pubDate>
<guid>%link%#%anchor%</guid>
%enclosure%
</item>\n"
"Template used to publish individual journal entries as RSS 2.0.
This may be text or a filename."
:type 'string
:group 'muse-journal)
(defcustom muse-journal-rss-enclosure-types-alist
'(("mp3" . "audio/mpeg"))
"File types that are accepted as RSS enclosures.
This is an alist that maps file extension to content type.
Useful for podcasting."
:type '(alist :key-type string :value-type string)
:group 'muse-journal)
(defcustom muse-journal-rss-summarize-entries nil
"If non-nil, include only summaries in the RSS file, not the full data.
The default is nil, because this annoys some subscribers."
:type 'boolean
:group 'muse-journal)
(defcustom muse-journal-rss-markup-regexps
'((10000 muse-explicit-link-regexp 0 "\\2"))
"List of markup rules for publishing a Muse journal page to RSS 2.0.
For more information on the structure of this list, see
`muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-journal)
(defcustom muse-journal-rss-markup-functions
'((email . ignore)
(link . ignore)
(url . ignore))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-journal)
(defun muse-journal-anchorize-title (title)
"This strips tags from TITLE, truncates TITLE at begin parenthesis,
and escapes any remaining non-alphanumeric characters."
(save-match-data
(if (string-match "(" title)
(setq title (substring title 0 (match-beginning 0))))
(if (string-match "<[^>]+>" title)
(setq title (replace-match "" nil nil title)))
(let (pos code len ch)
(while (setq pos (string-match (concat "[^" muse-regexp-alnum "_]")
title pos))
(setq ch (aref title pos)
code (format "%%%02X" (cond ((fboundp 'char-to-ucs)
(char-to-ucs ch))
((fboundp 'char-to-int)
(char-to-int ch))
(t ch)))
len (length code)
title (concat (substring title 0 pos)
code
(when (< pos (length title))
(substring title (1+ pos) nil)))
pos (+ len pos)))
title)))
(defun muse-journal-sort-entries (&optional direction)
(interactive "P")
(sort-subr
direction
(function
(lambda ()
(if (re-search-forward "^\\* [0-9]+" nil t)
(goto-char (match-beginning 0))
(goto-char (point-max)))))
(function
(lambda ()
(if (re-search-forward "^\\* [0-9]+" nil t)
(goto-char (1- (match-beginning 0)))
(goto-char (point-max)))))
(function
(lambda ()
(forward-char 2)))
(function
(lambda ()
(end-of-line)))))
(defun muse-journal-qotd-tag (beg end)
(muse-publish-ensure-block beg end)
(muse-insert-markup (muse-markup-text 'begin-quote))
(muse-insert-markup (muse-markup-text 'begin-quote-item))
(goto-char end)
(muse-insert-markup (muse-markup-text 'end-quote-item))
(muse-insert-markup (muse-markup-text 'end-quote)))
(defun muse-journal-html-munge-buffer ()
(goto-char (point-min))
(let ((heading-regexp muse-journal-html-heading-regexp)
(inhibit-read-only t))
(while (re-search-forward heading-regexp nil t)
(let* ((date (match-string 1))
(orig-date date)
(title (match-string 2))
(clean-title title)
datestamp qotd text)
(delete-region (match-beginning 0) (match-end 0))
(if clean-title
(save-match-data
(while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title)
(setq clean-title (replace-match "" nil nil clean-title)))))
(save-match-data
(when (and date
(string-match
(concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?"
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
(setq datestamp
(encode-time
0 0 0
(string-to-number (match-string 3 date))
(string-to-number (match-string 2 date))
(string-to-number (match-string 1 date))
nil)
date (concat (format-time-string
muse-journal-date-format datestamp)
(substring date (match-end 0))))))
(save-restriction
(narrow-to-region
(point) (if (re-search-forward
(concat "\\(^<hr>$\\|"
heading-regexp "\\)") nil t)
(match-beginning 0)
(point-max)))
(goto-char (point-max))
(while (and (not (bobp))
(eq ?\ (char-syntax (char-before))))
(delete-char -1))
(goto-char (point-min))
(while (and (not (eobp))
(eq ?\ (char-syntax (char-after))))
(delete-char 1))
(save-excursion
(when (search-forward "<qotd>" nil t)
(let ((tag-beg (match-beginning 0))
(beg (match-end 0))
end)
(re-search-forward "</qotd>\n*")
(setq end (point-marker))
(save-restriction
(narrow-to-region beg (match-beginning 0))
(muse-publish-escape-specials (point-min) (point-max)
nil 'document)
(setq qotd (buffer-substring-no-properties
(point-min) (point-max))))
(delete-region tag-beg end)
(set-marker end nil))))
(setq text (buffer-string))
(delete-region (point-min) (point-max))
(let ((entry muse-journal-html-entry-template))
(muse-insert-file-or-string entry)
(muse-publish-mark-read-only (point-min) (point-max))
(goto-char (point-min))
(while (search-forward "%date%" nil t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(replace-match (or date "") nil t))
(goto-char (point-min))
(while (search-forward "%title%" nil t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(replace-match (or title "&nbsp;") nil t))
(goto-char (point-min))
(while (search-forward "%anchor%" nil t)
(replace-match (muse-journal-anchorize-title
(or clean-title orig-date))
nil t))
(goto-char (point-min))
(while (search-forward "%qotd%" nil t)
(save-restriction
(narrow-to-region (match-beginning 0) (match-end 0))
(delete-region (point-min) (point-max))
(when qotd (muse-insert-markup qotd))))
(goto-char (point-min))
(while (search-forward "%text%" nil t)
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(replace-match text nil t))
(when (null qotd)
(goto-char (point-min))
(when (search-forward "<div class=\"entry-qotd\">" nil t)
(let ((beg (match-beginning 0)))
(re-search-forward "</div>\n*" nil t)
(delete-region beg (point))))))))))
;; indicate that we are to continue the :before-end processing
nil)
(defun muse-journal-latex-munge-buffer ()
(goto-char (point-min))
(let ((heading-regexp
(concat "^" (regexp-quote (muse-markup-text 'section))
muse-journal-heading-regexp
(regexp-quote (muse-markup-text 'section-end)) "$"))
(inhibit-read-only t))
(when (re-search-forward heading-regexp nil t)
(goto-char (match-beginning 0))
(sort-subr nil
(function
(lambda ()
(if (re-search-forward heading-regexp nil t)
(goto-char (match-beginning 0))
(goto-char (point-max)))))
(function
(lambda ()
(if (re-search-forward heading-regexp nil t)
(goto-char (1- (match-beginning 0)))
(goto-char (point-max)))))
(function
(lambda ()
(forward-char 2)))
(function
(lambda ()
(end-of-line)))))
(while (re-search-forward heading-regexp nil t)
(let ((date (match-string 1))
(title (match-string 2))
;; FIXME: Nothing is done with qotd
qotd section)
(save-match-data
(when (and date
(string-match
(concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
(setq date (encode-time
0 0 0
(string-to-number (match-string 3 date))
(string-to-number (match-string 2 date))
(string-to-number (match-string 1 date))
nil)
date (format-time-string
muse-journal-date-format date))))
(save-restriction
(narrow-to-region (match-beginning 0) (match-end 0))
(delete-region (point-min) (point-max))
(muse-insert-markup muse-journal-latex-section)
(goto-char (point-min))
(while (search-forward "%title%" nil t)
(replace-match (or title "Untitled") nil t))
(goto-char (point-min))
(while (search-forward "%date%" nil t)
(replace-match (or date "") nil t))))))
(goto-char (point-min))
(let ((subheading-regexp
(concat "^" (regexp-quote (muse-markup-text 'subsection))
"\\([^\n}]+\\)"
(regexp-quote (muse-markup-text 'subsection-end)) "$"))
(inhibit-read-only t))
(while (re-search-forward subheading-regexp nil t)
(let ((title (match-string 1)))
(save-restriction
(narrow-to-region (match-beginning 0) (match-end 0))
(delete-region (point-min) (point-max))
(muse-insert-markup muse-journal-latex-subsection)
(goto-char (point-min))
(while (search-forward "%title%" nil t)
(replace-match title nil t))))))
;; indicate that we are to continue the :before-end processing
nil)
(defun muse-journal-rss-munge-buffer ()
(goto-char (point-min))
(let ((heading-regexp muse-journal-rss-heading-regexp)
(inhibit-read-only t))
(while (re-search-forward heading-regexp nil t)
(let* ((date (match-string 1))
(orig-date date)
(title (match-string 2))
;; FIXME: Nothing is done with qotd
enclosure qotd desc)
(if title
(save-match-data
(if (string-match muse-explicit-link-regexp title)
(setq enclosure (muse-get-link title)
title (muse-get-link-desc title)))))
(save-match-data
(when (and date
(string-match
(concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
"\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
(setq date (encode-time 0 0 0
(string-to-number (match-string 3 date))
(string-to-number (match-string 2 date))
(string-to-number (match-string 1 date))
nil)
;; make sure that date is in a format that RSS
;; readers can handle
date (let ((system-time-locale "C"))
(format-time-string
(muse-style-element :date-format) date)))))
(save-restriction
(narrow-to-region
(match-beginning 0)
(if (re-search-forward heading-regexp nil t)
(match-beginning 0)
(if (re-search-forward "^Footnotes:" nil t)
(match-beginning 0)
(point-max))))
(goto-char (point-min))
(delete-region (point) (muse-line-end-position))
(re-search-forward "</qotd>\n+" nil t)
(while (and (char-after)
(eq ?\ (char-syntax (char-after))))
(delete-char 1))
(let ((beg (point)))
(if (muse-style-element :summarize)
(progn
(forward-sentence 2)
(setq desc (concat (buffer-substring beg (point)) "...")))
(save-restriction
(muse-publish-markup-buffer "rss-entry" "journal-rss-entry")
(goto-char (point-min))
(if (re-search-forward "Page published by Emacs Muse" nil t)
(goto-char (muse-line-end-position))
(muse-display-warning
(concat
"Cannot find 'Page published by Emacs Muse begins here'.\n"
"You will probably need this text in your header."))
(goto-char (point-min)))
(setq beg (point))
(if (re-search-forward "Page published by Emacs Muse" nil t)
(goto-char (muse-line-beginning-position))
(muse-display-warning
(concat
"Cannot find 'Page published by Emacs Muse ends here'.\n"
"You will probably need this text in your footer."))
(goto-char (point-max)))
(setq desc (buffer-substring beg (point))))))
(unless (string= desc "")
(setq desc (concat "<![CDATA[" desc "]]>")))
(delete-region (point-min) (point-max))
(let ((entry (muse-style-element :entry-template)))
(muse-insert-file-or-string entry)
(goto-char (point-min))
(while (search-forward "%date%" nil t)
(replace-match (or date "") nil t))
(goto-char (point-min))
(while (search-forward "%title%" nil t)
(replace-match "")
(save-restriction
(narrow-to-region (point) (point))
(insert (or title "Untitled"))
(remove-text-properties (match-beginning 0) (match-end 0)
'(read-only nil rear-nonsticky nil))
(let ((muse-publishing-current-style (muse-style "html")))
(muse-publish-escape-specials (point-min) (point-max)
nil 'document))))
(goto-char (point-min))
(while (search-forward "%desc%" nil t)
(replace-match desc nil t))
(goto-char (point-min))
(while (search-forward "%enclosure%" nil t)
(replace-match
(if (null enclosure)
""
(save-match-data
(format
"<enclosure url=\"%s\" %stype=\"%s\"/>"
(if (string-match "//" enclosure)
enclosure
(concat (muse-style-element :base-url)
enclosure))
(let ((file
(expand-file-name enclosure
(muse-style-element :path))))
(if (file-readable-p file)
(format "length=\"%d\" "
(nth 7 (file-attributes file)))
""))
(if (string-match "\\.\\([^.]+\\)$" enclosure)
(let* ((ext (match-string 1 enclosure))
(type
(assoc
ext muse-journal-rss-enclosure-types-alist)))
(if type
(cdr type)
"application/octet-stream"))))))
nil t))
(goto-char (point-min))
(while (search-forward "%link%" nil t)
(replace-match
(concat (muse-style-element :base-url)
(concat (muse-page-name)
muse-html-extension))
nil t))
(goto-char (point-min))
(while (search-forward "%anchor%" nil t)
(replace-match
(muse-journal-anchorize-title (or title orig-date))
nil t))
(goto-char (point-min))
(while (search-forward "%maintainer%" nil t)
(replace-match
(or (muse-style-element :maintainer)
(concat "webmaster@" (system-name)))
nil t)))))))
;; indicate that we are to continue the :before-end processing
nil)
;;; Register the Muse Journal Publishers
(muse-derive-style "journal-html" "html"
:before-end 'muse-journal-html-munge-buffer)
(muse-derive-style "journal-xhtml" "xhtml"
:before-end 'muse-journal-html-munge-buffer)
(muse-derive-style "journal-latex" "latex"
:tags 'muse-journal-markup-tags
:before-end 'muse-journal-latex-munge-buffer)
(muse-derive-style "journal-pdf" "pdf"
:tags 'muse-journal-markup-tags
:before-end 'muse-journal-latex-munge-buffer)
(muse-derive-style "journal-book-latex" "book-latex"
;;:nochapters
:tags 'muse-journal-markup-tags
:before-end 'muse-journal-latex-munge-buffer)
(muse-derive-style "journal-book-pdf" "book-pdf"
;;:nochapters
:tags 'muse-journal-markup-tags
:before-end 'muse-journal-latex-munge-buffer)
(muse-define-style "journal-rdf"
:suffix 'muse-journal-rdf-extension
:regexps 'muse-journal-rss-markup-regexps
:functions 'muse-journal-rss-markup-functions
:before 'muse-journal-rss-munge-buffer
:header 'muse-journal-rdf-header
:footer 'muse-journal-rdf-footer
:date-format 'muse-journal-rdf-date-format
:entry-template 'muse-journal-rdf-entry-template
:base-url 'muse-journal-rdf-base-url
:summarize 'muse-journal-rdf-summarize-entries)
(muse-define-style "journal-rss"
:suffix 'muse-journal-rss-extension
:regexps 'muse-journal-rss-markup-regexps
:functions 'muse-journal-rss-markup-functions
:before 'muse-journal-rss-munge-buffer
:header 'muse-journal-rss-header
:footer 'muse-journal-rss-footer
:date-format 'muse-journal-rss-date-format
:entry-template 'muse-journal-rss-entry-template
:base-url 'muse-journal-rss-base-url
:summarize 'muse-journal-rss-summarize-entries)
;; Used by `muse-journal-rss-munge-buffer' to mark up individual entries
(muse-derive-style "journal-rss-entry" "html"
:tags 'muse-journal-markup-tags)
(provide 'muse-journal)
;;; muse-journal.el ends here

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

@ -1,669 +0,0 @@
;;; 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
View file

@ -1,277 +0,0 @@
;; 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
View file

File diff suppressed because it is too large Load diff

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

@ -1,263 +0,0 @@
;;; 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
View file

@ -1,973 +0,0 @@
;;; 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
View file

@ -1,251 +0,0 @@
;;; 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
View file

File diff suppressed because it is too large Load diff

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

@ -1,270 +0,0 @@
;;; 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
View file

@ -1,346 +0,0 @@
;;; 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
View file

@ -1,498 +0,0 @@
;;; 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
View file

@ -1,201 +0,0 @@
;;; muse-xml-common.el --- common routines for XML-like publishing styles
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 3, or (at your
;; option) any later version.
;; Emacs Muse is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Contributors:
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse XML Publishing - Common Elements
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-regexps)
(defcustom muse-xml-encoding-map
'((iso-8859-1 . "iso-8859-1")
(iso-2022-jp . "iso-2022-jp")
(utf-8 . "utf-8")
(japanese-iso-8bit . "euc-jp")
(chinese-big5 . "big5")
(mule-utf-8 . "utf-8")
(chinese-iso-8bit . "gb2312")
(chinese-gbk . "gbk"))
"An alist mapping Emacs coding systems to appropriate XML charsets.
Use the base name of the coding system (i.e. without the -unix)."
:type '(alist :key-type coding-system :value-type string)
:group 'muse-xml)
(defun muse-xml-transform-content-type (content-type default)
"Using `muse-xml-encoding-map', try and resolve an Emacs coding
system to an associated XML coding system.
If no match is found, the DEFAULT charset is used instead."
(let ((match (and (fboundp 'coding-system-base)
(assoc (coding-system-base content-type)
muse-xml-encoding-map))))
(if match
(cdr match)
default)))
(defcustom muse-xml-markup-specials
'((?\" . "&quot;")
(?\< . "&lt;")
(?\> . "&gt;")
(?\& . "&amp;"))
"A table of characters which must be represented specially."
:type '(alist :key-type character :value-type string)
:group 'muse-xml)
(defcustom muse-xml-markup-specials-url-extra
'((?\" . "&quot;")
(?\< . "&lt;")
(?\> . "&gt;")
(?\& . "&amp;")
(?\ . "%20")
(?\n . "%0D%0A"))
"A table of characters which must be represented specially.
These are extra characters that are escaped within URLs."
:type '(alist :key-type character :value-type string)
:group 'muse-xml)
(defun muse-xml-decide-specials (context)
"Determine the specials to escape, depending on CONTEXT."
(cond ((memq context '(email url image))
'muse-xml-escape-url)
((eq context 'url-extra)
muse-xml-markup-specials-url-extra)
(t muse-xml-markup-specials)))
(defun muse-xml-escape-url (str)
"Convert to character entities any non-alphanumeric characters
outside a few punctuation symbols, that risk being misinterpreted
if not escaped."
(when str
(setq str (muse-publish-escape-specials-in-string str 'url-extra))
(let (pos code len ch)
(save-match-data
(while (setq pos (string-match (concat "[^-"
muse-regexp-alnum
"/:._=@\\?~#%\"\\+<>()&;]")
str pos))
(setq ch (aref str pos)
code (concat "&#" (int-to-string
(cond ((fboundp 'char-to-ucs)
(char-to-ucs ch))
((fboundp 'char-to-int)
(char-to-int ch))
(t ch)))
";")
len (length code)
str (concat (substring str 0 pos)
code
(when (< pos (length str))
(substring str (1+ pos) nil)))
pos (+ len pos)))
str))))
(defun muse-xml-markup-anchor ()
(unless (get-text-property (match-end 1) 'muse-link)
(let ((text (muse-markup-text 'anchor (match-string 2))))
(save-match-data
(skip-chars-forward (concat muse-regexp-blank "\n"))
(when (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>"))
(goto-char (match-end 0)))
(muse-insert-markup text)))
(match-string 1)))
(defun muse-xml-sort-table (table)
"Sort the given table structure so that it validates properly."
;; Note that the decision matrix must have a nil diagonal, or else
;; elements with the same type will be reversed with respect to each
;; other.
(let ((decisions '((nil nil nil) ; body < header, body < footer
(t nil t) ; header stays where it is
(t nil nil)))) ; footer < header
(sort table #'(lambda (l r)
(and (integerp (car l)) (integerp (car r))
(nth (1- (car r))
(nth (1- (car l)) decisions)))))))
(defun muse-xml-markup-table (&optional attributes)
"Publish the matched region into a table.
If a string ATTRIBUTES is given, pass it to the markup string begin-table."
(let* ((table-info (muse-publish-table-fields (match-beginning 0)
(match-end 0)))
(row-len (car table-info))
(supports-group (not (string= (muse-markup-text 'begin-table-group
row-len)
"")))
(field-list (muse-xml-sort-table (cdr table-info)))
last-part)
(when table-info
(let ((beg (point)))
(muse-publish-ensure-block beg))
(muse-insert-markup (muse-markup-text 'begin-table (or attributes "")))
(muse-insert-markup (muse-markup-text 'begin-table-group row-len))
(dolist (fields field-list)
(let* ((type (car fields))
(part (cond ((eq type 'hline) nil)
((= type 1) "tbody")
((= type 2) "thead")
((= type 3) "tfoot")))
(col (cond ((eq type 'hline) nil)
((= type 1) "td")
((= type 2) "th")
((= type 3) "td"))))
(setq fields (cdr fields))
(unless (and part last-part (string= part last-part))
(when last-part
(muse-insert-markup " </" last-part ">\n")
(when (eq type 'hline)
;; horizontal separators are represented by closing
;; the current table group and opening a new one
(muse-insert-markup (muse-markup-text 'end-table-group))
(muse-insert-markup (muse-markup-text 'begin-table-group
row-len))))
(when part
(muse-insert-markup " <" part ">\n"))
(setq last-part part))
(unless (eq type 'hline)
(muse-insert-markup (muse-markup-text 'begin-table-row))
(dolist (field fields)
(muse-insert-markup (muse-markup-text 'begin-table-entry col))
(insert field)
(muse-insert-markup (muse-markup-text 'end-table-entry col)))
(muse-insert-markup (muse-markup-text 'end-table-row)))))
(when last-part
(muse-insert-markup " </" last-part ">\n"))
(muse-insert-markup (muse-markup-text 'end-table-group))
(muse-insert-markup (muse-markup-text 'end-table))
(insert ?\n))))
(defun muse-xml-prepare-buffer ()
(set (make-local-variable 'muse-publish-url-transforms)
(cons 'muse-xml-escape-string muse-publish-url-transforms)))
(provide 'muse-xml-common)
;;; muse-xml-common.el ends here

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

@ -1,274 +0,0 @@
;;; muse-xml.el --- publish XML files
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Michael Olson <mwolson@gnu.org>
;; Date: Sat 23-Jul-2005
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 3, or (at your
;; option) any later version.
;; Emacs Muse is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; James Clarke's nxml-mode can be used for editing and validating
;; Muse-generated XML files. If you are in nxml-mode use the command
;; C-c C-s C-f to point to the schema in `contrib/muse.rnc', which
;; comes with Muse. Say yes if you are asked if you want to copy the
;; file to your location. C-c C-s C-a can then be used to reload the
;; schema if you make changes to the file.
;;; Contributors:
;; Peter K. Lee (saint AT corenova DOT com) made the initial
;; implementation of planner-publish.el, which was heavily borrowed
;; from.
;; Brad Collins (brad AT chenla DOT org) provided a Compact RelaxNG
;; schema.
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Muse XML Publishing
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'muse-publish)
(require 'muse-regexps)
(require 'muse-xml-common)
(defgroup muse-xml nil
"Options controlling the behavior of Muse XML publishing.
See `muse-xml' for more information."
:group 'muse-publish)
(defcustom muse-xml-extension ".xml"
"Default file extension for publishing XML files."
:type 'string
:group 'muse-xml)
(defcustom muse-xml-header
"<?xml version=\"1.0\" encoding=\"<lisp>
(muse-xml-encoding)</lisp>\"?>
<MUSE>
<pageinfo>
<title><lisp>(muse-publishing-directive \"title\")</lisp></title>
<author><lisp>(muse-publishing-directive \"author\")</lisp></author>
<maintainer><lisp>(muse-style-element :maintainer)</lisp></maintainer>
<pubdate><lisp>(muse-publishing-directive \"date\")</lisp></pubdate>
</pageinfo>
<!-- Page published by Emacs Muse begins here -->\n"
"Header used for publishing XML files.
This may be text or a filename."
:type 'string
:group 'muse-xml)
(defcustom muse-xml-footer "
<!-- Page published by Emacs Muse ends here -->
</MUSE>\n"
"Footer used for publishing XML files.
This may be text or a filename."
:type 'string
:group 'muse-xml)
(defcustom muse-xml-markup-regexps
`(;; Beginning of doc, end of doc, or plain paragraph separator
(10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*"
"\\([" muse-regexp-blank "]*\n\\)\\)"
"\\|\\`\\s-*\\|\\s-*\\'\\)")
;; this is somewhat repetitive because we only require the
;; line just before the paragraph beginning to be not
;; read-only
3 muse-xml-markup-paragraph))
"List of markup rules for publishing a Muse page to XML.
For more on the structure of this list, see `muse-publish-markup-regexps'."
:type '(repeat (choice
(list :tag "Markup rule"
integer
(choice regexp symbol)
integer
(choice string function symbol))
function))
:group 'muse-xml)
(defcustom muse-xml-markup-functions
'((anchor . muse-xml-markup-anchor)
(table . muse-xml-markup-table))
"An alist of style types to custom functions for that kind of text.
For more on the structure of this list, see
`muse-publish-markup-functions'."
:type '(alist :key-type symbol :value-type function)
:group 'muse-xml)
(defcustom muse-xml-markup-strings
'((image-with-desc . "<image href=\"%s.%s\">%s</image>")
(image . "<image href=\"%s.%s\"></image>")
(image-link . "<link type=\"image\" href=\"%s\">%s.%s</link>")
(anchor-ref . "<link type=\"url\" href=\"#%s\">%s</link>")
(url . "<link type=\"url\" href=\"%s\">%s</link>")
(link . "<link type=\"url\" href=\"%s\">%s</link>")
(link-and-anchor . "<link type=\"url\" href=\"%s#%s\">%s</link>")
(email-addr . "<link type=\"email\" href=\"%s\">%s</link>")
(anchor . "<anchor id=\"%s\" />\n")
(emdash . "%s--%s")
(comment-begin . "<!-- ")
(comment-end . " -->")
(rule . "<hr />")
(fn-sep . "<hr />\n")
(no-break-space . "&nbsp;")
(line-break . "<br>")
(enddots . "....")
(dots . "...")
(section . "<section level=\"1\"><title>")
(section-end . "</title>")
(subsection . "<section level=\"2\"><title>")
(subsection-end . "</title>")
(subsubsection . "<section level=\"3\"><title>")
(subsubsection-end . "</title>")
(section-other . "<section level=\"%s\"><title>")
(section-other-end . "</title>")
(section-close . "</section>")
(footnote . "<footnote>")
(footnote-end . "</footnote>")
(begin-underline . "<format type=\"underline\">")
(end-underline . "</format>")
(begin-literal . "<code>")
(end-literal . "</code>")
(begin-emph . "<format type=\"emphasis\" level=\"1\">")
(end-emph . "</format>")
(begin-more-emph . "<format type=\"emphasis\" level=\"2\">")
(end-more-emph . "</format>")
(begin-most-emph . "<format type=\"emphasis\" level=\"3\">")
(end-most-emph . "</format>")
(begin-verse . "<verse>\n")
(begin-verse-line . "<line>")
(end-verse-line . "</line>")
(empty-verse-line . "<line />")
(begin-last-stanza-line . "<line>")
(end-last-stanza-line . "</line>")
(end-verse . "</verse>")
(begin-example . "<example>")
(end-example . "</example>")
(begin-center . "<p><format type=\"center\">\n")
(end-center . "\n</format></p>")
(begin-quote . "<blockquote>\n")
(end-quote . "\n</blockquote>")
(begin-cite . "<cite>")
(begin-cite-author . "<cite type=\"author\">")
(begin-cite-year . "<cite type=\"year\">")
(end-cite . "</cite>")
(begin-quote-item . "<p>")
(end-quote-item . "</p>")
(begin-uli . "<list type=\"unordered\">\n")
(end-uli . "\n</list>")
(begin-uli-item . "<item>")
(end-uli-item . "</item>")
(begin-oli . "<list type=\"ordered\">\n")
(end-oli . "\n</list>")
(begin-oli-item . "<item>")
(end-oli-item . "</item>")
(begin-dl . "<list type=\"definition\">\n")
(end-dl . "\n</list>")
(begin-dl-item . "<item>\n")
(end-dl-item . "\n</item>")
(begin-ddt . "<term>")
(end-ddt . "</term>")
(begin-dde . "<definition>")
(end-dde . "</definition>")
(begin-table . "<table%s>\n")
(end-table . "</table>")
(begin-table-row . " <tr>\n")
(end-table-row . " </tr>\n")
(begin-table-entry . " <%s>")
(end-table-entry . "</%s>\n"))
"Strings used for marking up text.
These cover the most basic kinds of markup, the handling of which
differs little between the various styles."
:type '(alist :key-type symbol :value-type string)
:group 'muse-xml)
(defcustom muse-xml-encoding-default 'utf-8
"The default Emacs buffer encoding to use in published files.
This will be used if no special characters are found."
:type 'symbol
:group 'muse-xml)
(defcustom muse-xml-charset-default "utf-8"
"The default XML charset to use if no translation is
found in `muse-xml-encoding-map'."
:type 'string
:group 'muse-xml)
(defun muse-xml-encoding ()
(muse-xml-transform-content-type
(or (and (boundp 'buffer-file-coding-system)
buffer-file-coding-system)
muse-xml-encoding-default)
muse-xml-charset-default))
(defun muse-xml-markup-paragraph ()
(let ((end (copy-marker (match-end 0) t)))
(goto-char (match-beginning 0))
(when (save-excursion
(save-match-data
(and (not (get-text-property (max (point-min) (1- (point)))
'muse-no-paragraph))
(re-search-backward "<\\(/?\\)p[ >]" nil t)
(not (string-equal (match-string 1) "/")))))
(when (get-text-property (1- (point)) 'muse-end-list)
(goto-char (previous-single-property-change (1- (point))
'muse-end-list)))
(muse-insert-markup "</p>"))
(goto-char end))
(cond
((eobp)
(unless (bolp)
(insert "\n")))
((get-text-property (point) 'muse-no-paragraph)
(forward-char 1)
nil)
((eq (char-after) ?\<)
(when (looking-at (concat "<\\(format\\|code\\|link\\|image"
"\\|anchor\\|footnote\\)[ >]"))
(muse-insert-markup "<p>")))
(t
(muse-insert-markup "<p>"))))
(defun muse-xml-finalize-buffer ()
(when (boundp 'buffer-file-coding-system)
(when (memq buffer-file-coding-system '(no-conversion undecided-unix))
;; make it agree with the default charset
(setq buffer-file-coding-system muse-xml-encoding-default))))
;;; Register the Muse XML Publisher
(muse-define-style "xml"
:suffix 'muse-xml-extension
:regexps 'muse-xml-markup-regexps
:functions 'muse-xml-markup-functions
:strings 'muse-xml-markup-strings
:specials 'muse-xml-decide-specials
:after 'muse-xml-finalize-buffer
:header 'muse-xml-header
:footer 'muse-xml-footer
:browser 'find-file)
(provide 'muse-xml)
;;; muse-xml.el ends here

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

@ -1,881 +0,0 @@
;;; 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

1061
emacs.d/elisp/popup.el
View file

File diff suppressed because it is too large Load diff

1932
emacs.d/elisp/tabbar.el
View file

File diff suppressed because it is too large Load diff

1179
emacs.d/elisp/zenburn.el
View file

File diff suppressed because it is too large Load diff