[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 2e76655: Convert the last :subtrees listed in externals-li
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] master 2e76655: Convert the last :subtrees listed in externals-list |
|
Date: |
Sat, 28 Nov 2020 00:36:23 -0500 (EST) |
branch: master
commit 2e76655fa8c9aa34513d64fca40ba64cac3bd04a
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
Convert the last :subtrees listed in externals-list
This affects the following packages:
bug-hunter cobol-mode dbus-codegen enwc gnorb muse pinentry vlf
---
externals-list | 22 +-
packages/bug-hunter/README.org | 92 -
packages/bug-hunter/bug-hunter.el | 533 ---
packages/cobol-mode/cobol-mode.el | 3096 --------------
packages/dbus-codegen/dbus-codegen.el | 942 -----
packages/dbus-codegen/tests/dbus-codegen-tests.el | 130 -
packages/enwc/.bzrignore | 1 -
packages/enwc/.hgignore | 4 -
packages/enwc/.hgtags | 7 -
packages/enwc/COPYING | 674 ---
packages/enwc/Makefile | 59 -
packages/enwc/doc/enwc.texi | 78 -
packages/enwc/doc/fdl.texi | 505 ---
packages/enwc/doc/version.texi | 4 -
packages/enwc/enwc-backend.el | 157 -
packages/enwc/enwc-cm.el | 372 --
packages/enwc/enwc-edit.el | 434 --
packages/enwc/enwc-nm.el | 725 ----
packages/enwc/enwc-test.el | 66 -
packages/enwc/enwc-wicd.el | 483 ---
packages/enwc/enwc.el | 835 ----
packages/gnorb/.elpaignore | 1 -
packages/gnorb/.gitignore | 5 -
packages/gnorb/NEWS | 47 -
packages/gnorb/README.org | 116 -
packages/gnorb/dir | 18 -
packages/gnorb/gnorb-bbdb.el | 637 ---
packages/gnorb/gnorb-gnus.el | 1271 ------
packages/gnorb/gnorb-helm.el | 109 -
packages/gnorb/gnorb-org.el | 837 ----
packages/gnorb/gnorb-registry.el | 343 --
packages/gnorb/gnorb-utils.el | 682 ---
packages/gnorb/gnorb.el | 41 -
packages/gnorb/gnorb.info | 858 ----
packages/gnorb/gnorb.org | 609 ---
packages/gnorb/gnorb.texi | 819 ----
packages/gnorb/nngnorb.el | 194 -
packages/muse/README | 7 -
packages/muse/cgi.el | 218 -
packages/muse/dir | 18 -
packages/muse/htmlize-hack.el | 20 -
packages/muse/httpd.el | 288 --
packages/muse/muse-backlink.el | 327 --
packages/muse/muse-blosxom.el | 307 --
packages/muse/muse-book.el | 284 --
packages/muse/muse-colors.el | 1019 -----
packages/muse/muse-context.el | 458 --
packages/muse/muse-docbook.el | 352 --
packages/muse/muse-groff.el | 274 --
packages/muse/muse-html.el | 756 ----
packages/muse/muse-http.el | 239 --
packages/muse/muse-ikiwiki.el | 219 -
packages/muse/muse-import-docbook.el | 137 -
packages/muse/muse-import-latex.el | 149 -
packages/muse/muse-import-xml.el | 88 -
packages/muse/muse-ipc.el | 194 -
packages/muse/muse-journal.el | 774 ----
packages/muse/muse-latex.el | 669 ---
packages/muse/muse-latex2png.el | 277 --
packages/muse/muse-mode.el | 1012 -----
packages/muse/muse-poem.el | 263 --
packages/muse/muse-project.el | 979 -----
packages/muse/muse-protocols.el | 251 --
packages/muse/muse-publish.el | 2195 ----------
packages/muse/muse-regexps.el | 270 --
packages/muse/muse-texinfo.el | 346 --
packages/muse/muse-wiki.el | 498 ---
packages/muse/muse-xml-common.el | 201 -
packages/muse/muse-xml.el | 274 --
packages/muse/muse.el | 881 ----
packages/muse/muse.info | 4656 ---------------------
packages/muse/texi/Makefile | 29 -
packages/muse/texi/dir-template | 15 -
packages/muse/texi/doclicense.texi | 416 --
packages/muse/texi/muse.texi | 4247 -------------------
packages/pinentry/pinentry.el | 460 --
packages/vlf/vlf-base.el | 456 --
packages/vlf/vlf-ediff.el | 331 --
packages/vlf/vlf-follow.el | 85 -
packages/vlf/vlf-occur.el | 481 ---
packages/vlf/vlf-search.el | 355 --
packages/vlf/vlf-setup.el | 160 -
packages/vlf/vlf-tune.el | 464 --
packages/vlf/vlf-write.el | 202 -
packages/vlf/vlf.el | 364 --
85 files changed, 10 insertions(+), 42761 deletions(-)
diff --git a/externals-list b/externals-list
index dfe6402..84a0087 100644
--- a/externals-list
+++ b/externals-list
@@ -6,7 +6,6 @@
;; Where NAME is the name of the package;
;;
;; KIND can be one of:
-;; :subtree = a "git subtree" in the `master' branch.
;; :external = kept in a separate `externals/<name>' branch.
;; :core = part of GNU Emacs repository.
;;
@@ -14,8 +13,7 @@
;; For KIND :external URL is the URL of the remote git repository that we want
;; to track, or `nil' if there is no upstream, i.e., if development of this
;; package takes place directly on the `externals/<name>' branch of the
-;; `elpa.git' repository. In the case of :subtree URL is useless. For
packages
-;; of KIND :core URL must be a list of:
+;; `elpa.git' repository. For packages of KIND :core URL must be a list of:
;; STRING = A file-name to copy from Emacs repo.
;; (STRING STRING) = A file-name to copy renamed from Emacs repo.
@@ -40,7 +38,7 @@
("bluetooth" :external "https://gitlab.com/rstocker/emacs-bluetooth";)
("bnf-mode" :external "https://github.com/sergeyklay/bnf-mode";)
("buffer-expose" :external "https://github.com/clemera/buffer-expose";)
- ("bug-hunter" :subtree
"https://github.com/Malabarba/elisp-bug-hunter";)
+ ("bug-hunter" :external
"https://github.com/Malabarba/elisp-bug-hunter";)
;;FIXME:("cedet" :external "??")
;; ("cc-mode" :core ("lisp/progmodes/cc-align.el"
;; "lisp/progmodes/cc-awk.el"
@@ -59,7 +57,7 @@
;; ;; the .info file from this texi file!
;; "doc/misc/cc-mode.texi"))
("chess" :external nil) ;; Was
https://github.com/jwiegley/emacs-chess.git
- ;; ("cobol-mode" :subtree
"https://gist.github.com/Edward-H/6768e7dc53ea3dd2adca";)
+ ("cobol-mode" :external
"https://gist.github.com/Edward-H/6768e7dc53ea3dd2adca";)
("cl-print" :core "lisp/emacs-lisp/cl-print.el")
("clipboard-collector" :external
"https://github.com/clemera/clipboard-collector";)
("coffee-mode" :external
"https://github.com/defunkt/coffee-mode";)
@@ -70,7 +68,7 @@
("cpio-mode" :external "https://github.com/dlewan/cpio-mode";)
("darkroom" :external
"https://github.com/capitaomorte/darkroom.git";)
("dash" :external "https://github.com/magnars/dash.el.git";)
- ("dbus-codegen" :subtree "https://github.com/ueno/dbus-codegen-el.git";)
+ ("dbus-codegen" :external "https://github.com/ueno/dbus-codegen-el.git";)
("delight" :external "https://git.savannah.gnu.org/r/delight.git";)
("diffview" :external
"https://github.com/mgalgs/diffview-mode.git";)
("diff-hl" :external "https://github.com/dgutov/diff-hl.git";)
@@ -86,7 +84,7 @@
("eldoc-eval" :external
"https://github.com/thierryvolpiatto/eldoc-eval.git";)
("elisp-benchmarks" :external nil)
("emms" :external "https://git.savannah.gnu.org/git/emms.git";)
- ("enwc" :subtree
"bzr::bzr://bzr.savannah.nongnu.org/enwc/trunk")
+ ("enwc" :external
"hg::https://hg.savannah.nongnu.org/hgweb/enwc/";)
("ergoemacs-mode" :external
"https://github.com/ergoemacs/ergoemacs-mode.git";)
("expand-region" :external "https://github.com/magnars/expand-region.el";)
("exwm" :external "https://github.com/ch11ng/exwm.git";)
@@ -96,7 +94,7 @@
("gcmh" :external "https://gitlab.com/koral/gcmh";)
("ggtags" :external "https://github.com/leoliu/ggtags";)
("gnome-c-style" :external "https://github.com/ueno/gnome-c-style.git";)
- ("gnorb" :subtree "https://github.com/girzel/gnorb";)
+ ("gnorb" :external nil) ;; Was "https://github.com/girzel/gnorb";
("gnu-elpa" :external nil)
("gpastel" :external
"https://gitlab.petton.fr/DamienCassou/gpastel";)
("greader" :external
"https://gitlab.com/michelangelo-rodriguez/greader";)
@@ -115,7 +113,7 @@
("mmm-mode" :external "https://github.com/purcell/mmm-mode.git";)
("modus-operandi-theme":external
"https://gitlab.com/protesilaos/modus-themes";)
("modus-vivendi-theme" :external
"https://gitlab.com/protesilaos/modus-themes";)
- ("muse" :subtree "https://github.com/alexott/muse";)
+ ("muse" :external "https://github.com/alexott/muse";) ;FIXME:
Not nearly in-sync
("nameless" :external "https://github.com/Malabarba/Nameless";)
("names" :external "http://github.com/Malabarba/names";)
("objed" :external "https://github.com/clemera/objed";)
@@ -129,7 +127,7 @@
("peg" :external) ;Was in
"https://github.com/ellerh/peg.el";
("persist" :external "https://gitlab.com/phillord/persist.git";)
("phps-mode" :external
"https://github.com/cjohansson/emacs-phps-mode";)
- ("pinentry" :subtree "https://github.com/ueno/pinentry-el.git";)
+ ("pinentry" :external "https://github.com/ueno/pinentry-el.git";)
("posframe" :external "https://github.com/tumashu/posframe";)
("prefixed-core" :external nil)
("project" :core "lisp/progmodes/project.el")
@@ -139,7 +137,7 @@
;; --index-filter "git read-tree --empty; \
;; git reset \$GIT_COMMIT -- pspp-mode.el" \
;; -- -- pspp-mode.el
- ("pspp-mode" :external "https://git.sv.gnu.org/r/pspp.git";)
+ ("pspp-mode" :external nil) ;; Was
"https://git.sv.gnu.org/r/pspp.git";
("python" :core "lisp/progmodes/python.el")
;;FIXME:("org" :external ??) ;; Need to introduce snapshots!!
("realgud" :external "https://github.com/realgud/realgud";)
@@ -173,7 +171,7 @@
("vcl-mode" :external "git://git.gnu.org.ua/vcl-mode")
("tramp" :external
"https://git.savannah.gnu.org/cgit/tramp.git/?h=elpa";)
("transient" :external "https://github.com/magit/transient";)
- ;;FIXME:("vlf" :subtree ??)
+ ("vlf" :external "https://github.com/m00natic/vlfi";)
("verilog-mode" :core "lisp/progmodes/verilog-mode.el")
("wcheck-mode" :external
"https://github.com/tlikonen/wcheck-mode";)
("web-server" :external
"https://github.com/eschulte/emacs-web-server.git";)
diff --git a/packages/bug-hunter/README.org b/packages/bug-hunter/README.org
deleted file mode 100644
index d8c9463..0000000
--- a/packages/bug-hunter/README.org
+++ /dev/null
@@ -1,92 +0,0 @@
-#+OPTIONS: toc:nil num:nil
-#+TITLE: [[file:hunter.png]] The Bug Hunter
[[https://travis-ci.org/Malabarba/elisp-bug-hunter][file:https://travis-ci.org/Malabarba/elisp-bug-hunter.svg?branch=master]]
-
-/Automatically debug and bisect your init (.emacs) file!/
-
-The Bug Hunter is an Emacs library that finds the source of an error
-or unexpected behavior inside an elisp configuration file (typically
-~init.el~ or ~.emacs~).
-
-[[file:hunter-screencast.gif]]
-
-* Usage Examples
-
-** Automated error hunting
-If your Emacs init file signals an error during startup, but you don’t
-know why, simply issue
-#+BEGIN_SRC text
-M-x bug-hunter-init-file RET e
-#+END_SRC
-and The Bug Hunter will find it for you. Note that your ~init.el~
-(or ~.emacs~) must be idempotent for this to work.
-
-** Interactive hunt
-
-If Emacs starts up without errors but something is not working as it
-should, invoke the same command, but choose the interactive option:
-#+BEGIN_SRC text
-M-x bug-hunter-init-file RET i
-#+END_SRC
-The Bug Hunter will start a separate Emacs instance several times, and
-then it will ask you each time whether that instance presented the
-problem you have. After doing this about 5--12 times, you’ll be given
-the results.
-
-** Assertion hunt
-
-The Bug Hunter can also find your issue based on an assertion.
-Essentially, if you can write a code snippet that returns non-nil when
-it detects the issue, just provide this snippet as the assertion and
-the Bug Hunter will do the rest.
-
-For example, let’s say there’s something in your init file that’s
-loading the ~cl~ library, and you don’t want that. You /know/ you’re
-not loading it yourself, but how can you figure out which external
-package is responsible for this outrage?
-
-#+BEGIN_SRC text
-M-x bug-hunter-init-file RET a (featurep 'cl) RET
-#+END_SRC
-
-*That’s it!* You’ll be given a nice buffer reporting the results:
-
-[[file:cl-example.png]]
-- Are you getting obscure errors when trying to open /“.tex”/ files?
- - Don’t despair! Just use ~(find-file "dummy.tex")~ as the assertion.
-- Did ~ox-html~ stop working due to some arcane misconfiguration?
- - Just write an assertion that does an export and checks the result.
-- Does some random command suddenly bind itself to ~C-j~ and you can’t figure
out why?
- - ~(eq (key-binding "\n") 'unwanted-command)~ is the assertion for you!
-
-Finally, you can also use ~bug-hunter-file~ to hunt in other files.
-
-* Installation
-The Bug Hunter is available from
[[https://elpa.gnu.org/packages/bug-hunter.html][GNU Elpa]] to all Emacs
versions since
-~24.1~. To install, just issue
-
-#+BEGIN_SRC text
-M-x package-install RET bug-hunter
-#+END_SRC
-
-* init.org and other literate-style configs
-
-Some people (me included) like to organize their init files by
-writting it in ~org-mode~ instead of Emacs-Lisp. This usually involves
-adding something like this to ~init.el~,
-#+BEGIN_SRC emacs-lisp
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Maybe some code up here ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(require 'org)
-(org-babel-tangle-file "~/.emacs.d/org-init.org"
- "~/.emacs.d/org-init.el")
-(load "~/.emacs.d/org-init.el")
-#+END_SRC
-
-At first, this makes the Bug-Hunter essentially useless, for it will
-do the hunting in ~init.el~ instead of the much more extensive
-~org-init.el~. The name of the second file (~org-init.el~) will vary,
-but the point is the same. But fear not! There’s a simple solution:
-
-1. If you have any code above the call to ~org-babel-tangle-file~, copy that
to the top of ~org-init.el~ (or whatever is the name of your tangled file).
This includes that ~(require 'org)~ over there.
-2. Invoke ~M-x~ ~bug-hunter-file~ (instead of ~bug-hunter-init-file~). It will
ask you which file to debug, and you need to point it to your tangled output
file ~org-init.el~.
diff --git a/packages/bug-hunter/bug-hunter.el
b/packages/bug-hunter/bug-hunter.el
deleted file mode 100644
index 30c2c8e..0000000
--- a/packages/bug-hunter/bug-hunter.el
+++ /dev/null
@@ -1,533 +0,0 @@
-;;; bug-hunter.el --- Hunt down errors by bisecting elisp files -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-;; URL: https://github.com/Malabarba/elisp-bug-hunter
-;; Version: 1.3.1
-;; Keywords: lisp
-;; Package-Requires: ((seq "1.3") (cl-lib "0.5"))
-
-;; 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:
-;; An Emacs library that finds the source of an error or unexpected
-;; behavior inside an elisp configuration file (typically `init.el' or
-;; `.emacs').
-;;
-;; Usage Examples
-;; ==============
-;;
-;; Automated error hunting
-;; ~~~~~~~~~~~~~~~~~~~~~~~
-;;
-;; If your Emacs init file signals an error during startup, but you don’t
-;; know why, simply issue
-;; ,----
-;; | M-x bug-hunter-init-file RET e
-;; `----
-;; and The Bug Hunter will find it for you. Note that your `init.el' (or
-;; `.emacs') must be idempotent for this to work.
-;;
-;;
-;; Interactive hunt
-;; ~~~~~~~~~~~~~~~~
-;;
-;; If Emacs starts up without errors but something is not working as it
-;; should, invoke the same command, but choose the interactive option:
-;; ,----
-;; | M-x bug-hunter-init-file RET i
-;; `----
-;; The Bug Hunter will start a separate Emacs instance several times, and
-;; then it will ask you each time whether that instance presented the
-;; problem you have. After doing this about 5--12 times, you’ll be given
-;; the results.
-;;
-;;
-;; Assertion hunt
-;; ~~~~~~~~~~~~~~
-;;
-;; The Bug Hunter can also find your issue based on an assertion.
-;; Essentially, if you can write a code snippet that returns non-nil when
-;; it detects the issue, just provide this snippet as the assertion and
-;; the Bug Hunter will do the rest.
-;;
-;; For example, let’s say there’s something in your init file that’s
-;; loading the `cl' library, and you don’t want that. You /know/ you’re
-;; not loading it yourself, but how can you figure out which external
-;; package is responsible for this outrage?
-;;
-;; ,----
-;; | M-x bug-hunter-init-file RET a (featurep 'cl) RET
-;; `----
-;;
-;; *That’s it!* You’ll be given a nice buffer reporting the results:
-;;
-;; - Are you getting obscure errors when trying to open /".tex"/ files?
-;; - Don’t despair! Just use `(find-file "dummy.tex")' as the
-;; assertion.
-;; - Did `ox-html' stop working due to some arcane misconfiguration?
-;; - Just write an assertion that does an export and checks the result.
-;; - Does some random command suddenly bind itself to `C-j' and you can’t
-;; figure out why?
-;; - `(eq (key-binding "\n") 'unwanted-command)' is the assertion for
-;; you!
-;;
-;; Finally, you can also use `bug-hunter-file' to hunt in other files.
-;;
-;;
-;; init.org and other literate-style configs
-;; =========================================
-;;
-;; Please see the full Readme on http://github.com/Malabarba/elisp-bug-hunter
-
-;;; Code:
-(require 'seq)
-(require 'cl-lib)
-
-(defconst bug-hunter--interactive-explanation
- "You have asked to do an interactive hunt, here's how it goes.
-1) I will start a new Emacs instance, which opens a new frame.
-2) You will try to reproduce your problem on the new frame.
-3) When you’re done, close that frame.
-4) I will ask you if you managed to reproduce the problem.
-5) We will repeat steps up to %s times, so hang tight!")
-
-(defconst bug-hunter--assertion-reminder
- "Remember, the assertion must be an expression that returns
-non-nil in your current (problematic) Emacs state, AND that
-returns nil on a clean Emacs instance.
-If you're unsure how to write an assertion, you can try the interactive
-hunt instead, or see some examples in the Readme:
- https://github.com/Malabarba/elisp-bug-hunter";
- "Printed to the user if they provide a bad assertion.")
-
-(defvar bug-hunter--current-head nil
- "Current list of expressions under scrutiny. Used for user feedback.
-Used if the user aborts before bisection ends.")
-
-(defvar bug-hunter--i 0
- "Current step of the bisection. Used for user feedback.")
-(defvar bug-hunter--estimate 0
- "Estimate on how many steps the bisection can take. Used for user feedback.
-This is the base 2 log of the number of expressions in the
-file.")
-
-(defvar bug-hunter--current-file nil
- "File currently being debugged.")
-
-(defun bug-hunter--read-buffer ()
- "Return all sexps after point as a list."
- (let (out line col)
- (or (condition-case er
- ;; Looks hacky, but comes from `byte-compile-from-buffer'.
- (while (progn (while (progn (skip-chars-forward " \t\n\^l")
- (looking-at ";"))
- (forward-line 1))
- (not (eobp)))
- (setq line (line-number-at-pos (point)))
- (setq col (current-column))
- (push (list (read (current-buffer)) line col)
- out)
- nil)
- (end-of-file `(bug-caught (end-of-file) ,line ,col))
- (invalid-read-syntax `(bug-caught ,er ,line ,col))
- (error
- (if (string= (elt er 1) "Invalid modifier in string")
- `(bug-caught (invalid-modifier) ,line ,col)
- (error "Ran into an error we don't understand, please file a bug
report: %S" er))))
- (nreverse out))))
-
-(defun bug-hunter--read-contents (file)
- "Return all sexps in FILE as a list."
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (bug-hunter--read-buffer)))
-
-
-;;; Reporting functions
-(defun bug-hunter--report-print (&rest r)
- "Print information on the \"*Bug-Hunter Report*\" buffer.
-R is passed to `format' and inserted."
- (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
- (goto-char (point-max))
- (let ((inhibit-read-only t))
- (insert "\n" (apply #'format r)))))
-
-(defun bug-hunter--report (&rest r)
- "Report arbitrary information.
-R is passed to `bug-hunter--report-print'."
- (declare (indent 1))
- (apply #'bug-hunter--report-print r)
- (redisplay)
- (apply #'message r))
-
-(defun bug-hunter--report-user-error (&rest r)
- "Report the user has done something wrong.
-R is passed to `bug-hunter--report-print'."
- (declare (indent 1))
- (apply #'bug-hunter--report-print r)
- (bug-hunter--report-print "\xc\n")
- (apply #'user-error r))
-
-(defvar compilation-error-regexp-alist)
-(defun bug-hunter--init-report-buffer (assertion steps)
- "Create and prepare the \"*Bug-Hunter Report*\" buffer.
-Also add some descriptions depending on ASSERTION."
- (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
- (let ((inhibit-read-only t))
- (erase-buffer)
- (compilation-mode "Bug Hunt")
- (set (make-local-variable 'compilation-error-regexp-alist)
- '(comma))
- (pcase assertion
- (`interactive (insert (format bug-hunter--interactive-explanation (+ 2
steps))))))
- (current-buffer)))
-
-(defun bug-hunter--pretty-format (value padding)
- "Return a VALUE as a string with PADDING spaces on the left."
- (with-temp-buffer
- (pp value (current-buffer))
- (goto-char (point-min))
- (let ((pad (make-string padding ?\s)))
- (while (not (eobp))
- (insert pad)
- (forward-line 1)))
- (buffer-string)))
-
-(defun bug-hunter--report-error (error line column &optional expression)
- "Print on report buffer information about ERROR.
-LINE and COLUMN are the coordinates where EXPRESSION started in
-the file."
- (when line
- (bug-hunter--report "%S, line %s pos %s:"
- bug-hunter--current-file line column))
- (bug-hunter--report " %s"
- (cl-case (car error)
- (end-of-file
- "There's a missing closing parenthesis, the expression on this line
never ends.")
- (invalid-modifier (concat "There's a string on this line with an invalid
modifier."
- "\n A \"modifier\" is a \\ followed by a few
characters."
- "\n For example, \\C-; is an invalid
modifier."))
- (invalid-read-syntax
- (let ((char (cadr error)))
- (if (member char '("]" ")"))
- (concat "There's an extra " char
- " on this position. There's probably a missing "
- (if (string= char ")") "(" "[")
- " before that.")
- (concat "There's a " char
- " on this position, and that is not valid elisp syntax."))))
- (user-aborted
- (let* ((print-level 2)
- (print-length 15)
- (forms (cadr error))
- (size (length forms)))
- (concat "User aborted while testing the following expressions:\n"
- (mapconcat (lambda (x) (bug-hunter--pretty-format x 4))
- (if (< size 16) forms (seq-take forms 7))
- "")
- (when (> size 16)
- (format "\n ... %s omitted expressions ...\n\n"
- (- size 14)))
- (when (> size 16)
- (mapconcat (lambda (x) (bug-hunter--pretty-format x 4))
- (seq-drop forms (- size 7)) "")))))
- (assertion-triggered
- (concat "The assertion returned the following value here:\n"
- (bug-hunter--pretty-format (cadr error) 4)))
- (t (format "The following error was signaled here:\n %S"
- error))))
- (when expression
- (bug-hunter--report " Caused by the following expression:\n%s"
- (bug-hunter--pretty-format expression 4)))
- (bug-hunter--report "\xc\n")
- `[,error ,line ,column ,expression])
-
-
-;;; Execution functions
-(defun bug-hunter--print-to-temp (sexp)
- "Print SEXP to a temp file and return the file name."
- (let ((print-length nil)
- (print-level nil)
- (file (make-temp-file "bug-hunter")))
- (with-temp-file file
- (print sexp (current-buffer)))
- file))
-
-(defun bug-hunter--run-emacs (file &rest args)
- "Start an Emacs process to run FILE and return the output buffer.
-ARGS are passed before \"-l FILE\"."
- (let ((out-buf (generate-new-buffer "*Bug-Hunter Command*"))
- (exec (file-truename (expand-file-name invocation-name
- invocation-directory))))
- (apply #'call-process exec nil out-buf nil
- (append args (list "-l" file)))
- out-buf))
-
-(defun bug-hunter--run-form (form)
- "Run FORM with \"emacs -Q\" and return the result."
- (let ((file-name (bug-hunter--print-to-temp (list 'prin1 form))))
- (unwind-protect
- (with-current-buffer (bug-hunter--run-emacs file-name "-Q" "--batch")
- (goto-char (point-max))
- (forward-sexp -1)
- (prog1 (read (current-buffer))
- (kill-buffer (current-buffer))))
- (delete-file file-name))))
-
-(defun bug-hunter--run-form-interactively (form)
- "Run FORM in a graphical instance and ask user about the outcome."
- (let ((file-name (bug-hunter--print-to-temp (list 'prin1 form))))
- (unwind-protect
- (bug-hunter--run-emacs file-name "-Q")
- (delete-file file-name))
- (y-or-n-p "Did you find the problem/bug in this instance (if you encounter
some other issue, answer `n')? ")))
-
-(defun bug-hunter--wrap-forms-for-eval (forms)
- "Return FORMS wrapped in initialization code."
- `(let ((server-name (make-temp-file "bug-hunter-temp-server-file")))
- (delete-file server-name)
- (if site-run-file (load site-run-file t t))
- (run-hooks 'before-init-hook)
- ,@forms
- (package-initialize)
- (run-hooks 'after-init-hook)))
-
-(defun bug-hunter--run-and-test (forms assertion)
- "Execute FORMS in the background and test ASSERTION.
-See `bug-hunter' for a description on the ASSERTION.
-
-If ASSERTION is `interactive', the form is run through
-`bug-hunter--run-form-interactively'. Otherwise, a slightly
-modified version of the form combined with ASSERTION is run
-through `bug-hunter--run-form'."
- (if (eq assertion 'interactive)
- (bug-hunter--run-form-interactively
- (bug-hunter--wrap-forms-for-eval forms))
- (bug-hunter--run-form
- `(condition-case er
- ,(append (bug-hunter--wrap-forms-for-eval forms)
- (list assertion))
- (error (cons 'bug-caught er))))))
-
-
-
-;;; The actual bisection
-(defun bug-hunter--split (l)
- "Split list L in two lists of same size."
- (seq-partition l (ceiling (/ (length l) 2.0))))
-
-(defun bug-hunter--bisect (assertion safe head &optional tail)
- "Implementation used by `bug-hunter--bisect-start'.
-ASSERTION is received by `bug-hunter--bisect-start'.
-SAFE is a list of forms confirmed to not match the ASSERTION,
-HEAD is a list of forms to be tested now, and TAIL is a list
-which will be inspected if HEAD doesn't match ASSERTION."
- (message "Testing: %s/%s" (cl-incf bug-hunter--i) bug-hunter--estimate)
- ;; Used if the user quits.
- (setq bug-hunter--current-head head)
- (let ((ret-val (bug-hunter--run-and-test (append safe head) assertion)))
- (cond
- ((not tail)
- (cl-assert ret-val nil)
- (vector (length safe) ret-val))
- ;; Issue in the head.
- ((and ret-val (< (length head) 2))
- (vector (length safe) ret-val))
- (ret-val
- (apply #'bug-hunter--bisect
- assertion
- safe
- (bug-hunter--split head)))
- ;; Issue in the tail.
- (t (apply #'bug-hunter--bisect
- assertion
- (append safe head)
- ;; If tail has length 1, we already know where the issue is,
- ;; but we still do this to get the return value.
- (bug-hunter--split tail))))))
-
-(defun bug-hunter--bisect-start (forms assertion)
- "Run a bisection search on list of FORMS using ASSERTION.
-Returns a vector [n value], where n is the position of the first
-element in FORMS which trigger ASSERTION, and value is the
-ASSERTION's return value.
-
-If ASSERTION is nil, n is the position of the first form to
-signal an error and value is (bug-caught . ERROR-SIGNALED)."
- (let ((bug-hunter--i 0)
- (bug-hunter--current-head nil))
- (condition-case-unless-debug nil
- (apply #'bug-hunter--bisect assertion nil (bug-hunter--split forms))
- (quit `[nil (bug-caught user-aborted ,bug-hunter--current-head)]))))
-
-
-;;; Main functions
-(defun bug-hunter-hunt (rich-forms assertion)
- "Bisect RICH-FORMS using ASSERTION.
-RICH-FORMS is a list with elements of the form: (EXPR LINE COL)
- EXPR is an elisp expression. LINE and COL are the coordinates
- in `bug-hunter--current-file' where the expression starts.
-It is expected that one of EXPR is either throwing an error or
-causing some undesirable effect (which triggers ASSERTION).
-
-ASSERTION is either nil or an expression.
- If nil, EXPRs are bisected until we find the first one that
- throws errors.
- If it is an expression, EXPRs are bisected by testing
- ASSERTION. It should return nil if all is fine (e.g. if used
- with \"emacs -Q\"), and should return non-nil when a problem
- is detected.
-
-Bug hunter will refuse to hunt if (i) an error is signaled or the
-assertion is triggered while running emacs -Q, or (ii) no errors
-are signaled and the assertion is not triggered after all EXPRs
-are evaluated."
- (let ((expressions (unless (eq (car-safe rich-forms) 'bug-caught)
- (mapcar #'car rich-forms)))
- (bug-hunter--estimate (ceiling (log (length rich-forms) 2))))
- ;; Prepare buffer, and make sure they've seen it.
- (switch-to-buffer (bug-hunter--init-report-buffer assertion
bug-hunter--estimate))
- (when (eq assertion 'interactive)
- (read-char-choice "Please read the instructions above and type 6 when
ready. " '(?6)))
-
- (cond
- ;; Check for errors when reading the init file.
- ((not expressions)
- (apply #'bug-hunter--report-error (cdr rich-forms))
- (apply #'vector (cdr rich-forms)))
-
- ;; Make sure there's a bug to hunt.
- ((progn (bug-hunter--report "Doing some initial tests...")
- (not (bug-hunter--run-and-test expressions assertion)))
- (bug-hunter--report-user-error "Test failed.\n%s\n%s"
- (if assertion
- (concat "The assertion returned nil after loading the entire
file.\n"
- bug-hunter--assertion-reminder)
- "No errors signaled after loading the entire file.
-If you're looking for something that's not an error, use the
-interactive hunt instead of the error hunt. If you have some
-elisp proficiency, you can also use the assertion hunt, see this
-link for some examples:
- https://github.com/Malabarba/elisp-bug-hunter";)
- (or assertion "")))
-
- ;; Make sure we're in a forest, not a volcano.
- ((bug-hunter--run-and-test nil assertion)
- (bug-hunter--report-user-error "Test failed.\n%s\n%s"
- (if assertion
- (concat "Assertion returned non-nil even on emacs -Q:"
- bug-hunter--assertion-reminder)
- "Detected a signaled error even on emacs -Q. This could mean three
-things things:
-1. The problem happens inside `package-initialize'.
-2. You wrote the assertion wrong.
-3. There's something seriously wrong with your Emacs installation.")
- (or assertion "")))
-
- (t
- ;; Perform the actual hunt.
- (bug-hunter--report "Initial tests done. Hunting for the cause...")
- (let* ((result (bug-hunter--bisect-start expressions assertion)))
- (if (not result)
- (bug-hunter--report-user-error "No problem was found, despite our
initial tests.\n%s"
- "I have no idea what's going on.")
- (let* ((pos (elt result 0))
- (ret (elt result 1))
- (linecol (when pos (cdr (elt rich-forms pos))))
- (expression (when pos (elt expressions pos))))
- (if (eq (car-safe ret) 'bug-caught)
- (bug-hunter--report-error
- (cdr ret) (car linecol) (cadr linecol) expression)
- (bug-hunter--report-error
- (list 'assertion-triggered ret)
- (car linecol) (cadr linecol) expression)))))))))
-
-(defconst bug-hunter--hunt-type-prompt
- "To bisect interactively, type i
-To use automatic error detection, type e
-To provide a lisp assertion, type a
-=> ")
-
-(defun bug-hunter--read-from-minibuffer ()
- "Read a list of expressions from the minibuffer.
-Wraps them in a progn if necessary to always return a single
-form.
-
-The user may decide to not provide input, in which case
-`interactive' is returned. Note, this is different from the user
-typing RET at an empty prompt, in which case nil is returned."
- (pcase (read-char-choice (if (display-graphic-p)
- bug-hunter--hunt-type-prompt
- (replace-regexp-in-string "To bisect
interactively,.*\n" ""
-
bug-hunter--hunt-type-prompt))
- '(?i ?e ?a))
- (`?i
- (unless (display-graphic-p)
- (user-error "Sorry, but `interactive' bisection needs a graphical
frame"))
- 'interactive)
- (`?e nil)
- (_
- (require 'simple)
- (let ((exprs
- (with-temp-buffer
- ;; Copied from `read--expression'.
- (let ((minibuffer-completing-symbol t))
- (minibuffer-with-setup-hook
- (lambda ()
- (add-hook 'completion-at-point-functions
- (if (fboundp 'elisp-completion-at-point)
- #'elisp-completion-at-point
- (with-no-warnings
- #'lisp-completion-at-point))
- nil t)
- (run-hooks 'eval-expression-minibuffer-setup-hook))
- (insert
- (read-from-minibuffer
- "Provide an assertion. This is a lisp expression that
returns nil if (and only if) everything is fine:\n => "
- nil read-expression-map nil 'read-expression-history))))
- (goto-char (point-min))
- (mapcar #'car (bug-hunter--read-buffer)))))
- (if (cdr exprs)
- (cons #'progn exprs)
- (car exprs))))))
-
-;;;###autoload
-(defun bug-hunter-file (file &optional assertion)
- "Bisect FILE while testing ASSERTION.
-All sexps in FILE are read and passed to `bug-hunter-hunt' as a
-list. See `bug-hunter-hunt' for how to use ASSERTION."
- (interactive
- (list
- (read-file-name "File to bisect: "
- (file-name-directory (or (buffer-file-name) "./"))
- nil t
- (file-name-nondirectory (or (buffer-file-name) "./")))
- (bug-hunter--read-from-minibuffer)))
- (let ((bug-hunter--current-file file))
- (bug-hunter-hunt (bug-hunter--read-contents file) assertion)))
-
-;;;###autoload
-(defun bug-hunter-init-file (&optional assertion)
- "Test ASSERTION throughout `user-init-file'.
-All sexps inside `user-init-file' are read and passed to
-`bug-hunter-hunt' as a list. See `bug-hunter-hunt' for how to use
-ASSERTION."
- (interactive (list (bug-hunter--read-from-minibuffer)))
- (bug-hunter-file user-init-file assertion))
-
-(provide 'bug-hunter)
-;;; bug-hunter.el ends here
diff --git a/packages/cobol-mode/cobol-mode.el
b/packages/cobol-mode/cobol-mode.el
deleted file mode 100644
index f7dcab8..0000000
--- a/packages/cobol-mode/cobol-mode.el
+++ /dev/null
@@ -1,3096 +0,0 @@
-;;; cobol-mode.el --- Mode for editing COBOL code -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
-
-;; Author: Edward Hart <edward.dan.hart@gmail.com>
-;; Maintainer: Edward Hart <edward.dan.hart@gmail.com>
-;; Version: 1.0.0
-;; Created: 9 November 2013
-;; Keywords: languages
-;; Package-Requires: ((cl-lib "0.5"))
-
-;; 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:
-
-;; This file should not be confused with Rick Bielawski's cobol-mode.el
-;; (http://www.emacswiki.org/emacs/cobol-mode.el), which this mode attempts to
-;; supersede.
-
-;; This COBOL mode features syntax highlighting for most modern COBOL dialects,
-;; indentation, code skeletons, rulers and basic formatting functions.
-;; Highlighting changes with the code format, which can be specified using the
-;; M-x customize menu.
-
-;;;; Installation:
-
-;; To install cobol-mode.el, save it to your .emacs.d/ directory and add the
-;; following to your .emacs:
-;; (autoload 'cobol-mode "cobol-mode" "Major mode for highlighting COBOL
files." t nil)
-
-;; To automatically load cobol-mode.el upon opening COBOL files, add this:
-;; (setq auto-mode-alist
-;; (append
-;; '(("\\.cob\\'" . cobol-mode)
-;; ("\\.cbl\\'" . cobol-mode)
-;; ("\\.cpy\\'" . cobol-mode))
-;; auto-mode-alist))
-
-;; Finally, I strongly suggest installing auto-complete-mode, which makes
typing
-;; long keywords and variable names a thing of the past. See
-;; https://github.com/auto-complete/auto-complete.
-
-;;;; Known bugs:
-
-;; * Switching source formats requires M-x customize settings to be changed,
-;; saved and cobol-mode to be unloaded then reloaded.
-;; * Copying-and-pasting content in fixed-format sometimes results in content
-;; being pasted in column 1 and spaces inserted in the middle of it.
-;; * The indentation code leaves a lot of trailing whitespace.
-;; * Periods on their own line are sometimes indented strangely.
-;; * String continuation does not work.
-
-;;;; Missing features:
-
-;; * Switch between dialect's reserved word lists via M-x customize (without
-;; unloading cobol-mode).
-;; * Allow users to modify easily reserved word lists.
-;; * Expand copybooks within a buffer.
-;; * String continuation (see above).
-;; * Allow users to modify start of program-name area.
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-
-(defgroup cobol nil
- "Major mode for editing COBOL code."
- :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
- :prefix 'cobol-
- :group 'languages)
-
-(eval-and-compile
-(defun cobol--radio-of-list (list)
- "Return radio with the elements of LIST as its arguments."
- (cons 'radio (mapcar #'(lambda (elt) (list 'const elt)) list)))
-
-(defun cobol--val-in-list-p (list)
- "Return a predicate to check whether a value is in the LIST."
- #'(lambda (value) (memq value list))))
-
-(defcustom cobol-declaration-clause-indent 40
- "Column to indent data division declaration clauses to."
- :type 'integer
- :safe 'integerp)
-
-(eval-and-compile
-(defconst cobol-formats
- '(fixed-85 fixed-2002 free)
- "The accepted values for `cobol-source-format'.")
-
-(defcustom cobol-source-format 'fixed-85
- "Source format of COBOL source code."
- :type (cobol--radio-of-list cobol-formats)
- :safe (cobol--val-in-list-p cobol-formats)))
-
-;; Ruler
-;; Code derived from the Emacs fortran.el, rulers from IBM Rational Developer.
-
-(defcustom cobol-fixed-85-ruler
-
"----+-*A-1-B--+----2----+----3----+----4----+----5----+----6----+----7--|-+----\n"
- "Ruler for COBOL-85-style fixed format code."
- :type 'string
- :safe 'stringp)
-
-(defcustom cobol-fixed-2002-ruler
-
"----+-*--1----+----2----+----3----+----4----+----5----+----6----+----7----+----\n"
- "Ruler for COBOL-2002-style fixed format code."
- :type 'string
- :safe 'stringp)
-
-(defcustom cobol-free-ruler
-
"----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----\n"
- "Ruler for free format code."
- :type 'string
- :safe 'stringp)
-
-(defun cobol-column-ruler ()
- "Insert a column ruler above the current line until the next keystroke.
-The next key typed is executed unless it is SPC."
- (interactive)
- (momentary-string-display
- (cond ((eq cobol-source-format 'fixed-85)
- cobol-fixed-85-ruler)
- ((eq cobol-source-format 'fixed-2002)
- cobol-fixed-2002-ruler)
- ((eq cobol-source-format 'free)
- cobol-free-ruler))
- (save-excursion
- (beginning-of-line)
- (if (eq (window-start (selected-window))
- (window-point (selected-window)))
- (line-beginning-position 2)
- (point)))
- nil "Type SPC or any command to erase the ruler."))
-
-(defcustom cobol-mode-hook nil
- "Hook run by `cobol-mode'."
- :type 'hook)
-
-(defun cobol--remove-strings (l1 l2)
- "Return a list of strings in L1 not in L2."
- (cl-set-difference l1 l2 :test #'string-equal))
-
-(defconst cobol-directives
- '("CALL-CONVENTION"
- "D"
- "DEFINE"
- "ELIF"
- "ELSE"
- "END-EVALUATE"
- "END-IF"
- "EVALUATE"
- "FLAG-02"
- "FLAG-85"
- "FLAG-NATIVE-ARITHMETIC"
- "IF"
- "IMP"
- "LEAP-SECOND"
- "LISTING"
- "PAGE"
- "PROPAGATE"
- "SOURCE"
- "TURN"
- "WHEN")
- "List of COBOL compiler directives.")
-
-(defconst cobol-verbs-74
- '("GO TO"
- "NEXT SENTENCE"
- "ACCEPT"
- "ADD"
- "ALTER"
- "CALL"
- "CANCEL"
- "CLOSE"
- "COPY"
- "COMPUTE"
- "DELETE"
- "DISABLE"
- "DISPLAY"
- "DIVIDE"
- "ENABLE"
- "ENTER"
- "EXIT"
- "GENERATE"
- "GO"
- "IF"
- "INITIATE"
- "INSPECT"
- "MERGE"
- "MOVE"
- "MULTIPLY"
- "OPEN"
- "PERFORM"
- "READ"
- "RECEIVE"
- "RELEASE"
- "RESET"
- "RETURN"
- "REWRITE"
- "SEARCH"
- "SELECT"
- "SEND"
- "SET"
- "SORT"
- "START"
- "STOP"
- "STRING"
- "SUBTRACT"
- "SUPPRESS"
- "TERMINATE"
- "UNSTRING"
- "USE"
- "WRITE"))
-
-(defconst cobol-verbs-85
- (append cobol-verbs-74
- '("CONTINUE"
- "EVALUATE"
- "INITIALIZE"
- "REPLACE")))
-
-(defconst cobol-removed-verbs-2002
- '("ALTER" "ENTER"))
-
-(defconst cobol-verbs-2002
- (append (cobol--remove-strings cobol-verbs-85 cobol-removed-verbs-2002)
- '("ALLOCATE"
- "FREE"
- "GOBACK"
- "INVOKE"
- "RAISE"
- "RESUME"
- "UNLOCK"
- "VALIDATE")))
-
-(defconst cobol-removed-verbs-2014
- '("DISABLE"
- "ENABLE"
- "SEND"
- "RECEIVE"))
-
-(defconst cobol-verbs-2014
- (cobol--remove-strings cobol-verbs-2002
- cobol-removed-verbs-2014))
-
-(defconst cobol-verbs-extensions
- '("DELETE FILE"
- "READY TRACE"
- "RESET TRACE"
- "XML GENERATE"
- "XML PARSE"
- "ATTACH"
- "ALLOW" ; Unisys COBOL-74
- "AWAIT-OPEN" ; Unisys COBOL-74
- "CAUSE" ; Unisys COBOL-74
- "CHAIN"
- "CHANGE" ; Unisys COBOL-74
- "COLOR"
- "COMMIT"
- "CREATE"
- "DECLARE"
- "DELEGATE"
- "DETACH"
- "DISALLOW" ; Unisys COBOL-74
- "ENTRY"
- "EXAMINE"
- "EXEC"
- "EXECUTE"
- "EXHIBIT"
- ;; "LOCK" ; Unisys COBOL-74 ; Treated as keyword
- "MODIFY"
- "NOTE"
- "ON" ; OS/VS Statement ; Keyword <= COBOL-74
- "PROCESS" ; Unisys COBOL-74
- "RESPOND" ; Unisys COBOL-74
- "ROLLBACK"
- ;; "RUN" ; Unisys COBOL-74 ; Treated as keyword
- "SEEK" ; Unisys COBOL-74
- "SERVICE"
- "SYNC" ; <= COBOL-74
- "TRANSFORM"
- "TRY"
- "WAIT"))
-
-(defconst cobol-verbs
- (append cobol-verbs-2014
- cobol-removed-verbs-2002
- cobol-removed-verbs-2014
- cobol-verbs-extensions)
- "List of COBOL verb keywords.")
-
-(defconst cobol-scope-terminators-85
- '("END-ADD"
- "END-CALL"
- "END-COMPUTE"
- "END-DELETE"
- "END-DIVIDE"
- "END-EVALUATE"
- "END-IF"
- "END-MULTIPLY"
- "END-PERFORM"
- "END-READ"
- "END-RECEIVE"
- "END-RETURN"
- "END-REWRITE"
- "END-SEARCH"
- "END-START"
- "END-STRING"
- "END-SUBTRACT"
- "END-UNSTRING"
- "END-WRITE"))
-
-(defconst cobol-scope-terminators-2002
- (append cobol-scope-terminators-85
- '("END-ACCEPT"
- "END-DISPLAY")))
-
-(defconst cobol-removed-scope-terminators-2014
- '("END-RECEIVE"))
-
-(defconst cobol-scope-terminators-2014
- (cobol--remove-strings cobol-scope-terminators-2002
- cobol-removed-scope-terminators-2014))
-
-(defconst cobol-scope-terminators-xml-tr
- '("END-OPEN"))
-
-(defconst cobol-scope-terminators-extensions
- '("END-CHAIN"
- "END-COLOR"
- "END-DELEGATE"
- "END-EXEC"
- "END-INVOKE"
- "END-MODIFY"
- "END-MOVE"
- "END-SYNC"
- "END-TRY"
- "END-WAIT"
- "END-XML"))
-
-(defconst cobol-scope-terminators
- (append cobol-scope-terminators-2014
- cobol-scope-terminators-xml-tr
- cobol-scope-terminators-extensions))
-
-(defconst cobol-keywords-74
- '("ACCESS"
- "ADVANCING"
- "AFTER"
- "ALL"
- "ALPHABETIC"
- "ALSO"
- "ALTERNATE"
- "AND"
- "ARE"
- "AREA"
- "AREAS"
- "ASCENDING"
- "ASSIGN"
- "AT"
- "AUTHOR"
- "BEFORE"
- "BLANK"
- "BLOCK"
- "BOTTOM"
- "BY"
- "CD"
- "CF"
- "CH"
- "CHARACTER"
- "CHARACTERS"
- "CLOCK-UNITS"
- "COBOL"
- "CODE"
- "CODE-SET"
- "COLLATING"
- "COLUMN"
- "COMMA"
- "COMMUNICATION"
- "COMP"
- "COMPUTATIONAL"
- "CONFIGURATION"
- "CONTAINS"
- "CONTROL"
- "CONTROLS"
- "CORR"
- "CORRESPONDING"
- "COUNT"
- "CURRENCY"
- "DATA"
- "DATE"
- "DATE-COMPILED"
- "DATE-WRITTEN"
- "DAY"
- "DE"
- "DEBUG-CONTENTS"
- "DEBUG-ITEM"
- "DEBUG-LINE"
- "DEBUG-NAME"
- "DEBUG-SUB-1"
- "DEBUG-SUB-2"
- "DEBUG-SUB-3"
- "DEBUGGING"
- "DECIMAL-POINT"
- "DECLARATIVES"
- "ENVIRONMENT"
- "DELIMITED"
- "DELIMITER"
- "DEPENDING"
- "DESCENDING"
- "DESTINATION"
- "DETAIL"
- "DIVISION"
- "DOWN"
- "DUPLICATES"
- "DYNAMIC"
- "EGI"
- "ELSE"
- "EMI"
- "END"
- "END-OF-PAGE"
- "EOP"
- "EQUAL"
- "ERROR"
- "ESI"
- "EVERY"
- "EXCEPTION"
- "EXTEND"
- "FD"
- "FILE"
- "FILE-CONTROL"
- "FILLER"
- "FINAL"
- "FIRST"
- "FOOTING"
- "FOR"
- "FROM"
- "GIVING"
- "GREATER"
- "GROUP"
- "HEADING"
- "I-O"
- "I-O-CONTROL"
- "IDENTIFICATION"
- "INDEX"
- "INDEXED"
- "IN"
- "INDICATE"
- "INITIAL"
- "INPUT"
- "INPUT-OUTPUT"
- "INSTALLATION"
- "INTO"
- "INVALID"
- "IS"
- "JUST"
- "JUSTIFIED"
- "KEY"
- "LABEL"
- "LAST"
- "LEADING"
- "LEFT"
- ; LENGTH is treated as an intrinsic function.
- "LESS"
- "LIMIT"
- "LIMITS"
- "LINAGE"
- "LINAGE-COUNTER"
- "LINE"
- "LINE-COUNTER"
- "LINES"
- "LINKAGE"
- "LOCK"
- "NEXT"
- "MEMORY"
- "MESSAGE"
- "MODE"
- "MODULES"
- "MULTIPLE"
- "NATIVE"
- "NEGATIVE"
- "NO"
- "NOT"
- "NUMBER"
- "NUMERIC"
- "OBJECT-COMPUTER"
- "OCCURS"
- "OF"
- "OFF"
- "OMITTED"
- ;; "ON" ; OS/VS Statement ; Keyword <= COBOL-74
- "OPTIONAL"
- "OR"
- "ORGANIZATION"
- "OUTPUT"
- "OVERFLOW"
- "PAGE"
- "PAGE-COUNTER"
- "PF"
- "PH"
- "PIC"
- "PICTURE"
- "PLUS"
- "POINTER"
- "POSITION"
- "POSITIVE"
- "PRINTING"
- "PROCEDURE"
- "PROCEDURES"
- "PROCEED"
- "PROGRAM"
- "PROGRAM-ID"
- "QUEUE"
- "RANDOM"
- "RD"
- "RECORD"
- "RECORDS"
- "REDEFINES"
- "REEL"
- "REFERENCES"
- "RELATIVE"
- "REMAINDER"
- "REMOVAL"
- "RENAMES"
- "REPLACING"
- "REPORT"
- "REPORTING"
- "REPORT"
- "RERUN"
- "RESERVE"
- "REVERSED"
- "REWIND"
- "RF"
- "RH"
- "RIGHT"
- "ROUNDED"
- "RUN"
- "SAME"
- "SD"
- "SECTION"
- "SECURITY"
- "SEGMENT"
- "SEGMENT-LIMIT"
- "SEND"
- "SENTENCE"
- "SEPARATE"
- "SEQUENCE"
- "SEQUENTIAL"
- "SIZE"
- "SORT-MERGE"
- "SOURCE"
- "SOURCE-COMPUTER"
- "SPECIAL-NAMES"
- "STANDARD"
- "STANDARD-1"
- "STATUS"
- "SUB-QUEUE-1"
- "SUB-QUEUE-2"
- "SUB-QUEUE-3"
- "SYMBOLIC"
- "SYNCHRONIZED"
- "TABLE"
- "TALLYING"
- "TAPE"
- "TERMINAL"
- "TEXT"
- "THAN"
- "THROUGH"
- "THRU"
- "TIME"
- "TIMES"
- "TO"
- "TOP"
- "TRAILING"
- "TYPE"
- "UNIT"
- "UNTIL"
- "UP"
- "UPON"
- "USAGE"
- "USING"
- "VALUE"
- "VALUES"
- "VARYING"
- "WHEN"
- "WITH"
- "WORDS"
- "WORKING-STORAGE"))
-
-(defconst cobol-keywords-85
- (append cobol-keywords-74
- '("ALPHABET"
- "ALPHABETIC-LOWER"
- "ALPHABETIC-UPPER"
- "ALPHANUMERIC"
- "ALPHANUMERIC-EDITED"
- "ANY"
- "BINARY"
- "CLASS"
- "COMMON"
- "CONTENT"
- "CONVERTING"
- "DAY-OF-WEEK"
- "EXTERNAL"
- "FALSE"
- "FUNCTION"
- "GLOBAL"
- "NUMERIC-EDITED"
- "ORDER"
- "OTHER"
- "PACKED-DECIMAL"
- "PADDING"
- "PURGE"
- "REFERENCE"
- "STANDARD-2"
- "TEST"
- "THEN"
- "TRUE")))
-
-(defconst cobol-removed-keywords-2002
- '("AUTHOR"
- "INSTALLATION"
- "DATE-WRITTEN"
- "DATE-COMPILED"
- "SECURITY"
- "MEMORY"
- "RERUN"
- "MULTIPLE"
- "TAPE"
- "LABEL"
- "REVERSED"
- "DEBUG-CONTENTS"
- "DEBUG-ITEM"
- "DEBUG-LINE"
- "DEBUG-NAME"
- "DEBUG-SUB-1"
- "DEBUG-SUB-2"
- "DEBUG-SUB-3"))
-
-(defconst cobol-keywords-2002
- (append (cobol--remove-strings cobol-keywords-85
- cobol-removed-keywords-2002)
- '("ACTIVE-CLASS"
- "ADDRESS"
- "ALIGNED"
- "ANYCASE"
- "AS"
- "B-AND"
- "B-NOT"
- "B-OR"
- "B-XOR"
- "BASED"
- "BINARY-CHAR"
- "BINARY-DOUBLE"
- "BINARY-LONG"
- "BINARY-SHORT"
- "BIT"
- "BOOLEAN"
- "CLASS-ID"
- "COL"
- "COLS"
- "COLUMNS"
- "CONDITION"
- "CONSTANT"
- "CRT"
- "CURSOR"
- "DATA-POINTER"
- "DEFAULT"
- "EC"
- "EO"
- "EXCEPTION-OBJECT"
- "FACTORY"
- "FLOAT-EXTENDED"
- "FLOAT-LONG"
- "FLOAT-SHORT"
- "FORMAT"
- "FUNCTION-ID"
- "GET"
- "GROUP-USAGE"
- "INHERITS"
- "INTERFACE"
- "INTERFACE-ID"
- "LAST"
- "LOCAL-STORAGE"
- "LOCALE"
- "METHOD"
- "METHOD-ID"
- "MINUS"
- "NATIONAL"
- "NATIONAL-EDITED"
- "NESTED"
- "OBJECT"
- "OBJECT-REFERENCE"
- "OPTIONS"
- "OVERRIDE"
- "PRESENT"
- "PROGRAM-POINTER"
- "PROPERTY"
- "PROTOTYPE"
- "RAISING"
- "REPOSITORY"
- "RETRY"
- "RETURNING"
- "SCREEN"
- "SHARING"
- "SOURCES"
- "SYSTEM-DEFAULT"
- "TYPEDEF"
- "UNIVERSAL"
- "USER-DEFAULT"
- "VAL-STATUS"
- "VALID"
- "VALIDATE-STATUS")))
-
-(defconst cobol-keywords-finalizer-tr
- '("AUTO-METHOD"))
-
-(defconst cobol-keywords-xml-tr
- '("DOCUMENT"
- "IDENTIFIED"
- "VERSION-XML"))
-
-(defconst cobol-removed-keywords-2014
- '("CD"
- "DEBUGGING"
- "EGI"
- "EMI"
- "ESI"
- "MESSAGE"
- "PADDING"
- "PURGE"
- "QUEUE"
- "SEGMENT"
- "SUB-QUEUE-1"
- "SUB-QUEUE-2"
- "SUB-QUEUE-3"
- "TERMINAL"
- "TEXT"))
-
-(defconst cobol-keywords-2014
- (append (cobol--remove-strings cobol-keywords-2002
- cobol-removed-keywords-2014)
- '("FARTHEST-FROM-ZERO"
- "FLOAT-BINARY-32"
- "FLOAT-BINARY-64"
- "FLOAT-BINARY-128"
- "FLOAT-DECIMAL-16"
- "FLOAT-DECIMAL-34"
- "FLOAT-INFINITY"
- "FLOAT-NOT-A-NUMBER"
- "FLOAT-NOT-A-NUMBER-QUIET"
- "FLOAT-NOT-A-NUMBER-SIGNALING"
- "FUNCTION-POINTER"
- "IN-ARITHMETIC-RANGE"
- "NEAREST-TO-ZERO")))
-
-(defconst cobol-keywords-extensions
- '("3-D"
- "ABSENT"
- "ABSTRACT"
- "ACQUIRE"
- "ACTION"
- "ACTIVE-X"
- "ACTUAL"
- "ACCEPT-CLOSE"
- "ACCEPT-OPEN"
- "ADDRESS-ARRAY"
- "ADDRESS-OFFSET"
- "ADJUSTABLE-COLUMNS"
- "AFP-5A"
- "ALIGNMENT"
- "ALLOWING"
- "ANY LENGTH"
- "APPLY"
- "ARGUMENT-NUMBER"
- "ARGUMENT-VALUE"
- "ASSEMBLY-ATTRIBUTES"
- "ASSOCIATED-DATA" ; Unisys
- "ASSOCIATED-DATA-LENGTH" ; Unisys
- "AUTO-DECIMAL"
- "AUTO-HYPHEN-SKIP"
- "AUTO-MINIMIZE"
- "AUTO-RESIZE"
- "AUTO-SKIP"
- "AUTO-SPIN"
- "AUTOTERMINATE"
- "AX-EVENT-LIST"
- "B-EXOR"
- "B-LEFT"
- "B-RIGHT"
- "BACKGROUND-COLOUR"
- "BACKGROUND-HIGH"
- "BACKGROUND-LOW"
- "BACKGROUND-STANDARD"
- "BACKWARD"
- "BAR"
- "BASIS"
- "BEEP"
- "BEGINNING"
- "BINARY-INT"
- "BINARY-LONG-LONG"
- "BIND"
- "BITMAP"
- "BITMAP-END"
- "BITMAP-HANDLE"
- "BITMAP-NUMBER"
- "BITMAP-RAW-HEIGHT"
- "BITMAP-RAW-WIDTH"
- "BITMAP-SCALE"
- "BITMAP-START"
- "BITMAP-TIMER"
- "BITMAP-TRAILING"
- "BITMAP-WIDTH"
- "BLINKING"
- "BLOB"
- "BLOB-FILE"
- "BLOB-LOCATOR"
- "BOLD"
- "BOX"
- "BOXED"
- "BROWSING"
- "BULK-ADDITION"
- "BUSY"
- "BUTTONS"
- "C01"
- "C02"
- "C03"
- "C04"
- "C05"
- "C06"
- "C07"
- "C08"
- "C09"
- "C10"
- "C11"
- "C12"
- "CALENDAR-FONT"
- "CALLED"
- "CANCEL-BUTTON"
- "CATCH"
- "CBL"
- "CBL-CTR"
- "CCOL"
- "CELL"
- "CELL-COLOR"
- "CELL-DATA"
- "CELL-FONT"
- "CELL-PROTECTION"
- "CELLS"
- "CENTERED"
- "CENTERED-HEADINGS"
- "CENTURY-DATE"
- "CENTURY-DAY"
- "CHAINING"
- "CHANGED"
- "CHAR-VARYING"
- "CHART"
- "CHECK-BOX"
- "CHECKING"
- "CLASS-ATTRIBUTES"
- "CLASS-CONTROL"
- "CLASS-OBJECT"
- "CLEAR-SELECTION"
- "CLINE"
- "CLINES"
- "CLOB"
- "CLOB-FILE"
- "CLOB-LOCATOR"
- "CLOSE-DISPOSITION" ; Unisys
- "CMP" ; Unisys
- "COERCION"
- "COLORS"
- "COLOUR"
- "COLOURS"
- "COLUMN-COLOR"
- "COLUMN-DIVIDERS"
- "COLUMN-FONT"
- "COLUMN-HEADINGS"
- "COLUMN-PROTECTION"
- "COM-REG"
- "COMBO-BOX"
- "COMMAND-LINE"
- "COMMITMENT"
- "COMP-0"
- "COMP-1"
- "COMP-2"
- "COMP-3"
- "COMP-4"
- "COMP-5"
- "COMP-6"
- "COMP-N"
- "COMP-X"
- "COMPRESSION"
- "COMPUTATIONAL-0"
- "COMPUTATIONAL-1"
- "COMPUTATIONAL-2"
- "COMPUTATIONAL-3"
- "COMPUTATIONAL-4"
- "COMPUTATIONAL-5"
- "COMPUTATIONAL-6"
- "COMPUTATIONAL-N"
- "COMPUTATIONAL-X"
- "CONDITION-VALUE"
- "CONNECT-TIME-LIMIT" ; Unisys
- "CONSOLE"
- "CONSTRAIN"
- "CONSTRAINTS"
- "CONTROL-AREA"
- "CONTROL-POINT" ; Unisys
- "CONTROLS-UNCROPPED"
- "CONVENTION"
- "CONVERSION"
- "CONVERT"
- "COPY-SELECTION"
- "CORE-INDEX"
- "CP" ; Unisys
- "CREATING"
- "CRT-UNDER"
- "CRUNCH" ; Unisys
- "CSIZE"
- "CSP"
- "CURSOR-COL"
- "CURSOR-COLOR"
- "CURSOR-FRAME-WIDTH"
- "CURSOR-ROW"
- "CURSOR-X"
- "CURSOR-Y"
- "CUSTOM-ATTRIBUTE"
- "CUSTOM-PRINT-TEMPLATE"
- "CYL-INDEX"
- "CYL-OVERFLOW"
- "DASHED"
- "DATA-COLUMNS"
- "DATA-TYPES"
- "DATABASE-KEY"
- "DATABASE-KEY-LONG"
- "DATE-ENTRY"
- "DATE-RECORD"
- "DBCLOB"
- "DBCLOB-FILE"
- "DBCLOB-LOCATOR"
- "DBCS"
- "DEBUG"
- "DECIMAL"
- "DEFAULT-BUTTON"
- "DEFAULT-FONT"
- "DEFINITION"
- "DELEGATE-ID"
- "DESTROY"
- "DICTIONARY"
- "DISC"
- "DISJOINING"
- "DISK"
- "DISP"
- "DISPLAY-1"
- "DISPLAY-COLUMNS"
- "DISPLAY-FORMAT"
- "DISPLAY-ST"
- "DIVIDER-COLOR"
- "DIVIDERS"
- "DONT-PARTICIPATE" ; Unisys
- "DOT-DASH"
- "DOTTED"
- "DOUBLE"
- "DRAG-COLOR"
- "DRAW"
- "DROP"
- "DROP-DOWN"
- "DROP-LIST"
- "EBCDIC"
- "ECHO"
- "EGCS"
- "EJECT"
- "ELEMENTARY"
- "EMPTY-CHECK"
- "ENABLED"
- "ENCRYPTION"
- "ENDING"
- "ENGRAVED"
- "ENSURE-VISIBLE"
- "ENTRY-FIELD"
- "ENTRY-REASON"
- "ENUM"
- "ENUM-ID"
- "ENVIRONMENT-NAME"
- "ENVIRONMENT-VALUE"
- "EQUALS"
- "ESCAPE"
- "ESCAPE-BUTTON"
- "EVENT"
- "EVENT-LIST"
- "EVENT-POINTER"
- "EXCEEDS"
- "EXCEPTION-VALUE"
- "EXCESS-3"
- "EXCLUDE-EVENT-LIST"
- "EXCLUSIVE"
- "EXPAND"
- "EXTENDED"
- "EXTENDED-SEARCH"
- "EXTENSION"
- "EXTERNAL-FORM"
- "EXTERNALLY-DESCRIBED-KEY"
- "FH--FCD"
- "FH--KEYDEF"
- "FILE-ID"
- "FILE-LIMIT"
- "FILE-LIMITS"
- "FILE-NAME"
- "FILE-POS"
- "FILL-COLOR"
- "FILL-COLOR2"
- "FILL-PERCENT"
- "FINALLY"
- "FINISH-REASON"
- "FIXED"
- "FIXED-FONT"
- "FIXED-WIDTH"
- "FLAT"
- "FLAT-BUTTONS"
- "FLOAT"
- "FLOATING"
- "FONT"
- "FOREGROUND-COLOUR"
- "FRAME"
- "FRAMED"
- "FULL-HEIGHT"
- "GETTER"
- "GO-BACK"
- "GO-FORWARD"
- "GO-HOME"
- "GO-SEARCH"
- "GRAPHICAL"
- "GRID"
- "GRIP"
- "GROUP-VALUE"
- "HANDLE"
- "HAS-CHILDREN"
- "HEADING-COLOR"
- "HEADING-DIVIDER-COLOR"
- "HEADING-FONT"
- "HEAVY"
- "HEIGHT"
- "HEIGHT-IN-CELLS"
- "HELP-ID"
- "HIDDEN-DATA"
- "HIGH"
- "HIGH-COLOR"
- "HORIZONTAL"
- "HOT-TRACK"
- "HSCROLL"
- "HSCROLL-POS"
- "ICON"
- "ID"
- "IGNORE"
- "INDEPENDENT"
- "INDEXED"
- "INDEXER"
- "INDEXER-ID"
- "INDIC"
- "INDICATOR"
- "INDICATORS"
- "INDIRECT"
- "INHERITING"
- "INQUIRE"
- "INTERRUPT"
- "INSERT"
- "INSERT-ROWS"
- "INSERTION-INDEX"
- "INSTANCE"
- "INTERNAL"
- "INVOKED"
- "ITEM"
- "ITEM-BOLD"
- "ITEM-ID"
- "ITEM-TEXT"
- "ITEM-TO-ADD"
- "ITEM-TO-DELETE"
- "ITEM-TO-EMPTY"
- "ITEM-VALUE"
- "ITERATOR"
- "ITERATOR-ID"
- "JOINED"
- "JOINING"
- "KANJI"
- "KEPT"
- "KEY-YY"
- "KEYBOARD"
- "LABEL-OFFSET"
- "LARGE-FONT"
- "LAST-ROW"
- "LAYOUT-DATA"
- "LAYOUT-MANAGER"
- "LEADING-SHIFT"
- "LEAVE"
- "LEFT-JUSTIFY"
- "LEFT-TEXT"
- "LEFTLINE"
- "LENGTH-CHECK"
- "LENGTH OF"
- "LIN"
- "LINES-AT-ROOT"
- "LINK"
- "LIST"
- "LIST-BOX"
- "LM-RESIZE"
- "LANGUAGE"
- "LOCAL" ; Unisys
- "LOCKING"
- "LONG-DATE"
- "LONG-VARBINARY"
- "LONG-VARCHAR"
- "LOW"
- "LOW-COLOR"
- "LOWER"
- "LOWER-BOUND" ; Unisys
- "LOWER-BOUNDS" ; Unisys
- "LOWERED"
- "MASS-UPDATE"
- "MASTER-INDEX"
- "MAX-HEIGHT"
- "MAX-LINES"
- "MAX-PROGRESS"
- "MAX-SIZE"
- "MAX-TEXT"
- "MAX-VAL"
- "MAX-WIDTH"
- "MDI-CHILD"
- "MDI-FRAME"
- "MEDIUM-FONT"
- "MENU"
- "MESSAGES"
- "METACLASS"
- "MIN-HEIGHT"
- "MIN-LINES"
- "MIN-SIZE"
- "MIN-VAL"
- "MIN-WIDTH"
- "MMDDYYYY" ; Unisys
- "MODAL"
- "MODELESS"
- "MODIFIED"
- "MONITOR-POINTER"
- "MORE-DATA" ; Unisys
- "MORE-LABELS"
- "MULTILINE"
- "MUTEX-POINTER"
- "MYJOB" ; Unisys
- "MYSELF" ; Unisys
- "NAME"
- "NAMED"
- "NAVIGATE-URL"
- "NCHAR"
- "NET-EVENT-LIST"
- "NEW"
- "NEWABLE"
- "NEXT-ITEM"
- "NO-AUTO-DEFAULT"
- "NO-AUTOSEL"
- "NO-BOX"
- "NO-CELL-DRAG"
- "NO-CLOSE"
- "NO-DIVIDERS"
- "NO-ECHO"
- "NO-F4"
- "NO-FOCUS"
- "NO-GROUP-TAB"
- "NO-KEY-LETTER"
- "NO-SEARCH"
- "NO-TAB"
- "NO-UPDOWN"
- "NOMINAL"
- "NOTIFY"
- "NOTIFY-CHANGE"
- "NOTIFY-DBLCLICK"
- "NOTIFY-SELCHANGE"
- "NSTD-REELS"
- "NUM-COL-HEADINGS"
- "NUM-ROW-HEADINGS"
- "NUM-ROWS"
- "NUMERIC-DATE" ; Unisys
- "NUMERIC-FILL"
- "NUMERIC-TIME" ; Unisys
- "O-FILL"
- "OBJECT-ID"
- "OBJECT-STORAGE"
- "OC" ; Unisys
- "ODT-INPUT-PRESENT" ; Unisys
- "OK-BUTTON"
- "OOSTACKPTR"
- "OPERATOR"
- "OPERATOR-ID"
- "OTHERWISE"
- "OVERLAP-LEFT"
- "OVERLAP-TOP"
- "OVERLAPPED"
- "OVERLINE"
- "OWN" ; Unisys
- "PAGE-SETUP"
- "PAGE-SIZE"
- "PAGED"
- "PANEL-INDEX"
- "PANEL-STYLE"
- "PANEL-TEXT"
- "PANEL-WIDTHS"
- "PARAMS"
- "PARENT"
- "PARSE"
- "PARTIAL"
- "PARTICIPATE" ; Unisys
- "PASSWORD"
- "PC" ; Unisys
- "PERMANENT"
- "PIXEL"
- "PIXELS"
- "PLACEMENT"
- "POP-UP"
- "POSITION-SHIFT"
- "POSITIONING"
- "PREFIXING"
- "PRINT"
- "PRINT-CONTROL"
- "PRINT-NO-PROMPT"
- "PRINT-PREVIEW"
- "PRINT-SWITCH"
- "PRINTER"
- "PRINTER-1"
- "PRIOR"
- "PRIORITY"
- "PRIVATE"
- "PROCEDURE-POINTER"
- "PROCESSING"
- "PROGRESS"
- "PROMPT"
- "PROPERTIES"
- "PROPERTY-ID"
- "PROPERTY-VALUE"
- "PROTECTED"
- "PUBLIC"
- "PUSH-BUTTON"
- "QUERY-INDEX"
- "RADIO-BUTTON"
- "RAISED"
- "READ-OK" ; Unisys
- "READ-ONLY"
- "READING"
- "READY"
- "REAL" ; Unisys
- "RECORD-DATA"
- "RECORD-OVERFLOW"
- "RECORD-TO-ADD"
- "RECORD-TO-DELETE"
- "RECORDING"
- "REDEFINE"
- "REDEFINITION"
- "REF" ; Unisys
- "REFRESH"
- "REGION-COLOR"
- "REJECT-OPEN"
- "RELOAD"
- "REMARKS"
- "REORG-CRITERIA"
- "REPEATED"
- "REREAD"
- "RESET"
- "RESET-GRID"
- "RESET-LIST"
- "RESET-TABS"
- "RESIDENT"
- "RESIZABLE"
- "RESTRICTED"
- "RESULT-SET-LOCATOR"
- "RETURN-CODE"
- "RIGHT-ALIGN"
- "RIGHT-JUSTIFY"
- "RIMMED"
- "ROLLING"
- "ROW-COLOR"
- "ROW-COLOR-PATTERN"
- "ROW-DIVIDERS"
- "ROW-FONT"
- "ROW-HEADINGS"
- "ROW-PROTECTION"
- "ROWID"
- "S01"
- "S02"
- "S03"
- "S04"
- "S05"
- "SAVE-AS"
- "SAVE-AS-NO-PROMPT"
- "SCROLL"
- "SCROLL-BAR"
- "SEARCH-OPTIONS"
- "SEARCH-TEXT"
- "SELECT-ALL"
- "SELECTION-INDEX"
- "SELECTION-TEXT"
- "SELECTIVE"
- "SELF-ACT"
- "SELFCLASS"
- "SEMAPHORE-POINTER"
- "SEPARATION"
- "SETTER"
- "SHADING"
- "SHADOW"
- "SHIFT-IN"
- "SHIFT-OUT"
- "SHORT-DATE"
- "SHOW-LINES"
- "SHOW-NONE"
- "SHOW-SEL-ALWAYS"
- ;; SIGN is treated as an intrinsic function.
- "SIGNED-INT"
- "SIGNED-LONG"
- "SIGNED-SHORT"
- "SKIP1"
- "SKIP2"
- "SKIP3"
- "SMALL-FONT"
- "SORT-CONTROL"
- "SORT-CORE-SIZE"
- "SORT-FILE-SIZE"
- "SORT-MESSAGE"
- "SORT-MODE-SIZE"
- "SORT-OPTION"
- "SORT-ORDER"
- "SORT-RETURN"
- "SORT-TAPE"
- "SORT-TAPES"
- "SPACE-FILL"
- "SPINNER"
- "SQL"
- "SQUARE"
- "STANDARD-3"
- "START-X"
- "START-Y"
- "STARTING"
- "STATIC"
- "STATIC-LIST"
- "STATIONLIST"
- "STATUS-BAR"
- "STATUS-TEXT"
- "STDCALL"
- "STOP-BROWSER"
- "STYLE"
- "SUBFILE"
- "SUBWINDOW"
- "SUFFIXING"
- ;; SUM is an intrinsic function.
- "SW0"
- "SW1"
- "SW2"
- "SW3"
- "SW4"
- "SW5"
- "SW6"
- "SW7"
- "SW8"
- "SW9"
- "SW10"
- "SW11"
- "SW12"
- "SW13"
- "SW14"
- "SW15"
- "SWITCH-0"
- "SWITCH-1"
- "SWITCH-2"
- "SWITCH-3"
- "SWITCH-4"
- "SWITCH-5"
- "SWITCH-6"
- "SWITCH-7"
- "SWITCH-8"
- "SWITCH-9"
- "SWITCH-10"
- "SWITCH-11"
- "SWITCH-12"
- "SWITCH-13"
- "SWITCH-14"
- "SWITCH-15"
- "SYSIN"
- "SYSIPT"
- "SYSLST"
- "SYSOUT"
- "SYSPCH"
- "SYSPUNCH"
- "SYSTEM"
- "SYSTEM-INFO"
- "TAB"
- "TAB-CONTROL"
- "TAB-TO-ADD"
- "TAB-TO-DELETE"
- "TAG-KEY" ; Unisys
- "TAG-SEARCH" ; Unisys
- "TALLY"
- "TAPES"
- "TASK"
- "TEMPORARY"
- "TERMINAL-INFO"
- "TERMINATION-VALUE"
- "THREAD"
- "THREAD-LOCAL"
- "THREAD-LOCAL-STORAGE"
- "THREAD-POINTER"
- "THUMB-POSITION"
- "TILED-HEADINGS"
- "TIME-OF-DAY"
- "TIME-OUT"
- "TIME-RECORD"
- "TIMEOUT"
- "TIMER" ; Unisys
- "TIMESTAMP"
- "TIMESTAMP-OFFSET"
- "TIMESTAMP-OFFSET-RECORD"
- "TIMESTAMP-RECORD"
- "TITLE"
- "TITLE-BAR"
- "TITLE-POSITION"
- "TODAYS-DATE"
- "TODAYS-NAME"
- "TOOL-BAR"
- "TOTALED"
- "TOTALING"
- "TRACE"
- "TRACK-AREA"
- "TRACK-LIMIT"
- "TRACK-THUMB"
- "TRACKS"
- "TRADITIONAL-FONT"
- "TRAILING-SHIFT"
- "TRAILING-SIGN"
- "TRANSACTION"
- "TRANSPARENT"
- "TRANSPARENT-COLOR"
- "TREE-VIEW"
- "UNDERLINED"
- "UNEQUAL"
- "UNFRAMED"
- "UNITS"
- "UNSIGNED-INT"
- "UNSIGNED-LONG"
- "UNSIGNED-SHORT"
- "UNSORTED"
- "UPDATE"
- "UPPER"
- "UPSI-0"
- "UPSI-1"
- "UPSI-2"
- "UPSI-3"
- "UPSI-4"
- "UPSI-5"
- "UPSI-6"
- "UPSI-7"
- "URGENT"
- "USE-ALT"
- "USE-RETURN"
- "USE-TAB"
- "USER"
- "USER-COLORS"
- "USER-GRAY"
- "USER-WHITE"
- "VA" ; Unisys
- "VALUE-FORMAT"
- "VALUETYPE"
- "VALUETYPE-ID"
- "VARBINARY"
- "VARIABLE"
- "VARIANT"
- "VERTICAL"
- "VERY-HEAVY"
- "VIRTUAL-WIDTH"
- "VISIBLE"
- "VPADDING"
- "VSCROLL"
- "VSCROLL-BAR"
- "VSCROLL-POS"
- "VTOP"
- "WEB-BROWSER"
- "WHERE"
- "WIDTH"
- "WIDTH-IN-CELLS"
- "WINDOW"
- "WRAP"
- "WRITE-ONLY"
- "WRITE-VERIFY"
- "WRITING"
- "XML"
- "XML-CODE"
- "XML-EVENT"
- "XML-NTEXT"
- "XML-TEXT"
- "YIELDING"
- "ZERO-FILL"))
-
-(defvar cobol-keywords
- (append cobol-keywords-2014
- cobol-removed-keywords-2002
- cobol-removed-keywords-2014
- cobol-keywords-finalizer-tr
- cobol-keywords-xml-tr
- cobol-keywords-extensions
- cobol-scope-terminators
- cobol-removed-scope-terminators-2014)
- "List of COBOL keywords.")
-
-(defconst cobol-context-sensitive-keywords-2002
- '("ARITHMETIC"
- "ATTRIBUTE"
- "AUTO"
- "AUTOMATIC"
- "BACKGROUND-COLOR"
- "BELL"
- "BLINK"
- "BYTE-LENGTH"
- "CENTER"
- "CLASSIFICATION"
- "CYCLE"
- "EC-ALL"
- "EC-ARGUMENT"
- "EC-ARGUMENT-FUNCTION"
- "EC-ARGUMENT-IMP"
- "EC-BOUND"
- "EC-BOUND-IMP"
- "EC-BOUND-ODO"
- "EC-BOUND-OVERFLOW"
- "EC-BOUND-PTR"
- "EC-BOUND-REF-MOD"
- "EC-BOUND-SET"
- "EC-BOUND-SUBSCRIPT"
- "EC-BOUND-TABLE-LIMIT"
- "EC-DATA"
- "EC-DATA-CONVERSION"
- "EC-DATA-IMP"
- "EC-DATA-INCOMPATIBLE"
- "EC-DATA-INTEGRITY"
- "EC-DATA-PTR-NULL"
- "EC-FLOW"
- "EC-FLOW-GLOBAL-EXIT"
- "EC-FLOW-GLOBAL-GOBACK"
- "EC-FLOW-IMP"
- "EC-FLOW-RELEASE"
- "EC-FLOW-REPORT"
- "EC-FLOW-RETURN"
- "EC-FLOW-SEARCH"
- "EC-FLOW-USE"
- "EC-FUNCTION"
- "EC-FUNCTION-PTR-INVALID"
- "EC-FUNCTION-PTR-NULL"
- "EC-I-O"
- "EC-I-O-AT-END"
- "EC-I-O-EOP"
- "EC-I-O-EOP-OVERFLOW"
- "EC-I-O-FILE-SHARING"
- "EC-I-O-IMP"
- "EC-I-O-INVALID-KEY"
- "EC-I-O-LINAGE"
- "EC-I-O-LOGIC-ERROR"
- "EC-I-O-PERMANENT-ERROR"
- "EC-I-O-RECORD-OPERATION"
- "EC-IMP"
- ;; EC-IMP-suffix is matched separately by
- ;; cobol-implementor-user-exception-re.
- "EC-LOCALE"
- "EC-LOCALE-IMP"
- "EC-LOCALE-INCOMPATIBLE"
- "EC-LOCALE-INVALID"
- "EC-LOCALE-INVALID-PTR"
- "EC-LOCALE-MISSING"
- "EC-LOCALE-SIZE"
- "EC-OO"
- "EC-OO-CONFORMANCE"
- "EC-OO-EXCEPTION"
- "EC-OO-IMP"
- "EC-OO-METHOD"
- "EC-OO-NULL"
- "EC-OO-RESOURCE"
- "EC-OO-UNIVERSAL"
- "EC-ORDER"
- "EC-ORDER-IMP"
- "EC-ORDER-NOT-SUPPORTED"
- "EC-OVERFLOW"
- "EC-OVERFLOW-IMP"
- "EC-OVERFLOW-STRING"
- "EC-OVERFLOW-UNSTRING"
- "EC-PROGRAM"
- "EC-PROGRAM-ARG-MISMATCH"
- "EC-PROGRAM-ARG-OMITTED"
- "EC-PROGRAM-CANCEL-ACTIVE"
- "EC-PROGRAM-IMP"
- "EC-PROGRAM-NOT-FOUND"
- "EC-PROGRAM-PTR-NULL"
- "EC-PROGRAM-RECURSIVE-CALL"
- "EC-PROGRAM-RESOURCES"
- "EC-RAISING"
- "EC-RAISING-IMP"
- "EC-RAISING-NOT-SPECIFIED"
- "EC-RANGE"
- "EC-RANGE-IMP"
- "EC-RANGE-INDEX"
- "EC-RANGE-INSPECT-SIZE"
- "EC-RANGE-INVALID"
- "EC-RANGE-PERFORM-VARYING"
- "EC-RANGE-PTR"
- "EC-RANGE-SEARCH-INDEX"
- "EC-RANGE-SEARCH-NO-MATCH"
- "EC-REPORT"
- "EC-REPORT-ACTIVE"
- "EC-REPORT-COLUMN-OVERLAP"
- "EC-REPORT-FILE-MODE"
- "EC-REPORT-IMP"
- "EC-REPORT-INACTIVE"
- "EC-REPORT-LINE-OVERLAP"
- "EC-REPORT-NOT-TERMINATED"
- "EC-REPORT-PAGE-LIMIT"
- "EC-REPORT-PAGE-WIDTH"
- "EC-REPORT-SUM-SIZE"
- "EC-REPORT-VARYING"
- "EC-SCREEN"
- "EC-SCREEN-FIELD-OVERLAP"
- "EC-SCREEN-IMP"
- "EC-SCREEN-ITEM-TRUNCATED"
- "EC-SCREEN-LINE-NUMBER"
- "EC-SCREEN-STARTING-COLUMN"
- "EC-SIZE"
- "EC-SIZE-ADDRESS"
- "EC-SIZE-EXPONENTIATION"
- "EC-SIZE-IMP"
- "EC-SIZE-OVERFLOW"
- "EC-SIZE-TRUNCATION"
- "EC-SIZE-UNDERFLOW"
- "EC-SIZE-ZERO-DIVIDE"
- "EC-SORT-MERGE"
- "EC-SORT-MERGE-ACTIVE"
- "EC-SORT-MERGE-FILE-OPEN"
- "EC-SORT-MERGE-IMP"
- "EC-SORT-MERGE-RELEASE"
- "EC-SORT-MERGE-RETURN"
- "EC-SORT-MERGE-SEQUENCE"
- "EC-STORAGE"
- "EC-STORAGE-IMP"
- "EC-STORAGE-NOT-ALLOC"
- "EC-STORAGE-NOT-AVAIL"
- "EC-USER"
- ;; EC-USER-suffix is matched separately by
- ;; cobol-implementor-user-exception-re.
- "EC-VALIDATE"
- "EC-VALIDATE-CONTENT"
- "EC-VALIDATE-FORMAT"
- "EC-VALIDATE-IMP"
- "EC-VALIDATE-RELATION"
- "EC-VALIDATE-VARYING"
- "EOL"
- "EOS"
- "ENTRY-CONVENTION"
- "ERASE"
- "EXPANDS"
- "FOREGROUND-COLOR"
- "FOREVER"
- "FULL"
- "HIGHLIGHT"
- "IGNORING"
- "IMPLEMENTS"
- "INITIALIZED"
- "INTRINSIC"
- "LC_ALL"
- "LC_COLLATE"
- "LC_CTYPE"
- "LC_MESSAGES"
- "LC_MONETARY"
- "LC_NUMERIC"
- "LC_TIME"
- "LOWLIGHT"
- "MANUAL"
- "MULTIPLE" ; <= COBOL-74
- "NEGATIVE-INFINITY"
- "NONE"
- "NORMAL"
- "NUMBERS"
- "ONLY"
- "PARAGRAPH"
- "POSITIVE-INFINITY"
- "PREVIOUS"
- "RECURSIVE"
- "RELATION"
- "REQUIRED"
- "REVERSE-VIDEO"
- "SECONDS"
- "SECURE"
- "STATEMENT"
- "STEP"
- "STRONG"
- "SYMBOL"
- "UCS-4"
- "UNDERLINE"
- "UNSIGNED"
- "UTF-8"
- "UTF-16"
- ;; XML is treated as a reserved word per IBM implementations.
- "YYYYDDD"
- "YYYYMMDD"))
-
-(defconst cobol-context-sensitive-keywords-finalizer-tr
- '("EC-OO-FINALIZABLE"
- "FINALIZER"))
-
-(defconst cobol-context-sensitive-keywords-xml-tr
- '("CHECK"
- "DISCARD"
- "DOCUMENTATION"
- "DTD"
- "EC-DATA-INFINITY"
- "EC-DATA-NEGATIVE-INFINITY"
- "EC-DATA-NOT-A-NUMBER"
- "EC-XML"
- "EC-XML-CODESET"
- "EC-XML-CODESET-CONVERSION"
- "EC-XML-COUNT"
- "EC-XML-DOCUMENT-TYPE"
- "EC-XML-IMPLICIT-CLOSE"
- "EC-XML-INVALID"
- "EC-XML-NAMESPACE"
- "EC-XML-STACKED-OPEN"
- "EC-XML-RANGE"
- "ELEMENT"
- "NAMESPACE"
- "RAW"
- "SCHEMA"
- "STACK"
- "VALIDITY"))
-
-(defconst cobol-context-sensitive-keywords-2014
- (append cobol-context-sensitive-keywords-2002
- '("AWAY-FROM-ZERO"
- "BINARY-ENCODING"
- "CAPACITY"
- "DECIMAL-ENCODING"
- "EC-FUNCTION-ARG-OMITTED"
- "EC-FUNCTION-NOT-FOUND"
- "EC-OO-ARG-OMITTED"
- "FLOAT-BINARY"
- "FLOAT-DECIMAL"
- "HIGH-ORDER-LEFT"
- "HIGH-ORDER-RIGHT"
- "INTERMEDIATE"
- "NEAREST-AWAY-FROM-ZERO"
- "NEAREST-EVEN-INTERMEDIATE"
- "NEAREST-TOWARD-ZERO"
- "PREFIXED"
- "PROHIBITED"
- "ROUNDING"
- "SHORT"
- "SIGNED"
- "STANDARD-BINARY"
- "STANDARD-DECIMAL"
- "TOWARD-GREATER"
- "TOWARD-LESSER"
- "TRUNCATION")))
-
-(defconst cobol-context-sensitive-extensions
- '("TRUNCATED" ; Unisys
- ))
-
-(defvar cobol-context-sensitive-keywords
- (append cobol-context-sensitive-keywords-2014
- cobol-context-sensitive-keywords-finalizer-tr
- cobol-context-sensitive-keywords-xml-tr
- cobol-context-sensitive-extensions)
- "List of context-sensitive COBOL keywords.")
-
-(defconst cobol-intrinsics-85
- '("ACOS"
- "ANNUITY"
- "ASIN"
- "ATAN"
- ;; BYTE-LENGTH is treated as a context-sensitive word.
- "CHAR"
- "COS"
- "CONCATENATE"
- "CURRENT-DATE"
- "DATE-OF-INTEGER"
- "DAY-OF-INTEGER"
- "FACTORIAL"
- "INTEGER"
- "INTEGER-OF-DATE"
- "INTEGER-OF-DAY"
- "INTEGER-PART"
- "LENGTH"
- "LOG"
- "LOG10"
- "LOWER-CASE"
- "MAX"
- "MEAN"
- "MEDIAN"
- "MIDRANGE"
- "MIN"
- "MOD"
- "NUMVAL"
- "NUMVAL-C"
- "ORD"
- "ORD-MAX"
- "ORD-MIN"
- "PRESENT-VALUE"
- ;; RANDOM is treated as a keyword
- "RANGE"
- "REM"
- "REVERSE"
- "SIGN" ; Keyword <= COBOL-74
- "SIN"
- "SQRT"
- "STANDARD-DEVIATION"
- "SUM" ; Keyword <= COBOL-74
- "TAN"
- "UPPER-CASE"
- "VARIANCE"
- "WHEN-COMPILED"))
-
-(defconst cobol-intrinsics-2002
- (append cobol-intrinsics-85
- '("ABS"
- "BOOLEAN-OF-INTEGER"
- "CHAR-NATIONAL"
- "DATE-TO-YYYYMMDD"
- "DAY-TO-YYYYDDD"
- "DISPLAY-OF"
- "E"
- "EXCEPTION-FILE"
- "EXCEPTION-FILE-N"
- "EXCEPTION-LOCATION"
- "EXCEPTION-LOCATION-N"
- "EXCEPTION-STATEMENT"
- "EXCEPTION-STATUS"
- "EXP"
- "EXP10"
- "FRACTION-PART"
- "HIGHEST-ALGEBRAIC"
- "INTEGER-OF-BOOLEAN"
- "LOCALE-COMPARE"
- "LOCALE-DATE"
- "LOCALE-TIME"
- "LOWEST-ALGEBRAIC"
- "NATIONAL-OF"
- "NUMVAL-F"
- "PI"
- "STANDARD-COMPARE"
- "TEST-DATE-YYYYMMDD"
- "TEST-DAY-YYYYDDD"
- "TEST-NUMVAL"
- "TEST-NUMVAL-C"
- "TEST-NUMVAL-F"
- "YEAR-TO-YYYY")))
-
-(defconst cobol-intrinsics-2014
- (append cobol-intrinsics-2002
- '("COMBINED-DATETIME"
- "FORMATTED-CURRENT-DATE"
- "FORMATTED-DATE"
- "FORMATTED-DATETIME"
- "FORMATTED-TIME"
- "INTEGER-OF-FORMATTED-DATE"
- "LOCALE-TIME-FROM-SECONDS"
- "SECONDS-FROM-FORMATTED-TIME"
- "SECONDS-PAST-MIDNIGHT"
- "TEST-FORMATTED-DATETIME"
- "TRIM")))
-
-(defconst cobol-intrinsics-extensions
- '("ADDR"
- "CURRENCY-SYMBOL"
- "LENGTH-AN"
- "MODULE-CALLER-ID"
- "MODULE-DATE"
- "MODULE-FORMATTED-DATE"
- "MODULE-ID"
- "MODULE-PATH"
- "MODULE-SOURCE"
- "MONETARY-DECIMAL-POINT"
- "MONETARY-THOUSANDS-SEPARATOR"
- "NUMERIC-DECIMAL-POINT"
- "NUMERIC-THOUSANDS-SEPARATOR"
- "STORED-CHAR-LENGTH"
- "SUBSTITUTE"
- "SUBSTITUTE-CASE"
- "ULENGTH"
- "UPOS"
- "USUBSTR"
- "USUPPLEMENTARY"
- "UVALID"
- "UWIDTH"))
-
-(defvar cobol-intrinsics
- (append cobol-intrinsics-2014
- cobol-intrinsics-extensions)
- "List of COBOL standard functions.")
-
-(defconst cobol-symbolic-literals-74
- '("HIGH-VALUE"
- "HIGH-VALUES"
- "LOW-VALUE"
- "LOW-VALUES"
- "QUOTE"
- "QUOTES"
- "SPACE"
- "SPACES"
- "ZERO"
- "ZEROES"
- "ZEROS"))
-
-(defconst cobol-symbolic-literals-85
- cobol-symbolic-literals-74)
-
-(defconst cobol-symbolic-literals-2002
- (append cobol-symbolic-literals-85
- '("NULL"
- "SELF"
- "SUPER")))
-
-(defconst cobol-symbolic-literals-2014
- cobol-symbolic-literals-2002)
-
-(defconst cobol-symbolic-literals-extensions
- '("NULLS"))
-
-(defvar cobol-symbolic-literals
- (append cobol-symbolic-literals-2014
- cobol-symbolic-literals-extensions)
- "List of COBOL symbolic literals.")
-
-(defface cobol-verb
- '((t (:inherit font-lock-keyword-face :weight bold)))
- "Face for COBOL verbs.")
-
-(defface cobol-context-sensitive
- '((t (:inherit font-lock-keyword-face)))
- "Face for context-sensitive COBOL words.")
-
-;;; Highlighting regexps
-
-(defconst cobol--fixed-form-sequence-area-re
- "^.\\{1,6\\}"
- "Regexp matching the fixed-form sequence area.")
-
-(eval-and-compile
-(defconst cobol--complete-sequence-area-re
- "^.\\{6\\}"
- "Regexp matching a complete sequence area.")
-
-(defconst cobol--fixed-comment-indicators
- "*/"
- "String containing COBOL fixed-form comment indicator characters.")
-
-(defconst cobol--fixed-form-comment-re
- (concat cobol--complete-sequence-area-re
- "\\(["
- cobol--fixed-comment-indicators
- "]\\)")
- "Regexp matching a fixed-form source comment.")
-
-(defconst cobol--continuation-or-debugging-indicator-re
- (concat cobol--complete-sequence-area-re
- "\\([d-]\\)")
- "Regexp matching a continuation or debugging line indicator.")
-
-(defconst cobol--non-fixed-comment-indicators-re
- (concat "[^" cobol--fixed-comment-indicators "]")
- "Regexp matching non-fixed-form-comment-indicator characters.")
-
-(defconst cobol--fixed-non-comment-sequence-area-re
- (concat cobol--complete-sequence-area-re
- cobol--non-fixed-comment-indicators-re)
- "Regexp matching the sequence area of a non-comment fixed-form line."))
-
-(defconst cobol--fixed-non-comment-grouped-sequence-area-re
- (concat "\\(" cobol--fixed-form-sequence-area-re "\\)")
- "Regexp matching the sequence area of a non-comment fixed-form line in a
-group.")
-
-(defconst cobol--fixed-form-areas-02-re
- cobol--fixed-non-comment-grouped-sequence-area-re
- "Regexp matching the ignored fixed-forms area in COBOL 2002 for non-comment
-lines.")
-
-(defconst cobol--fixed-form-areas-85-re
- (concat cobol--fixed-non-comment-grouped-sequence-area-re
- ".\\{0,66\\}\\(.*\\)")
- "Regexp matching the ignored fixed-form areas up to COBOL-85 for non-comment
-lines.")
-
-(defconst cobol--fixed-form-wrong-indicator-re
- (concat cobol--fixed-form-sequence-area-re "\\([^-\\*/d$]\\)")
- "Regexp matching incorrect indicators in fixed-form code.")
-
-(defconst cobol--free-form-comment-re
- "\\*>.*"
- "Regexp matching a free-form source comment.")
-
-(eval-and-compile
-(defconst cobol--optional-whitespace-re
- "[ ]*" ; Space and tab
- "Regexp matching optional whitespace.
-\\w isn't used to avoid matching newlines.")
-
-(defconst cobol--optional-leading-whitespace-line-re
- (if (not (eq cobol-source-format 'free))
- (concat cobol--fixed-non-comment-sequence-area-re
- cobol--optional-whitespace-re)
- (concat "^" cobol--optional-whitespace-re))
- "Regexp matching a line perhaps starting with whitespace.")
-
-(defun cobol--with-opt-whitespace-line (&rest strs)
- "Return STRS concatenated after
`cobol--optional-leading-whitespace-line-re'."
- (apply #'concat cobol--optional-leading-whitespace-line-re strs)))
-
-(defconst cobol--free-form-comment-line-re
- (cobol--with-opt-whitespace-line cobol--free-form-comment-re)
- "Regexp matching a free form comment line.")
-
-(defconst cobol--identifier-re
- "\\s-+\\(\\w+\\)"
- "Regexp matching an identifier in a separate group preceded by whitespace.")
-
-(defconst cobol--mf-set-directive
- (cobol--with-opt-whitespace-line "\\$SET\\s-+\\w+")
- "Regexp matching MF compiler directive with optional whitespace.")
-
-(defconst cobol--mf-compiler-directive-re
- (if (not (eq cobol-source-format 'free))
- (concat cobol--fixed-form-sequence-area-re
- ;; FIXME: cobol--mf-set-directive starts with "^" so it can't
- ;; match after cobol--fixed-form-sequence-area-re!
- cobol--mf-set-directive)
- (concat "^" cobol--mf-set-directive))
- "Regexp matching Micro Focus compiler directives.")
-
-(defconst cobol--standard-constant-re
- (cobol--with-opt-whitespace-line "0?1" cobol--identifier-re "\\s-+CONSTANT")
- "Regexp matching constants declared as specified by the 2002 standard.")
-
-(defconst cobol--mf-constant-re
- (cobol--with-opt-whitespace-line "78" cobol--identifier-re)
- "Regexp matching constants declared as specified by Micro Focus.")
-
-(eval-and-compile
-(defconst cobol--directive-indicator-re
- ">> ?"
- "Regexp matching a valid directive indicator."))
-
-(defconst cobol--define-directive-re
- (cobol--with-opt-whitespace-line cobol--directive-indicator-re
- "DEFINE"
- cobol--identifier-re)
- "Regexp matching values defined by the pre-processor.")
-
-(defconst cobol--descriptor-level-re
- "[FRS]D"
- "Regexp matching file/report/sort descriptor 'level numbers'.")
-
-(defconst cobol--record-descriptor-re
- (cobol--with-opt-whitespace-line cobol--descriptor-level-re
cobol--identifier-re)
- "Regexp matching file/report/sort record associations.")
-
-(defconst cobol--typedef-definition-re
- (cobol--with-opt-whitespace-line "0?1" cobol--identifier-re ".+TYPEDEF")
- "Regexp matching typedefs.")
-
-(defconst cobol--level-number-re
- "[[:digit:]]\\{1,2\\}"
- "Regexp matching level numbers.")
-
-(defconst cobol--variable-declaration-re
- (cobol--with-opt-whitespace-line cobol--level-number-re cobol--identifier-re)
- "Regexp matching standard variable declarations.")
-
-(defconst cobol--mf-declare-variable-re
- (cobol--with-opt-whitespace-line "DECLARE" cobol--identifier-re)
- "Regexp matching variable declarations using DECLARE verb used in Managed
-COBOL.")
-
-(defconst cobol--id-and-name-re
- "-ID\\.?\\s-*\\(\\w+\\)"
- "Regexp matching a construct ID and the name of the declared construct.")
-
-(defun cobol--create-id-re (re)
- "Create an id regexp using RE."
- (cobol--with-opt-whitespace-line re cobol--id-and-name-re))
-
-(defun cobol--create-end-marker-re (re)
- "Create an end marker regexp using RE."
- (cobol--with-opt-whitespace-line "END\\s-+" re cobol--identifier-re))
-
-(defconst cobol--standard-function-types
- '("FUNCTION" "METHOD" "PROGRAM")
- "List containing the names of standard constructs similar to functions.")
-
-(defconst cobol--mf-function-types
- '("ITERATOR" "OPERATOR" "PROPERTY")
- "List containing the names of constructs similar to functions created by
Micro
-Focus.")
-
-(defconst cobol--function-types-re
- (regexp-opt (append cobol--standard-function-types cobol--mf-function-types))
- "Regexp matching the names of constructs similar to functions.")
-
-(defconst cobol--function-id-name-re
- (cobol--create-id-re (remove "PROPERTY" cobol--function-types-re))
- "Regexp matching the id and name of a function or similar.")
-
-(defconst cobol--function-end-marker-re
- (cobol--create-end-marker-re cobol--function-types-re)
- "Regexp matching the end marker of a function or similar.")
-
-(defconst cobol--standard-type-types
- '("CLASS" "INTERFACE")
- "List containing the standard type construct names.")
-
-(defconst cobol--mf-type-types
- '("DELEGATE" "ENUM" "INDEXER" "VALUETYPE")
- "List containing the names of type constructs added by Micro Focus.")
-
-(defconst cobol--type-types-re
- (regexp-opt (append cobol--standard-type-types cobol--mf-type-types))
- "Regexp matching type construct names.")
-
-(defconst cobol--type-id-name-re
- (cobol--create-id-re cobol--type-types-re)
- "Regexp matching the id and name of a type.")
-
-(defconst cobol--type-end-marker-re
- (cobol--create-end-marker-re cobol--type-types-re)
- "Regexp matching the end marker of a type.")
-
-(defconst cobol--mf-property-id-name-re
- (concat "PROPERTY" cobol--id-and-name-re cobol--identifier-re)
- "Regexp matching the id, name and type of a property using MF's PROPERTY-ID
-syntax.")
-
-(defconst cobol--procedure-re
- (cobol--with-opt-whitespace-line "\\(\\w+\\)\\(\\s-+SECTION\\)?\\.")
- "Regexp matching the declaration of a procedure.
-Note that this matches DECLARATIVES.")
-
-(defconst cobol--select-file-re
- (cobol--with-opt-whitespace-line
- "SELECT\\(\\s-+OPTIONAL\\)?"
- cobol--identifier-re)
- "Regexp matching the declaration of a file.")
-
-(defconst cobol--pic-type-re
-
"PIC\\(TURE\\)?\\(\\s-+IS\\)?\\s-+\\(\\([-$*+,./[:digit:]()ABENPSVXZ]\\|CR\\|DB\\)+?\\)\\(\\s-\\|\\.?
-\\)"
- "Regexp matching the PICTURE clause of a variable.")
-
-(defconst cobol--string-literal-type-re
- "\\([ZBN]X?\\|[GHLX]\\)\\(\"\\|\'\\)"
- "Regexp matching the type of a string-style literal.")
-
-(defconst cobol--function-call-re
- "\\(\\w+\\)("
- "Regexp matching a function call.")
-
-(defun cobol--create-specifier-type-re (types)
- "Create a specifier id regexp for the list of type names TYPES."
- (cobol--with-opt-whitespace-line
- "\\("
- (mapconcat #'identity types "\\|")
- "\\)"
- cobol--identifier-re))
-
-(defconst cobol--repository-function-type-clause-re
- (cobol--create-specifier-type-re cobol--standard-function-types)
- "Regexp matching a REPOSITORY specifier clause for function types.")
-
-(defconst cobol--repository-type-type-clause-re
- (cobol--create-specifier-type-re cobol--standard-type-types)
- "Regexp matching a REPOSITORY specifier clause for type types.")
-
-(defconst cobol--mf-invoked-class-re
- (concat "TYPE" cobol--identifier-re)
- "Regexp matching a class being INVOKED.")
-
-(defconst cobol--implementer-user-exception-re
- "EC-\\(IMP\\|USER\\)-\\w+"
- "Regexp matching an implementor- or user-defined exception condition.")
-
-(defconst cobol--scope-terminator-re
- (cobol--with-opt-whitespace-line (regexp-opt cobol-scope-terminators 'words))
- "Regexp matching a scope terminator.")
-
-(defconst cobol--phrases-with-double-indent-after
-
"\\(IF\\|EVALUATE\\|WHEN\\|ELSE\\|PERFORM\\s-+\\(VARYING\\|UNTIL\\|\\(WITH\\s-+\\)?TEST\\|.+?\\s-+TIMES\\)\\)"
- "Regexp matching phrases whose conditions/clauses are indented twice.")
-
-(defconst cobol--containing-statement-or-phrase-re
- (cobol--with-opt-whitespace-line
- "\\("
- cobol--phrases-with-double-indent-after
-
"\\|\\(NOT\\s-+\\)?\\(\\(AT\\s-+\\)?END\\(-OF-PAGE\\)?\\>\\|\\(ON\\s-+\\)?\\(OVERFLOW\\|EXCEPTION\\|ESCAPE\\|SIZE\\s-+ERROR\\)\\|INVALID\\s-+KEY\\)\\)")
- "Regexp matching statements/phrases that contain nested statements.")
-
-(defconst cobol--verb-re
- (cobol--with-opt-whitespace-line (regexp-opt cobol-verbs 'words))
- "Regexp matching a verb.")
-
-(defconst cobol--non-id-groups
- ;; AUTO-METHOD is part of the Finalizer TR.
- '("AUTO-METHOD" "DECLARATIVES" "FACTORY" "OBJECT" "METHOD")
- "Groups which do not take a (specifiable) ID.")
-
-(defconst cobol--non-id-group-end-marker-re
- (cobol--with-opt-whitespace-line
- "END\\s-+" (regexp-opt cobol--non-id-groups 'words))
- "Regexp matching the end marker of the groups not taking IDs.")
-
-(defconst cobol--end-marker-re
- (concat "\\(" cobol--function-end-marker-re
- "\\|" cobol--type-end-marker-re
- "\\|" cobol--non-id-group-end-marker-re
- "\\)")
- "Regexp matching an end marker.")
-
-(defconst cobol--division-re
- (cobol--with-opt-whitespace-line
"\\(IDENTIFICATION\\|ENVIRONMENT\\|DATA\\|PROCEDURE\\)\\s-+DIVISION")
- "Regexp matching division header.")
-
-(defconst cobol--procedure-division-re
- (cobol--with-opt-whitespace-line "PROCEDURE\\s-+DIVISION")
- "Regexp matching the procedure division header.")
-
-(defconst cobol--env-or-data-div-sections-re
- (cobol--with-opt-whitespace-line
- (regexp-opt '("CONFIGURATION" "INPUT-OUTPUT" "FILE" "WORKING-STORAGE"
"LOCAL-STORAGE" "LINKAGE" "REPORT" "SCREEN"))
- "\\s-+SECTION.")
- "Regexp matching the sections of the environment and data divisions.")
-
-(defconst cobol--generic-declaration-re
- (cobol--with-opt-whitespace-line
- "\\("
- cobol--descriptor-level-re
- "\\|"
- cobol--level-number-re
- "\\)"
- cobol--identifier-re)
- "Regexp matching any declaration.")
-
-(defconst cobol--blank-line-re
- (cobol--with-opt-whitespace-line "\\.?$")
- "Regexp matching a blank line with optional period.")
-
-;;; Font lock
-
-(defun cobol--fixed-format-p ()
- "Return whether the current source format is fixed."
- (memq cobol-source-format '(fixed-85 'fixed-2002)))
-
-;; This is required for indentation to function, because the initial sequence
-;; area is marked as a comment, not whitespace.
-(defun cobol-back-to-indentation ()
- "Move point to the first non-whitespace character on this line.
-If in fixed-form code, the sequence area and indicators are skipped.
-Code copied from the Emacs source."
- (interactive "^")
- (beginning-of-line 1)
- (when (cobol--fixed-format-p)
- (forward-char 7))
- (skip-syntax-forward " " (line-end-position))
- ;; Move back over chars that have whitespace syntax but have the p flag.
- (backward-prefix-chars))
-
-(defun cobol--font-lock-sequence-area (end)
- "Mark text in the sequence area as comments from point up to END."
- (when (cobol--fixed-format-p)
- (while (and (< (point) end)
- (re-search-forward "^.\\{1,6\\}" end t))
- (put-text-property (match-beginning 0) (point)
- 'face font-lock-comment-face)))
- nil)
-
-(eval-when-compile
- (defconst cobol--syntax-propertize-indicator-area
- (syntax-propertize-precompile-rules
- (cobol--fixed-form-comment-re (1 "<"))
- (cobol--continuation-or-debugging-indicator-re (1 ".")))
- "Syntax rules to mark fixed-form comments as comments.")
-
- (defconst cobol--syntax-propertize-program-name-area
- (syntax-propertize-precompile-rules
- ;; TODO: Override open strings
- ("^.\\{72\\}\\(.\\)" (1 "<")))
- "Syntax rule to mark text in the program name area as comments.")
-
- (defconst cobol--syntax-propertize-page-directive
- (syntax-propertize-precompile-rules
- ((cobol--with-opt-whitespace-line cobol--directive-indicator-re
- "PAGE\\([ ]\\)")
- (1 "<")))
- "Syntax rule to mark text after >>PAGE as a comment.")
-
- (defconst cobol--syntax-propertize-adjacent-quotes
- (syntax-propertize-precompile-rules
- ("\"\"\\|''"
- (0 (ignore
- ;; Move to first quote.
- (backward-char 2)
- (if (nth 3 (syntax-ppss))
- (progn
- (put-text-property (point) (1+ (point))
- 'syntax-table (string-to-syntax "\\"))
- ;; Move back to past the escaped quotes.
- (forward-char 2))
- ;; If the first quote began a string, then the next quote may be
the
- ;; first character in another escaped quote sequence.
- (forward-char 1))))))
- "Syntax rule to mark the first of adjacent quotes, e.g. \"\" or '', as an
escape character."))
-
-(defun cobol--syntax-propertize-function (beg end)
- "Syntax propertize awkward COBOL features (fixed-form comments, indicators
-and ignored areas) between points BEG and END."
- ;; TO-DO: Propertize continuation lines.
- (funcall
- (pcase cobol-source-format
- (`fixed-85 (syntax-propertize-rules
- cobol--syntax-propertize-indicator-area
- cobol--syntax-propertize-program-name-area
- cobol--syntax-propertize-page-directive
- cobol--syntax-propertize-adjacent-quotes))
- (`fixed-2002 (syntax-propertize-rules
- cobol--syntax-propertize-indicator-area
- cobol--syntax-propertize-page-directive
- cobol--syntax-propertize-adjacent-quotes))
- (_ (syntax-propertize-rules
- cobol--syntax-propertize-page-directive
- cobol--syntax-propertize-adjacent-quotes)))
- beg end))
-
-;; Change to defconst so it reloads on something?
-(defvar cobol-font-lock-defaults
- `((;; Sequence area
- (cobol--font-lock-sequence-area)
-
- ;; Directives
- ( ,(concat cobol--directive-indicator-re
- "\\(" (regexp-opt cobol-directives) "\\>\\)")
- . font-lock-preprocessor-face)
- ( ,cobol--mf-compiler-directive-re . font-lock-preprocessor-face)
-
- ;; TO-DO: Highlight reserved words in directives as reserved words
-
- ;; Standard language features.
- ( ,(regexp-opt cobol-verbs 'words) . 'cobol-verb)
- ( ,(regexp-opt cobol-keywords 'words) . font-lock-keyword-face)
- ( ,(regexp-opt cobol-context-sensitive-keywords 'words)
- . 'cobol-context-sensitive)
- ( ,cobol--implementer-user-exception-re . 'cobol-context-sensitive)
- ( ,(regexp-opt cobol-intrinsics 'words) . font-lock-builtin-face)
-
- ;; Constants
- ( ,(regexp-opt cobol-symbolic-literals 'words) . font-lock-constant-face)
- ( ,cobol--standard-constant-re
- (1 'font-lock-constant-face))
- ( ,cobol--mf-constant-re
- (1 'font-lock-constant-face))
- ( ,cobol--define-directive-re
- (1 'font-lock-constant-face))
-
- ;; PIC Type
- ( ,cobol--pic-type-re
- (3 'font-lock-type-face))
-
- ;; Functions
- ( ,cobol--function-call-re
- (1 'font-lock-function-name-face))
-
- ;; REPOSITORY clauses
- ( ,cobol--repository-function-type-clause-re
- (2 'font-lock-function-name-face))
- ( ,cobol--repository-type-type-clause-re
- (2 'font-lock-type-face))
-
- ;; File declarations
- ( ,cobol--select-file-re
- (2 'font-lock-type-face))
-
- ;; File/Report/Sort record associations
- ( ,cobol--record-descriptor-re
- (1 'font-lock-type-face))
-
- ;; Typedef
- ( ,cobol--typedef-definition-re
- (1 'font-lock-type-face))
-
- ;; Variables
- ( ,cobol--variable-declaration-re
- (1 'font-lock-variable-name-face))
- ( ,cobol--mf-declare-variable-re
- (1 'font-lock-variable-name-face))
-
- ;; Construct IDs
- ( ,cobol--function-id-name-re
- (1 'font-lock-function-name-face))
- ( ,cobol--type-id-name-re
- (1 'font-lock-type-face))
- ( ,cobol--mf-property-id-name-re
- (1 'font-lock-variable-name-face)
- (2 'font-lock-type-face))
-
- ;; Construct end markers
- ( ,cobol--function-end-marker-re
- (1 'font-lock-function-name-face))
- ( ,cobol--type-end-marker-re
- (1 'font-lock-type-face))
-
- ;; Invoked classes
- ( ,cobol--mf-invoked-class-re
- (1 'font-lock-type-face))
-
- ;; Procedures
- ( ,cobol--procedure-re
- (1 'font-lock-function-name-face))
-
- ( ,cobol--string-literal-type-re
- (1 'font-lock-string-face)))
- nil
- t
- nil
- nil))
-
-;;; Skeletons
-
-(define-skeleton cobol-skeleton-if-else
- "Insert an IF - ELSE - END-IF block." nil
- > "IF " (skeleton-read "Condition: ") > \n
- > _ \n
- "ELSE" > \n
- > \n
- "END-IF" > \n)
-
-(define-skeleton cobol-skeleton-if
- "Insert an IF - END-IF block." nil
- > "IF " (skeleton-read "Condition: ") > \n
- > _ \n
- "END-IF" > \n)
-
-(define-skeleton cobol-skeleton-perform-times
- "Insert a PERFORM - TIMES - END-PERFORM block." nil
- > "PERFORM " (skeleton-read "Number: ") " TIMES" > \n
- > _ \n
- "END-PERFORM" > \n)
-
-(define-skeleton cobol-skeleton-perform-varying
- "Insert a PERFORM VARYING - FROM - BY - UNTIL - END-PERFORM block."
- nil
- > "PERFORM VARYING "
- (skeleton-read "Variable: ")
- " FROM "
- (skeleton-read "Start: ")
- " BY "
- (skeleton-read "Step: ")
- " UNTIL "
- (skeleton-read "Condition: ") > \n
- > _ \n
- "END-PERFORM" > \n)
-
-(defun cobol-when-with-also (prompt num-also)
- "Create a WHEN clause skeleton with provided PROMPT and NUM-ALSO ALSOs."
- `(,prompt "WHEN " str
- ,@(let ((clauses nil))
- (dotimes (_ num-also)
- (push `(" ALSO " (skeleton-read ,prompt)) clauses))
- clauses)
- > \n > _ \n))
-
-(defvar cobol--num-conds)
-
-(define-skeleton cobol-skeleton-evaluate
- "Insert an EVALUATE - END-EVALUATE block."
- "Variable/TRUE: "
- ;; This is set like so because cobol--num-conds is incremented even when no
str is supplied.
- '(setf cobol--num-conds -1)
- > "EVALUATE " str ("Variable/TRUE: "
- '(setf cobol--num-conds (1+ cobol--num-conds))
- " ALSO " str)
- > \n
- (cobol-when-with-also "Value/Condition: " cobol--num-conds)
- "END-EVALUATE")
-
-(define-skeleton cobol-skeleton-program
- "Insert an empty PROGRAM."
- "Program name: "
- > "IDENTIFICATION DIVISION." > \n
- "PROGRAM-ID. " str "." > \n
- > \n
- "DATA DIVISION." > \n
- "WORKING-STORAGE SECTION." > \n
- > _ \n
- "PROCEDURE DIVISION." > \n
- > \n
- "END PROGRAM " str "." > \n)
-
-(define-skeleton cobol-skeleton-function
- "Insert an empty FUNCTION."
- "Function name: "
- > "IDENTIFICATION DIVISION." > \n
- "FUNCTION-ID. " str "." > \n
- > \n
- "DATA DIVISION." > \n
- "LOCAL-STORAGE SECTION." > \n
- > \n
- "LINKAGE SECTION." > \n
- > _ \n
- "PROCEDURE DIVISION RETURNING ." > \n
- > \n
- "END FUNCTION " str "." > \n)
-
-(define-skeleton cobol-skeleton-method
- "Insert an empty METHOD."
- "Method name: "
- > "IDENTIFICATION DIVISION." > \n
- "METHOD-ID. " str "." > \n
- > \n
- "DATA DIVISION." > \n
- "LOCAL-STORAGE SECTION." > \n
- > _ \n
- "PROCEDURE DIVISION." > \n
- > \n
- "END METHOD " str "." > \n)
-
-(define-skeleton cobol-skeleton-class
- "Insert an empty CLASS."
- "Class name: "
- > "IDENTIFICATION DIVISION." > \n
- "CLASS-ID. " str "." > \n
- > _ \n
- "FACTORY." > \n
- "END FACTORY." > \n
- > \n
- "OBJECT." > \n
- "END OBJECT." > \n
- "END CLASS " str "." > \n)
-
-(define-skeleton cobol-skeleton-interface
- "Insert an empty INTERFACE."
- "Interface name: "
- > "IDENTIFICATION DIVISION." > \n
- "INTERFACE-ID. " str "." > \n
- > _ \n
- "FACTORY." > \n
- "END FACTORY." > \n
- > \n
- "OBJECT." > \n
- "END OBJECT." > \n
- "END INTERFACE " str "." > \n)
-
-;;; Code formatting
-
-(defconst cobol-formats
- '(upper-case lower-case capitalised-all capitalised-verbs)
- "The different formats supported when formatting COBOL code.")
-
-(defcustom cobol-format-style 'upper-case
- "The type of formatting used when formatting COBOL code."
- :type (cobol--radio-of-list cobol-formats)
- :safe (cobol--val-in-list-p cobol-formats))
-
-(defun cobol-format-word (word)
- "Return WORD formatted according to `cobol-format-style'."
- (cond
- ((eql cobol-format-style 'upper-case)
- (upcase word))
- ((eql cobol-format-style 'lower-case)
- (downcase word))
- ((eql cobol-format-style 'capitalised-all)
- (capitalize word))
- ((eql cobol-format-style 'capitalised-verbs)
- (if (memq word cobol-verbs)
- (capitalize word)
- (downcase word)))))
-
-(defun cobol-format-region (beg end)
- "Format all COBOL words between BEG and END according to
-`cobol-format-style'."
- (interactive "*r")
- (cobol-format beg end))
-
-(defun cobol-format-buffer ()
- "Format all COBOL words in the current buffer according to
-`cobol-format-style'."
- (interactive "*")
- (cobol-format (point-min) (point-max)))
-
-(defun cobol-format (beg end)
- "Format COBOL code between BEG and END according to `cobol-format-style'."
- (defconst words-to-format
- (append cobol-directives cobol-verbs cobol-keywords cobol-intrinsics
- cobol-symbolic-literals))
-
- (save-excursion
- (dolist (word words-to-format)
- (let ((ref-point (point-min)))
- (goto-char beg)
- (while (search-forward-regexp (concat "\\<" word "\\>") end t)
- (when (not (let ((state (parse-partial-sexp ref-point (point))))
- (or (nth 3 state) (nth 4 state))))
- (replace-match (cobol-format-word word) t)))))))
-
-;;; Fixed-form formatting
-
-(defun cobol-insert-in-sequence-area (beg end text)
- "Insert, in the lines between BEG and END, TEXT in the sequence area."
- (interactive "*r\nsText: ")
- (when (> (length text) 6)
- (error "%s is longer than six characters" text))
- (save-excursion
- ;; Find rectangle to insert text in.
- (let (top-left bottom-right)
- ;; Get top left corner of rectangle.
- (goto-char beg)
- (beginning-of-line)
- (when (< (point) beg)
- (forward-line 1))
- (setf top-left (point))
- ;; Get bottom right corner of rectangle.
- (while (and (<= (+ (point) 6) end) (not (eobp)))
- (forward-line 1))
- (forward-line -1)
- (setf bottom-right (+ (point) 6))
- (string-rectangle top-left bottom-right (format "%-6s" text)))))
-
-;;; Indentation
-;;; Derived (a long time ago) from the wonderful Emacs Mode Tutorial at
-;;; <http://www.emacswiki.org/emacs/ModeTutorial>.
-
-(defun cobol--code-start ()
- "Return the first column code can go in."
- (if (eq cobol-source-format 'free)
- 0
- 7))
-
-;;; Misc
-(defvar cobol-tab-width 4 "Width of a tab for `cobol-mode'.")
-
-(cl-defun cobol--indent (indent &optional (times 1))
- "Increment INDENT."
- (+ indent (* times cobol-tab-width)))
-
-(defun cobol--current-indentation ()
- "Return the indentation of the current line or -1 if the line is within the
-sequence area."
- (if (< (- (line-end-position) (line-beginning-position)) (cobol--code-start))
- -1
- (save-excursion
- (goto-char (+ (line-beginning-position) (cobol--code-start)))
- (let ((code-start-position (point)))
- (skip-syntax-forward " " (line-end-position))
- (backward-prefix-chars)
- (- (point) code-start-position)))))
-
-(defun cobol--indent-current ()
- "Return the current indent level indented once."
- (cobol--indent (cobol--current-indentation)))
-
-(defun cobol--search-back (fn)
- "Go back a line at a time, calling FN each time.
-If the car of the return value is non-nil, return the cdr."
- (save-excursion
- (cl-do ((ret nil (funcall fn)))
- ((car ret) (cdr ret))
- (forward-line -1))))
-
-(cl-defun cobol--search-back-for-indent (str &key with-whitespace)
- "Return the indent of the previous line starting with the regexp STR
(optionally
-after whitespace if WITH-WHITESPACE). If that cannot be found, return 0."
- (let ((line-re (concat (when with-whitespace cobol--optional-whitespace-re)
- str)))
- (cobol--search-back
- #'(lambda () (cond ((bobp)
- (cons t 0))
- ((looking-at line-re)
- (cons t (cobol--current-indentation))))))))
-
-(defun cobol--indent-of-last-div ()
- "Return the indent of the last division."
- (cobol--search-back-for-indent cobol--division-re))
-
-(defun cobol--indent-of-last-div-or-section ()
- "Return the indent of the preceding division or section."
- (cobol--search-back-for-indent "\\w+\\s-+\\(DIVISION\\|SECTION\\)\\."
:with-whitespace t))
-
-(defun cobol--indent-of-end-marker-match (group)
- "Return the indent of the start of GROUP."
- (if (memq (upcase group) cobol--non-id-groups)
- (cobol--search-back-for-indent
- (concat group ".") :with-whitespace t)
- (cobol--search-back-for-indent
- (cobol--create-id-re group))))
-
-(defun cobol--match-with-leading-whitespace (re str)
- "Match regexp RE (with optional leading whitespace) against STR."
- (string-match (concat cobol--optional-leading-whitespace-line-re re)
- str))
-
-(defun cobol--match-line-with-leading-whitespace (re)
- "Match regexp RE (with optional leading whitespace) against the current
line."
- (cobol--match-with-leading-whitespace re (thing-at-point 'line)))
-
-(defun cobol--get-level-number (declaration)
- "Return the level-number of DECLARATION.
-If the declaration does not have a level number, return zero."
- (string-match cobol--generic-declaration-re declaration)
- (string-to-number (match-string 1 declaration)))
-
-(defun cobol--indent-of-group-item (wanted-level-num)
- "Return the indentation of the last item with WANTED-LEVEL-NUM or indented
-from the last item of lower level."
- (cobol--search-back
- #'(lambda ()
- (cond ((looking-at cobol--generic-declaration-re)
- (let ((level-num (cobol--get-level-number (thing-at-point
'line))))
- (cond ((eq level-num wanted-level-num)
- (cons t (cobol--current-indentation)))
- ((< level-num wanted-level-num)
- (cons t (cobol--indent-current))))))
- ((bobp)
- (cons t 0))))))
-
-(defun cobol--indent-of-declaration (decl)
- "Return the indentation of the declaration DECL."
- (let ((level-num (cobol--get-level-number decl)))
- (if (or (>= 1 level-num) (eq 77 level-num) (eq 66 level-num))
- ;; If elementary item or FD/SD/RD.
- (cobol--search-back-for-indent cobol--division-re)
- ;; Find indent of item with same level or add-indent to previous item of
- ;; lower level. (This means 88 levels will always be indented to the
- ;; previous item.)
- (cobol--indent-of-group-item level-num))))
-
-(defun cobol--indent-from-previous ()
- "Return what the indent of the current line should be based on previous
-lines."
- (cobol--search-back
- #'(lambda ()
- (cond ((looking-at cobol--env-or-data-div-sections-re)
- (cons t (cobol--current-indentation)))
- ((or (looking-at cobol--containing-statement-or-phrase-re)
- (looking-at cobol--procedure-re)
- (looking-at cobol--procedure-division-re))
- (cons t (cobol--indent-current)))
- ((or (looking-at cobol--verb-re)
- (looking-at cobol--scope-terminator-re)
- (looking-at cobol--type-end-marker-re)
- (looking-at cobol--function-end-marker-re)
- (looking-at cobol--division-re)
- (looking-at cobol--generic-declaration-re))
- (cons t (cobol--current-indentation)))
- ((bobp)
- (cons t 0))))))
-
-(defun cobol--phrase-with-not (phrase)
- "Return regexp matching line with optional NOT and PHRASE."
- (cobol--with-opt-whitespace-line "\\(NOT\\s-+\\)?" phrase))
-
-(defun cobol--at-phrase (phrase)
- "Return regexp matching PHRASE with optional AT and NOT."
- (cobol--phrase-with-not (concat "\\(AT\\s-+\\)?" phrase)))
-
-(defun cobol--on-phrase (phrase)
- "Return regexp matching PHRASE with optional ON and NOT."
- (cobol--phrase-with-not (concat "\\(ON\\s-+\\)?" phrase)))
-
-(defun cobol--statements-with-phrase (str)
- "Return a list of statements taking the phrase STR."
- (cond ((string-match (cobol--with-opt-whitespace-line "WHEN")
- str)
- '("EVALUATE" "SEARCH"))
- ((string-match (cobol--at-phrase "END-OF-PAGE") str)
- '("WRITE"))
- ((string-match (cobol--at-phrase "END") str)
- ;; An AT END clause is added to OPEN in the XML TR.
- '("OPEN" "READ" "RETURN" "SEARCH"))
- ((string-match (cobol--on-phrase "OVERFLOW") str)
- '("CALL" "STRING" "UNSTRING"))
- ((string-match (cobol--on-phrase "EXCEPTION") str)
- '("ACCEPT" "CALL" "DISPLAY"))
- ((string-match (cobol--on-phrase "ESCAPE") str)
- '("ACCEPT")) ; MF/ACUCOBOL extension
- ((string-match (cobol--on-phrase "SIZE\\s-+ERROR") str)
- '("ADD" "COMPUTE" "DIVIDE" "MULTIPLY" "SUBTRACT"))
- ((string-match (cobol--phrase-with-not "INVALID\\s-+KEY") str)
- '("DELETE" "READ" "REWRITE" "START"))
- (t
- (error "Invalid phrase"))))
-
-(defun cobol--scope-terminator-statement (scope-terminator)
- "Return the statement contained in SCOPE-TERMINATOR."
- (cobol--match-with-leading-whitespace "END-\\(\\w+\\)" scope-terminator)
- (match-string 1 scope-terminator))
-
-(defun cobol--first-word (str)
- "Return the first word in STR."
- (cobol--match-with-leading-whitespace "\\(\\w+\\)" str)
- (match-string 1 str))
-
-(defun cobol--go-to-open-statement (statements)
- "Go to the last open (unterminated) statement in STATEMENTS."
- (let* ((statements-re (regexp-opt statements t))
- (valid-statement-re (cobol--with-opt-whitespace-line statements-re))
- (valid-scope-terminator-re cobol--scope-terminator-re)
- found)
- (while (not found)
- (forward-line -1)
- (cond ((looking-at valid-statement-re)
- ;; Check the scope-terminator is not on the same line.
- (let ((scope-terminator
- (concat "END-" (cobol--first-word (thing-at-point
'line)))))
- (unless (string-match scope-terminator (thing-at-point 'line))
- (setf found t))))
-
- ;; Skip past terminated statements
- ((looking-at valid-scope-terminator-re)
- (let ((terminated-statement
- (cobol--scope-terminator-statement (thing-at-point
'line))))
- (cobol--go-to-open-statement (list terminated-statement))))
-
- ;; If no statement is found, stop at beginning of buffer.
- ((bobp)
- (setf found t))))))
-
-(defun cobol--indent-of-open-statement (statements)
- "Return the indent of the last open statement in STATEMENTS."
- (save-excursion
- (cobol--go-to-open-statement statements)
- (cobol--current-indentation)))
-
-(defun cobol--indent-of-containing-statement-or-phrase (str)
- "Return the indentation of containing statement/phrase in STR."
- (let ((phrase (upcase (cobol--first-word str))))
- (cond ((or (string-equal phrase "IF")
- (string-equal phrase "EVALUATE")
- (string-equal phrase "PERFORM"))
- (cobol--indent-from-previous))
-
- ((string-equal phrase "ELSE")
- (cobol--indent-of-open-statement '("IF")))
-
- (t
- (cobol--indent (cobol--indent-of-open-statement
- (cobol--statements-with-phrase str)))))))
-
-(defun cobol--get-current-division ()
- "Return the division containing point as a symbol."
- (cobol--search-back
- #'(lambda ()
- (cond ((looking-at cobol--division-re)
- (string-match cobol--division-re (thing-at-point 'line))
- (let ((division (downcase (match-string 1 (thing-at-point
'line)))))
- (cons t (intern division))))
-
- ((or (looking-at cobol--end-marker-re)
- (bobp))
- (cons t 'identification))))))
-
-(defun cobol--no-instances-of-after-in-division (instance-re after-re division)
- "Actual implementation of `cobol--no-instances-of'."
- (and (eq division (cobol--get-current-division))
- (cobol--search-back
- #'(lambda ()
- (cond ((looking-at after-re)
- (cons t t))
- ((or (looking-at instance-re)
- (bobp))
- (cons t nil)))))))
-
-(defmacro cobol--no-instances-of (re after re2 in division)
- "Return non-nil if there are no instances of things matched by RE
-between point and the previous instance of RE2.
-Return nil if point is not in DIVISION or if nothing is found.
-Arguments must be in the form 'RE after RE2 in DIVISION' where
-`after' and `in' stand for themselves."
- (cl-assert (and (eq after 'after)
- (eq in 'in))
- nil
- "Clauses should be in the form 're AFTER re-2 IN division'.")
- `(cobol--no-instances-of-after-in-division ,re ,re2 ,division))
-
-(defun cobol--in-file-control-p ()
- "Return whether point is in the FILE-CONTROL paragraph."
- (cobol--no-instances-of cobol--procedure-re
- after (cobol--with-opt-whitespace-line
"FILE-CONTROL.")
- in 'environment))
-
-(defun cobol--no-statements-after (re)
- "Return whether there are any statements between point and the previous
-instance of RE."
- (cobol--no-instances-of cobol--verb-re
- after re
- in 'procedure))
-
-(defun cobol--in-proc-div-param-list-p ()
- "Return whether point is in the procedure division header parameter list."
- (cobol--no-statements-after cobol--procedure-division-re))
-
-(defun cobol--in-if-eval-when-or-perform-cond-p ()
- "Return whether point is in the condition of an IF, EVALUATE or WHEN or in
-the clauses of a non-procedural PERFORM."
- (cobol--no-statements-after (cobol--with-opt-whitespace-line
- cobol--phrases-with-double-indent-after)))
-
-(defun cobol--indent-of-last-statement ()
- "Return the indent of the last statement."
- (cobol--search-back-for-indent cobol--verb-re))
-
-(defun cobol--indent-of-clauses ()
- "Return the indentation for a clause at point."
- (let ((current-division (cobol--get-current-division)))
- (cond ((eq current-division 'identification)
- (cobol--indent-from-previous))
-
- ((eq current-division 'environment)
- (if (cobol--in-file-control-p)
- ;; Indent clauses of SELECT.
- (cobol--indent (cobol--indent-of-last-statement))
- (cobol--indent-from-previous)))
-
- ((eq current-division 'data)
- (- cobol-declaration-clause-indent (cobol--code-start)))
-
- ((eq current-division 'procedure)
- (cond ((cobol--in-proc-div-param-list-p)
- ;; Indent procedure division parameter list twice.
- (cobol--indent (cobol--search-back-for-indent
cobol--procedure-division-re)
- 2))
- ((cobol--in-if-eval-when-or-perform-cond-p)
- ;; Indent after IF/EVALUATE/WHEN/non-procedural PEROFRM twice.
- (cobol--indent (cobol--search-back-for-indent
- cobol--phrases-with-double-indent-after
- :with-whitespace t)
- 2))
- ;; Indent once after any other statement.
- (t
- (cobol--indent (cobol--indent-of-last-statement))))))))
-
-(defun cobol--looking-at-comment-line ()
- "Return whether we are looking at a comment line (using `looking-at')."
- (or (looking-at cobol--free-form-comment-line-re)
- (when (cobol--fixed-format-p)
- (looking-at cobol--fixed-form-comment-re))))
-
-(defun cobol--find-indent-of-line ()
- "Return what the indent of the current line should be."
- (save-excursion
- (beginning-of-line)
- (cond ((looking-at cobol--scope-terminator-re)
- (let ((matching-statement
- (cobol--scope-terminator-statement (thing-at-point 'line))))
- (cobol--indent-of-open-statement (list matching-statement))))
-
- ((looking-at cobol--procedure-re)
- (cobol--indent-of-last-div-or-section))
-
- ((looking-at cobol--end-marker-re)
- (cobol--match-line-with-leading-whitespace
- (concat "END" cobol--identifier-re))
- (let ((group (match-string 1 (thing-at-point 'line))))
- (cobol--indent-of-end-marker-match group)))
-
- ((looking-at cobol--division-re)
- (cobol--indent-of-last-div))
-
- ((looking-at cobol--generic-declaration-re)
- (cobol--indent-of-declaration (thing-at-point 'line)))
-
- ((looking-at cobol--containing-statement-or-phrase-re)
- (cobol--indent-of-containing-statement-or-phrase
- (thing-at-point 'line)))
-
- ((or (cobol--looking-at-comment-line)
- (looking-at cobol--verb-re)
- (looking-at cobol--blank-line-re))
- (cobol--indent-from-previous))
-
- (t
- (cobol--indent-of-clauses)))))
-
-(defun cobol--indent-point-to-col (col)
- "Indent point to COL."
- ;; FIXME: Use indent-line-to?
- (cond ((< (current-column) col)
- (indent-to col))
- ((> (current-column) col)
- (delete-char (- col (current-column))))))
-
-(defun cobol--set-line-indent (indent)
- "Set the indent of the current line to INDENT."
- (save-excursion
- (let ((line-length (- (line-end-position) (line-beginning-position)))
- (end-of-indent (+ (cobol--code-start) indent)))
- ;; Following lines derived from source of `back-to-indentation'.
- (move-to-column (cobol--code-start))
- (if (>= line-length (cobol--code-start) (current-column))
- (progn
- (skip-syntax-forward " " (line-end-position))
- (backward-prefix-chars))
- (indent-to (cobol--code-start)))
-
- (cobol--indent-point-to-col end-of-indent))))
-
-(defun cobol--indent-point ()
- "Indent point to the next multiple of `cobol-tab-width' (relative to the
-start of area A, if fixed-format)."
- (cobol--indent-point-to-col
- (+ (current-column) (- cobol-tab-width
- (% (if (cobol--fixed-format-p)
- (1+ (current-column))
- (current-column))
- cobol-tab-width)))))
-
-(defun cobol-indent-line ()
- "Indent current line as COBOL code."
- (interactive "*")
- (let ((indent (cobol--find-indent-of-line)))
- (if (not (eq indent (cobol--current-indentation)))
- (progn
- (cobol--set-line-indent indent)
- ;; If in leading whitespace/sequence area, move to first char of
code.
- (when (< (point) (+ (line-beginning-position) (cobol--code-start)
indent))
- (skip-syntax-forward " " (line-end-position))
- (backward-prefix-chars)))
- ;; Move to first non-whitespace char
- (skip-syntax-forward " " (line-end-position))
- (backward-prefix-chars)
- ;; Indent stuff at point if not the first word.
- (when (< (cobol--current-indentation) (- (current-column)
(cobol--code-start)))
- (cobol--indent-point)))))
-
-(defvar cobol-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap back-to-indentation] 'cobol-back-to-indentation)
- ;;(define-key map (kbd "RET") #'newline-and-indent)
- map))
-
-(defvar cobol-mode-syntax-table
- (let ((st (make-syntax-table)))
- (modify-syntax-entry ?- "w" st)
- (modify-syntax-entry ?_ "w" st)
- (modify-syntax-entry ?* ". 1" st)
- (modify-syntax-entry ?> "w 2" st)
- (modify-syntax-entry ?\\ "." st)
- (modify-syntax-entry ?' "\"" st)
- (modify-syntax-entry ?\" "\"" st)
- (modify-syntax-entry ?\n ">" st)
- st))
-
-(defvar ac-ignore-case)
-
-;;;###autoload
-(define-derived-mode cobol-mode prog-mode "COBOL"
- "COBOL mode is a major mode for handling COBOL files."
-
- (set (make-local-variable 'font-lock-defaults) cobol-font-lock-defaults)
-
- (when cobol-tab-width
- (set (make-local-variable 'tab-width) cobol-tab-width))
-
- (set (make-local-variable 'indent-tabs-mode) nil)
-
- (set (make-local-variable 'comment-start-skip)
- "\\(^.\\{6\\}\\*\\|\\*>\\)\\s-* *")
- (set (make-local-variable 'comment-start) "*>")
- (set (make-local-variable 'comment-end) "")
-
- (set (make-local-variable 'syntax-propertize-function)
- #'cobol--syntax-propertize-function)
-
- (set (make-local-variable 'column-number-mode) t)
-
- (set (make-local-variable 'indent-line-function) #'cobol-indent-line)
-
- ;; Auto complete mode
- (set (make-local-variable 'ac-ignore-case) t)
- )
-
-(provide 'cobol-mode)
-
-;;; cobol-mode.el ends here
diff --git a/packages/dbus-codegen/dbus-codegen.el
b/packages/dbus-codegen/dbus-codegen.el
deleted file mode 100644
index 334e20b..0000000
--- a/packages/dbus-codegen/dbus-codegen.el
+++ /dev/null
@@ -1,942 +0,0 @@
-;;; dbus-codegen.el --- Lisp code generation for D-Bus. -*- lexical-binding:
t; -*-
-
-;; Copyright (C) 2015-2019 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@gnu.org>
-;; Keywords: comm, dbus, convenience
-;; Package-Requires: ((cl-lib "0.5"))
-;; Version: 0.1
-;; Maintainer: emacs-devel@gnu.org
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package provides macros and functions to make D-Bus
-;; client/server implementation easy, inspired by the `gdbus-codegen'
-;; utility in GLib. To get it work, `lexical-binding' must be
-;; enabled.
-;;
-;; * Client support
-;;
-;; A proxy object representing a D-Bus client can be defined with
-;; either `dbus-codegen-define-proxy' or `dbus-codegen-make-proxy'.
-;;
-;; `dbus-codegen-define-proxy' takes a static XML definition of a
-;; D-Bus service and generates code at compile time. This is good for
-;; stable D-Bus services. On the other hand,
-;; `dbus-codegen-make-proxy' uses D-Bus introspection and retrieves a
-;; D-Bus service definition from a running service itself. This is
-;; good for debugging or for unstable D-Bus services.
-;;
-;; ** Example
-;;
-;; Suppose the following code:
-;;
-;; (dbus-codegen-define-proxy test-proxy
-;; "\
-;; <node>
-;; <interface name='org.example.Test'>
-;; <method name='OpenFile'>
-;; <arg type='s' name='path' direction='in'/>
-;; </method>
-;; <signal name='Changed'>
-;; <arg type='s' name='a_string'/>
-;; </signal>
-;; <property type='s' name='Content' access='read'/>
-;; </interface>
-;; </node>"
-;; "org.example.Test")
-;;
-;; The `dbus-codegen-define-proxy' macro expands to a definition a
-;; struct `test-proxy' with a slot `content', which corresponds to the
-;; "Content" property. The slot value will be initialized when the
-;; proxy is created and updated when the server sends a notification.
-;; The proxy can always retrieve the value with the function
-;; `PROXY-retrieve-PROPERTY-property'.
-;;
-;; The macro also defines the following wrapper functions:
-;;
-;; - `test-proxy-create'
-;; constructor of the proxy
-;; - `test-proxy-destroy'
-;; destructor of the proxy
-;; - `test-proxy-open-file'
-;; wrapper around calling the "OpenFile" method
-;; - `test-proxy-open-file-asynchronously'
-;; asynchronous wrapper around calling the "OpenFile" method
-;; - `test-proxy-send-changed-signal'
-;; wrapper around sending the "Changed" signal
-;; - `test-proxy-register-changed-signal'
-;; wrapper around registering a handler for the "Changed" signal
-;; - `test-proxy-retrieve-content-property'
-;; retrieve the value of the "Content" property
-;;
-;; In addition to those, the macro also defines a generic function
-;; `test-proxy-handle-changed-signal' to allow a class-wide signal
-;; handler definition.
-;;
-;; To register a class-wide signal handler, define a method
-;; `test-proxy-handle-changed-signal' with `cl-defmethod', like this:
-;;
-;; (cl-defmethod test-proxy-handle-changed-signal ((proxy test-proxy) string)
-;; ... do something with PROXY and STRING ...)
-;;
-;; * Server support
-;;
-;; A skeleton object representing a D-Bus server can be defined with
-;; `dbus-codegen-define-skeleton'.
-;;
-;; `dbus-codegen-define-skeleton' takes a static XML definition of a
-;; D-Bus service and generates code at compile time.
-;;
-;; ** Example
-;;
-;; Suppose the following code:
-;;
-;; (dbus-codegen-define-skeleton test-skeleton
-;; "\
-;; <node>
-;; <interface name='org.example.Test'>
-;; <method name='OpenFile'>
-;; <arg type='s' name='path' direction='in'/>
-;; </method>
-;; <signal name='Changed'>
-;; <arg type='s' name='a_string'/>
-;; </signal>
-;; <property type='s' name='Content' access='read'/>
-;; </interface>
-;; </node>"
-;; "org.example.Test")
-;;
-;; The `dbus-codegen-define-skeleton' macro expands to a definition a
-;; struct `test-skeleton' with a slot `content', which corresponds to the
-;; "Content" property.
-;;
-;; The macro also defines the following wrapper functions:
-;;
-;; - `test-skeleton-create'
-;; constructor of the skeleton
-;; - `test-skeleton-destroy'
-;; destructor of the skeleton
-;; - `test-skeleton-register-open-file-method'
-;; wrapper around registering a handler for the "OpenFile" method
-;; - `test-skeleton-send-changed-signal'
-;; wrapper around sending the "Changed" signal
-;; - `test-skeleton-register-changed-signal'
-;; wrapper around registering a handler for the "Changed" signal
-;; - `test-skeleton-register-content-property'
-;; wrapper around registering a value of the "Content" property
-;;
-;; In addition to those, the macro also defines a generic function
-;; `test-skeleton-handle-open-file-method' to allow a class-wide method
-;; handler definition.
-;;
-;; To register a class-wide method handler, define a method
-;; `test-skeleton-handle-open-file-method' with `cl-defmethod', like this:
-;;
-;; (cl-defmethod test-skeleton-handle-open-file-method ((skeleton
test-skeleton)
-;; string)
-;; ... do something with SKELETON and STRING ...)
-;;
-;; * TODO
-;;
-;; - function documentation generation from annotations
-
-;;; Code:
-
-(require 'dbus)
-(require 'cl-lib)
-
-(eval-when-compile
- (require 'xml)
- (require 'subword))
-
-;; Base type of a D-Bus proxy and a skeleton.
-(cl-defstruct (dbus-codegen-object
- (:constructor nil))
- (bus nil :read-only t)
- (service nil :read-only t)
- (path nil :read-only t)
- (interface nil :read-only t)
- registration-list)
-
-;; Base type of a D-Bus proxy.
-(cl-defstruct (dbus-codegen-proxy
- (:include dbus-codegen-object)
- (:constructor nil)))
-
-;; Base type of a D-Bus skeleton
-(cl-defstruct (dbus-codegen-skeleton
- (:include dbus-codegen-object)
- (:constructor nil)))
-
-;; Return a list of elements in the form: (LISP-NAME ORIG-NAME MEMBER).
-(defun dbus-codegen--apply-transform-name (elements transform-name)
- (mapcar (lambda (elements)
- (let ((name (xml-get-attribute-or-nil elements 'name)))
- (unless name
- (error "missing \"name\" attribute of %s"
- (xml-node-name elements)))
- (list (funcall transform-name name)
- name
- elements)))
- elements))
-
-;; Return a list of symbols.
-(defun dbus-codegen--collect-arglist (args transform-name)
- (delq nil
- (mapcar
- (lambda (arg)
- (let ((direction
- (xml-get-attribute-or-nil (nth 2 arg) 'direction)))
- (if (or (null direction)
- (equal direction "in"))
- (intern (car arg)))))
- (dbus-codegen--apply-transform-name args transform-name))))
-
-(defconst dbus-codegen--basic-type-to-symbol-alist
- '((?y . :byte)
- (?b . :boolean)
- (?n . :int16)
- (?q . :uint16)
- (?i . :int32)
- (?u . :uint32)
- (?x . :int64)
- (?t . :uint64)
- (?d . :double)
- (?s . :string)
- (?o . :object-path)
- (?g . :signature))
- "Mapping from D-Bus type-codes to Lisp symbols.")
-
-;; Read a single type from SIGNATURE. Returns a cons cell of
-;; (NEXT-OFFSET . TYPE).
-(defun dbus-codegen--read-signature (signature offset)
- (let* ((c (aref signature offset))
- (entry (assq c dbus-codegen--basic-type-to-symbol-alist)))
- (if entry
- (cons (1+ offset) (cdr entry))
- (pcase c
- (?{
- (let* ((type1 (dbus-codegen--read-signature signature (1+ offset)))
- (type2 (dbus-codegen--read-signature signature (car type1))))
- (unless (eq (aref signature (car type2)) ?})
- (error "Unterminated dict-entry"))
- (cons (car type2) (list :dict-entry (cdr type1) (cdr type2)))))
- (?\(
- (let ((next-offset (1+ offset))
- types
- type)
- (while (and (< next-offset (length signature))
- (not (eq (setq c (aref signature next-offset)) ?\))))
- (setq type (dbus-codegen--read-signature signature next-offset)
- next-offset (car type))
- (push (cdr type) types))
- (unless (eq (aref signature (car type)) ?\))
- (error "Unterminated struct"))
- (cons next-offset (list :struct (nreverse types)))))
- (?a
- (unless (< (1+ offset) (length signature))
- (error "Unterminated array"))
- (let ((type (dbus-codegen--read-signature signature (1+ offset))))
- (cons (car type) (list :array (cdr type)))))
- (?v
- (cons (1+ offset) (list :variant)))))))
-
-(defun dbus-codegen--byte-p (value)
- (and (integerp value)
- (<= 0 value #xFF)))
-
-(defun dbus-codegen--int16-p (value)
- (and (integerp value)
- (<= (- (- #x7FFF) 1) value #x7FFF)))
-
-(defun dbus-codegen--uint16-p (value)
- (and (integerp value)
- (<= 0 value #xFFFF)))
-
-(defun dbus-codegen--object-path-p (value)
- (and (stringp value)
- (string-match "\\`/\\'\\|\\`\\(?:/\\(?:[A-Za-z0-9_]+\\)\\)+\\'" value)))
-
-(defconst dbus-codegen--basic-type-check-alist
- '((:byte . dbus-codegen--byte-p)
- (:boolean . booleanp)
- (:int16 . dbus-codegen--int16-p)
- (:uint16 . dbus-codegen--uint16-p)
- (:int32 . integerp)
- (:uint32 . natnump)
- (:int64 . integerp)
- (:uint64 . natnump)
- (:double . floatp)
- (:string . stringp)
- (:object-path . dbus-codegen--object-path-p)
- (:signature . stringp)
- (:unix-fd . natnump))
- "An alist mapping from Lisp symbols to predicates that check value types.")
-
-(defun dbus-codegen--annotate-arg (type arg)
- (pcase type
- ((and basic (or :byte :boolean :int16 :uint16 :int32 :uint32 :int64 :uint64
- :double :string :object-path :signature :unix-fd))
- (let ((entry (assq basic dbus-codegen--basic-type-check-alist)))
- (when (and entry
- (not (funcall (cdr entry) arg)))
- (signal 'wrong-type-argument (list (cdr entry) arg))))
- (list basic arg))
- (`(:array ,elttype)
- ;; FIXME: an empty array must have a `:signature' element to
- ;; denote the element type.
- (list (cons :array
- (apply #'nconc
- (mapcar (lambda (subarg)
- (dbus-codegen--annotate-arg elttype subarg))
- arg)))))
- (`(:struct . ,memtypes)
- (list (cons :struct (apply #'nconc
- (cl-mapcar
- (lambda (memtype subarg)
- (dbus-codegen--annotate-arg memtype subarg))
- memtypes arg)))))
- (`(:variant)
- (list (cons :variant (apply #'nconc
- (mapcar (lambda (subarg) (list subarg))
- arg)))))
- (`(:dict-entry ,keytype ,valtype)
- (list (cons :dict-entry
- (nconc (dbus-codegen--annotate-arg keytype (car arg))
- (dbus-codegen--annotate-arg valtype (cdr arg))))))
- (_ (error "Unknown type specification: %S" type))))
-
-(defun dbus-codegen--collect-arglist-with-type-annotation (args transform-name)
- (delq nil (mapcar
- (lambda (arg)
- (let ((direction
- (xml-get-attribute-or-nil (nth 2 arg) 'direction))
- (type
- (xml-get-attribute-or-nil (nth 2 arg) 'type)))
- (if (or (null direction)
- (equal direction "in"))
- (let ((signature (dbus-codegen--read-signature type 0)))
- `(dbus-codegen--annotate-arg ,(cdr signature)
- ,(intern (car arg)))))))
- (dbus-codegen--apply-transform-name args transform-name))))
-
-(declare-function subword-forward "subword.el" (&optional arg))
-(defun dbus-codegen-transform-name (name)
- "Transform NAME into suitable Lisp function name."
- (require 'subword)
- (with-temp-buffer
- (let (words)
- (insert name)
- (goto-char (point-min))
- (while (not (eobp))
- ;; Skip characters not recognized by subword-mode.
- (if (looking-at "[^[:lower:][:upper:][:digit:]]+")
- (goto-char (match-end 0)))
- (push (downcase (buffer-substring (point) (progn (subword-forward 1)
- (point))))
- words))
- (mapconcat #'identity (nreverse words) "-"))))
-
-;; Emit wrappers around `dbus-call-method'.
-(defun dbus-codegen--emit-call-method (name methods transform-name)
- (apply
- #'nconc
- (mapcar
- (lambda (method)
- (let ((arglist (dbus-codegen--collect-arglist
- (xml-get-children
- (car (xml-get-children method 'method))
- 'arg)
- transform-name))
- (annotated-arglist
- (dbus-codegen--collect-arglist-with-type-annotation
- (xml-get-children
- (car (xml-get-children method 'method)) 'arg)
- transform-name)))
- `((cl-defgeneric
- ,(intern (format "%s-%s" name (car method)))
- (object ,@arglist &rest args)
- ,(format "Call the \"%s\" method of OBJECT."
- (nth 1 method)))
- (cl-defmethod
- ,(intern (format "%s-%s" name (car method)))
- ((object ,name) ,@arglist &rest args)
- (apply #'dbus-call-method
- (,(intern (format "%s-bus" name )) object)
- (,(intern (format "%s-service" name)) object)
- (,(intern (format "%s-path" name)) object)
- (,(intern (format "%s-interface" name)) object)
- ,(nth 1 method)
- (append ,@annotated-arglist args))))))
- methods)))
-
-;; Emit wrappers around `dbus-call-method-asynchronously'.
-(defun dbus-codegen--emit-call-method-asynchronously (name methods
- transform-name)
- (apply
- #'nconc
- (mapcar
- (lambda (method)
- (let ((arglist (dbus-codegen--collect-arglist
- (xml-get-children
- (car (xml-get-children method 'method))
- 'arg)
- transform-name))
- (annotated-arglist
- (dbus-codegen--collect-arglist-with-type-annotation
- (xml-get-children
- (car (xml-get-children method 'method))
- 'arg)
- transform-name)))
- `((cl-defgeneric
- ,(intern (format "%s-%s-asynchronously"
- name (car method)))
- ((object ,name) ,@arglist handler &rest args)
- ,(format "Asynchronously call the \"%s\" method of OBJECT."
- (nth 1 method)))
- (cl-defmethod
- ,(intern (format "%s-%s-asynchronously"
- name (car method)))
- ((object ,name) ,@arglist handler &rest args)
- (apply #'dbus-call-method-asynchronously
- (,(intern (format "%s-bus" name )) object)
- (,(intern (format "%s-service" name)) object)
- (,(intern (format "%s-path" name)) object)
- (,(intern (format "%s-interface" name)) object)
- ,(nth 1 method)
- handler
- (append ,@annotated-arglist args))))))
- methods)))
-
-;; Emit wrappers around `dbus-register-signal'.
-(defun dbus-codegen--emit-register-signal (name signals)
- (apply
- #'nconc
- (mapcar
- (lambda (signal)
- `((cl-defgeneric
- ,(intern (format "%s-register-%s-signal" name (car signal)))
- (object handler &rest args)
- ,(format "Register HANDLER to the \"%s\" signal of OBJECT."
- (nth 1 signal)))
- (cl-defmethod
- ,(intern (format "%s-register-%s-signal" name (car signal)))
- ((object ,name) handler &rest args)
- (push (apply #'dbus-register-signal
- (,(intern (format "%s-bus" name )) object)
- (,(intern (format "%s-service" name)) object)
- (,(intern (format "%s-path" name)) object)
- (,(intern (format "%s-interface" name)) object)
- ,(nth 1 signal)
- (lambda (&rest args)
- (apply handler object args))
- args)
- (,(intern (format "%s-registration-list" name)) object)))))
- signals)))
-
-;; Emit wrappers around `dbus-send-signal'.
-(defun dbus-codegen--emit-send-signal (name signals transform-name)
- (apply
- #'nconc
- (mapcar
- (lambda (signal)
- (let ((arglist (dbus-codegen--collect-arglist
- (xml-get-children
- (car (xml-get-children signal 'signal))
- 'arg)
- transform-name))
- (annotated-arglist
- (dbus-codegen--collect-arglist-with-type-annotation
- (xml-get-children
- (car (xml-get-children signal 'signal))
- 'arg)
- transform-name)))
- `((cl-defgeneric
- ,(intern (format "%s-send-%s-signal"
- name (car signal)))
- (object ,@arglist &rest args)
- ,(format "Send the \"%s\" signal of OBJECT."
- (nth 1 signal)))
- (cl-defmethod
- ,(intern (format "%s-send-%s-signal"
- name (car signal)))
- ((object ,name) ,@arglist &rest args)
- (apply #'dbus-send-signal
- (,(intern (format "%s-bus" name )) object)
- (,(intern (format "%s-service" name)) object)
- (,(intern (format "%s-path" name)) object)
- (,(intern (format "%s-interface" name)) object)
- ,(nth 1 signal)
- (append ,@annotated-arglist args))))))
- signals)))
-
-;; Emit generic functions for signal handlers.
-(defun dbus-codegen--emit-signal-defgeneric (name signals transform-name)
- (mapcar
- (lambda (signal)
- (let ((arglist (dbus-codegen--collect-arglist
- (xml-get-children
- (car (xml-get-children signal 'signal))
- 'arg)
- transform-name)))
- `(cl-defgeneric
- ,(intern (format "%s-handle-%s-signal" name (car signal)))
- (object ,@arglist)
- ,(format "Generic function called upon receiving the \"%s\" signal."
- (nth 1 signal))
- (list object ,@arglist)
- nil)))
- signals))
-
-;; Emit wrappers around `dbus-get-property'.
-(defun dbus-codegen--emit-retrieve-property (name properties)
- (apply
- #'nconc
- (mapcar
- (lambda (property)
- `((cl-defgeneric
- ,(intern (format "%s-retrieve-%s-property"
- name (car property)))
- (object)
- ,(format "Retrieve the value of the \"%s\" property of OBJECT."
- (nth 1 property)))
- (cl-defmethod
- ,(intern (format "%s-retrieve-%s-property"
- name (car property)))
- ((object ,name))
- (setf (,(intern (format "%s-%s" name (car property)))
- object)
- (dbus-get-property
- (,(intern (format "%s-bus" name )) object)
- (,(intern (format "%s-service" name)) object)
- (,(intern (format "%s-path" name)) object)
- (,(intern (format "%s-interface" name)) object)
- ,(nth 1 property))))))
- properties)))
-
-;; Emit generic functions for method handlers.
-(defun dbus-codegen--emit-method-defgeneric (name methods transform-name)
- (mapcar
- (lambda (method)
- (let ((arglist (dbus-codegen--collect-arglist
- (xml-get-children
- (car (xml-get-children method 'method))
- 'arg)
- transform-name)))
- `(cl-defgeneric
- ,(intern (format "%s-handle-%s-method" name (car method)))
- (object ,@arglist)
- ,(format "Generic function called when the \"%s\" method is called."
- (nth 1 method))
- (list object ,@arglist)
- nil)))
- methods))
-
-;; Emit wrappers around `dbus-register-method'.
-(defun dbus-codegen--emit-register-method (name methods)
- (apply
- #'nconc
- (mapcar
- (lambda (method)
- `((cl-defgeneric
- ,(intern (format "%s-register-%s-method" name (car method)))
- (object handler &rest args)
- ,(format "Register HANDLER to the \"%s\" method of OBJECT."
- (nth 1 method)))
- (cl-defmethod
- ,(intern (format "%s-register-%s-method" name (car method)))
- ((object ,name) handler &rest args)
- (push (apply #'dbus-register-method
- (,(intern (format "%s-bus" name )) object)
- (,(intern (format "%s-service" name)) object)
- (,(intern (format "%s-path" name)) object)
- (,(intern (format "%s-interface" name)) object)
- ,(nth 1 method)
- (lambda (&rest args)
- (apply handler object args))
- args)
- (,(intern (format "%s-registration-list" name)) object)))))
- methods)))
-
-;; Emit wrappers around `dbus-register-property'.
-(defun dbus-codegen--emit-register-property (name properties)
- (apply
- #'nconc
- (mapcar
- (lambda (property)
- (let* ((annotations
- (delq nil
- (mapcar
- (lambda (annotation)
- (if (equal
- (xml-get-attribute-or-nil annotation 'name)
- "org.freedesktop.DBus.Property.EmitsChangedSignal")
- annotation))
- (xml-get-children (nth 2 property) 'annotation))))
- (emits-signal
- (or (null annotations)
- (not (equal (xml-get-attribute-or-nil (car annotations)
- 'value)
- "false")))))
- `((cl-defgeneric
- ,(intern (format "%s-register-%s-property" name (car property)))
- (object value &rest args)
- ,(format "Register VALUE of the \"%s\" property of OBJECT."
- (nth 1 property)))
- (cl-defmethod
- ,(intern (format "%s-register-%s-property" name (car property)))
- ((object ,name) value &rest args)
- (setf (,(intern (format "%s-%s" name (car property))) object) value)
- (push (apply #'dbus-register-property
- (,(intern (format "%s-bus" name )) object)
- (,(intern (format "%s-service" name)) object)
- (,(intern (format "%s-path" name)) object)
- (,(intern (format "%s-interface" name)) object)
- ,(nth 1 property)
- value
- ,@(if emits-signal
- (list :emits-signal t))
- args)
- (,(intern (format "%s-registration-list" name)) object))))))
- properties)))
-
-;;;###autoload
-(defmacro dbus-codegen-define-proxy (name xml interface &rest args)
- "Define a new D-Bus proxy NAME.
-This defines a new struct type for the proxy and convenient
-functions for D-Bus method calls and signal registration.
-
-XML is either a string which defines the interface of the D-Bus
-proxy, or a Lisp form which returns a string. The format of the
-string must comply with the standard D-Bus introspection data
-format as described in:
-`http://dbus.freedesktop.org/doc/dbus-specification.html#introspection-format'.
-
-INTERFACE is a name of interface which is represented by this
-proxy.
-
-ARGS are keyword-value pair. Currently only one keyword is
-supported:
-
-:transform-name FUNCTION -- FUNCTION is a function which converts
-D-Bus method/signal/property names, into another representation.
-By default `dbus-codegen-transform-name' is used."
- ;; FIXME: A lot of redundancy with dbus-codegen-define-skeleton.
- (unless (symbolp name)
- (signal 'wrong-type-argument (list 'symbolp name)))
- ;; Accept a Lisp form as well as a string.
- (unless (stringp xml)
- (setq xml (eval xml)))
- (unless (stringp xml)
- (signal 'wrong-type-argument (list 'stringp xml)))
- (let ((node (car (with-temp-buffer
- (insert xml)
- (xml-parse-region (point-min) (point-max)))))
- (transform-name (or (plist-get args :transform-name)
- #'dbus-codegen-transform-name)))
- (unless (eq (xml-node-name node) 'node)
- (error "Root is not \"node\""))
- ;; Accept a quoted form of a function, such as #'func.
- (unless (functionp transform-name)
- (setq transform-name (eval transform-name)))
- (let ((interface-node
- (cl-find-if (lambda (element)
- (equal (xml-get-attribute-or-nil element 'name)
- interface))
- (xml-get-children node 'interface))))
- (unless interface-node
- (error "Interface %s is missing" interface))
- (let ((methods (dbus-codegen--apply-transform-name
- (xml-get-children interface-node 'method)
- transform-name))
- (properties (dbus-codegen--apply-transform-name
- (xml-get-children interface-node 'property)
- transform-name))
- (signals (dbus-codegen--apply-transform-name
- (xml-get-children interface-node 'signal)
- transform-name)))
- `(progn
- ;; Define a new struct.
- (cl-defstruct (,name (:include dbus-codegen-proxy)
- (:constructor nil)
- (:constructor ,(intern (format "%s--make" name))
- (bus service path interface)))
- ;; Slots for cached property values.
- ,@(mapcar
- (lambda (property)
- (intern (car property)))
- properties))
-
- ;; Define a constructor.
- (defun ,(intern (format "%s-create" name)) (bus service path)
- ,(format "Create a new D-Bus proxy for %s.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name to be used. PATH is the D-Bus
-object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE."
- interface)
- (let ((proxy (,(intern (format "%s--make" name))
- bus service path ,interface)))
- ,(when properties
- ;; Initialize slots.
- `(let ((properties (dbus-get-all-properties bus service path
- ,interface)))
- ,@(mapcar
- (lambda (property)
- `(setf (,(intern (format "%s-%s" name (car property)))
- proxy)
- (cdr (assoc ,(nth 1 property) properties))))
- properties)
- (push (dbus-register-signal
- bus service path dbus-interface-properties
- "PropertiesChanged"
- (lambda (interface changed invalidated)
- (,(intern (format "%s--handle-properties-changed"
- name))
- proxy
- interface changed invalidated))
- :arg0 ,interface)
- (,(intern (format "%s-registration-list" name))
- proxy))))
- ;; Register signal handlers.
- ,@(mapcar
- (lambda (signal)
- `(push (dbus-register-signal
- bus service path ,interface
- ,(nth 1 signal)
- (lambda (&rest args)
- (apply #',(intern (format "%s-handle-%s-signal"
- name (car signal)))
- proxy args)))
- (,(intern (format "%s-registration-list" name))
- proxy)))
- signals)
- proxy))
-
- ,(when properties
- ;; Define a handler of PropertiesChanged signal.
- `(defun ,(intern (format "%s--handle-properties-changed" name))
- (proxy interface changed invalidated)
- (when (equal interface ,interface)
- ,@(mapcar
- (lambda (property)
- `(let ((changed-value
- (cdr (assoc ,(nth 1 property) changed)))
- (invalidated-property
- (car (member ,(nth 1 property) invalidated)))
- invalidated-value)
- (when changed-value
- (setf (,(intern (format "%s-%s"
- name (car property)))
- proxy)
- (car (car changed-value))))
- (when invalidated-property
- (setq invalidated-value
- (dbus-get-property
- (,(intern (format "%s-bus" name)) proxy)
- (,(intern (format "%s-service" name)) proxy)
- (,(intern (format "%s-path" name)) proxy)
- ,interface
- ,(car property)))
- (when invalidated-value
- (setf (,(intern (format "%s-%s"
- name (car property)))
- proxy)
- invalidated-value)))))
- properties))))
-
- ;; Define a destructor.
- (cl-defgeneric ,(intern (format "%s-destroy" name)) (proxy)
- "Destroy a D-Bus proxy PROXY.")
-
- (cl-defmethod ,(intern (format "%s-destroy" name)) ((proxy ,name))
- (dolist (registration (,(intern (format "%s-registration-list"
- name))
- proxy))
- (dbus-unregister-object registration))
- (setf (,(intern (format "%s-registration-list" name)) proxy) nil))
-
- ;; Emit common helper functions.
- ,@(dbus-codegen--emit-signal-defgeneric name signals transform-name)
- ,@(dbus-codegen--emit-send-signal name signals transform-name)
- ,@(dbus-codegen--emit-register-signal name signals)
- ;; Emit helper functions for proxy.
- ,@(dbus-codegen--emit-call-method name methods transform-name)
- ,@(dbus-codegen--emit-call-method-asynchronously name methods
- transform-name)
- ,@(dbus-codegen--emit-retrieve-property name properties))))))
-
-;;;###autoload
-(defun dbus-codegen-make-proxy (name bus service path interface &rest args)
- "Create a new D-Bus proxy based on the introspection data.
-
-If the data type of the D-Bus proxy is not yet defined, this will
-define it with `dbus-codegen-define-proxy', under a type name NAME.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name to be used. PATH is the D-Bus
-object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE.
-
-INTERFACE is an interface which is represented by this proxy.
-
-ARGS are keyword-value pair. Currently only one keyword is
-supported:
-
-:redefine FLAG -- if FLAG is non-nil, redefine the data type and
-associated functions.
-
-Other keywords are same as `dbus-codegen-define-proxy'."
- (require 'xml)
- (require 'subword)
- (let ((constructor (intern (format "%s--make" name))))
- (if (or (plist-get args :redefine)
- (not (fboundp constructor)))
- (eval `(dbus-codegen-define-proxy ,name
- ,(dbus-introspect bus service path)
- ,interface
- ,@args)))
- (funcall constructor bus service path)))
-
-(defmacro dbus-codegen-define-skeleton (name xml interface &rest args)
- "Define a new D-Bus skeleton NAME.
-This defines a new struct type for the skeleton and convenient
-functions for D-Bus method calls and signal registration.
-
-XML is either a string which defines the interface of the D-Bus
-skeleton, or a Lisp form which returns a string. The format of the
-string must comply with the standard D-Bus introspection data
-format as described in:
-`http://dbus.freedesktop.org/doc/dbus-specification.html#introspection-format'.
-
-INTERFACE is a name of interface which is represented by this
-skeleton.
-
-ARGS are keyword-value pair. Currently only one keyword is
-supported:
-
-:transform-name FUNCTION -- FUNCTION is a function which converts
-D-Bus method/signal/property names, into another representation.
-By default `dbus-codegen-transform-name' is used."
- ;; FIXME: A lot of redundancy with dbus-codegen-define-proxy.
- (unless (symbolp name)
- (signal 'wrong-type-argument (list 'symbolp name)))
- ;; Accept a Lisp form as well as a string.
- (unless (stringp xml)
- (setq xml (eval xml)))
- (unless (stringp xml)
- (signal 'wrong-type-argument (list 'stringp xml)))
- (let ((node (car (with-temp-buffer
- (insert xml)
- (xml-parse-region (point-min) (point-max)))))
- (transform-name (or (plist-get args :transform-name)
- #'dbus-codegen-transform-name)))
- (unless (eq (xml-node-name node) 'node)
- (error "Root is not \"node\""))
- ;; Accept a quoted form of a function, such as #'func.
- (unless (functionp transform-name)
- (setq transform-name (eval transform-name)))
- (let ((interface-node
- (cl-find-if (lambda (element)
- (equal (xml-get-attribute-or-nil element 'name)
- interface))
- (xml-get-children node 'interface))))
- (unless interface-node
- (error "Interface %s is missing" interface))
- (let ((methods (dbus-codegen--apply-transform-name
- (xml-get-children interface-node 'method)
- transform-name))
- (properties (dbus-codegen--apply-transform-name
- (xml-get-children interface-node 'property)
- transform-name))
- (signals (dbus-codegen--apply-transform-name
- (xml-get-children interface-node 'signal)
- transform-name)))
- `(progn
- ;; Define a new struct.
- (cl-defstruct (,name (:include dbus-codegen-skeleton)
- (:constructor nil)
- (:constructor ,(intern (format "%s--make" name))
- (bus service path interface)))
- ;; Slots for cached property values.
- ,@(mapcar
- (lambda (property)
- (intern (car property)))
- properties))
-
- ;; Define a constructor.
- (defun ,(intern (format "%s-create" name))
- (bus service path &rest args)
- ,(format "Create a new D-Bus skeleton for %s.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name to be used. PATH is the D-Bus
-object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE."
- interface)
- (let ((skeleton (,(intern (format "%s--make" name))
- bus service path ,interface)))
- (apply #'dbus-register-service bus service args)
- ;; Register method handlers.
- ,@(mapcar
- (lambda (method)
- `(push (dbus-register-method
- bus service path ,interface
- ,(nth 1 method)
- (lambda (&rest args)
- (apply #',(intern (format "%s-handle-%s-method"
- name (car method)))
- skeleton args)))
- (,(intern (format "%s-registration-list" name))
- skeleton)))
- methods)
- skeleton))
-
- ;; Define a destructor.
- (cl-defgeneric ,(intern (format "%s-destroy" name)) (skeleton)
- "Destroy a D-Bus skeleton SKELETON.")
-
- (cl-defmethod ,(intern (format "%s-destroy" name)) ((skeleton ,name))
- (dolist (registration (,(intern (format "%s-registration-list"
- name))
- skeleton))
- (dbus-unregister-object registration))
- (setf (,(intern (format "%s-registration-list" name)) skeleton)
- nil)
- (dbus-unregister-service bus service))
-
- ;; Emit common helper functions.
- ,@(dbus-codegen--emit-signal-defgeneric name signals transform-name)
- ,@(dbus-codegen--emit-send-signal name signals transform-name)
- ,@(dbus-codegen--emit-register-signal name signals)
- ;; Emit helper functions for skeleton.
- ,@(dbus-codegen--emit-method-defgeneric name methods transform-name)
- ,@(dbus-codegen--emit-register-method name methods)
- ,@(dbus-codegen--emit-register-property name properties))))))
-
-(provide 'dbus-codegen)
-
-;;; dbus-codegen.el ends here
diff --git a/packages/dbus-codegen/tests/dbus-codegen-tests.el
b/packages/dbus-codegen/tests/dbus-codegen-tests.el
deleted file mode 100644
index 6184c46..0000000
--- a/packages/dbus-codegen/tests/dbus-codegen-tests.el
+++ /dev/null
@@ -1,130 +0,0 @@
-;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'ert)
-(require 'dbus-codegen)
-
-(ert-deftest dbus-codegen--read-signature ()
- (should (equal '(1 . :int32) (dbus-codegen--read-signature "i" 0)))
- (should-error (dbus-codegen--read-signature "a" 0))
- (should (equal '(2 :array :int32) (dbus-codegen--read-signature "ai" 0)))
- (should (equal '(4 :array (:dict-entry :string :int32))
- (dbus-codegen--read-signature "a{si}" 0)))
- (should (equal '(4 :array (:dict-entry :string (:variant)))
- (dbus-codegen--read-signature "a{sv}" 0)))
- (should-error (dbus-codegen--read-signature "a{sii}" 0))
- (should (equal '(5 :array (:struct (:string :int32 :int32)))
- (dbus-codegen--read-signature "a(sii)" 0))))
-
-(ert-deftest dbus-codegen--object-path-p ()
- (should (dbus-codegen--object-path-p "/"))
- (should (not (dbus-codegen--object-path-p "//")))
- (should (not (dbus-codegen--object-path-p "/a/")))
- (should (dbus-codegen--object-path-p "/a/b"))
- (should (not (dbus-codegen--object-path-p "/a!")))
- (should (dbus-codegen--object-path-p "/a")))
-
-(ert-deftest dbus-codegen--annotate-arg ()
- (should (equal '(:int32 1)
- (dbus-codegen--annotate-arg ':int32 1)))
- (should-error (dbus-codegen--annotate-arg '(:array :int32) 1))
- (should (equal '((:array :int32 1 :int32 2 :int32 3))
- (dbus-codegen--annotate-arg '(:array :int32) '(1 2 3))))
- ;; Type mismatch of the first element of a struct.
- (should-error (dbus-codegen--annotate-arg '(:struct :string :int32 :int32)
- '(1 2 3)))
- (should (equal '((:array (:dict-entry :string "a" :int32 1)
- (:dict-entry :string "b" :int32 2)
- (:dict-entry :string "c" :int32 3)))
- (dbus-codegen--annotate-arg
- '(:array (:dict-entry :string :int32))
- '(("a" . 1) ("b" . 2) ("c" . 3))))))
-
-(eval-when-compile
- (defconst dbus-codegen-tests-introspection-data "\
-<node>
- <interface name='org.gtk.GDBus.PeerTestInterface'>
- <method name='HelloPeer'>
- <arg type='s' name='greeting' direction='in'/>
- <arg type='s' name='response' direction='out'/>
- </method>
- <method name='EmitSignal'/>
- <method name='EmitSignalWithNameSet'/>
- <method name='OpenFile'>
- <arg type='s' name='path' direction='in'/>
- </method>
- <signal name='PeerSignal'>
- <arg type='s' name='a_string'/>
- </signal>
- <property type='s' name='PeerProperty' access='read'/>
- <property type='s' name='PeerPropertyAnnotated' access='read'>
- <annotation name='org.freedesktop.DBus.Property.EmitsChangedSignal'
- value='false'/>
- </property>
- </interface>
-</node>"))
-
-(ert-deftest dbus-codegen-define-proxy ()
- (dbus-codegen-define-proxy test-proxy
- dbus-codegen-tests-introspection-data
- "org.gtk.GDBus.PeerTestInterface")
- (should (fboundp 'test-proxy-create))
- (should (fboundp 'test-proxy-destroy))
- (should (fboundp 'test-proxy-hello-peer))
- (should (fboundp 'test-proxy-hello-peer-asynchronously))
- (should (fboundp 'test-proxy-emit-signal))
- (should (fboundp 'test-proxy-emit-signal-asynchronously))
- (should (fboundp 'test-proxy-emit-signal-with-name-set))
- (should (fboundp 'test-proxy-emit-signal-with-name-set-asynchronously))
- (should (fboundp 'test-proxy-open-file))
- (should (fboundp 'test-proxy-open-file-asynchronously))
- (should (fboundp 'test-proxy-register-peer-signal-signal))
- (should (fboundp 'test-proxy-send-peer-signal-signal))
- (should (fboundp 'test-proxy-handle-peer-signal-signal))
- (should (fboundp 'test-proxy-peer-property))
- (should (fboundp 'test-proxy-retrieve-peer-property-property))
- (should (fboundp 'test-proxy-peer-property-annotated))
- (should (fboundp 'test-proxy-retrieve-peer-property-annotated-property)))
-
-(ert-deftest dbus-codegen-define-skeleton ()
- (dbus-codegen-define-skeleton test-skeleton
- dbus-codegen-tests-introspection-data
- "org.gtk.GDBus.PeerTestInterface")
- (should (fboundp 'test-skeleton-create))
- (should (fboundp 'test-skeleton-destroy))
- (should (fboundp 'test-skeleton-register-hello-peer-method))
- (should (fboundp 'test-skeleton-handle-hello-peer-method))
- (should (fboundp 'test-skeleton-register-emit-signal-method))
- (should (fboundp 'test-skeleton-handle-emit-signal-method))
- (should (fboundp 'test-skeleton-register-emit-signal-with-name-set-method))
- (should (fboundp 'test-skeleton-handle-emit-signal-with-name-set-method))
- (should (fboundp 'test-skeleton-register-open-file-method))
- (should (fboundp 'test-skeleton-handle-open-file-method))
- (should (fboundp 'test-skeleton-register-peer-signal-signal))
- (should (fboundp 'test-skeleton-send-peer-signal-signal))
- (should (fboundp 'test-skeleton-handle-peer-signal-signal))
- (should (fboundp 'test-skeleton-register-peer-property-property))
- (should (fboundp 'test-proxy-peer-property-annotated))
- (should (fboundp 'test-proxy-retrieve-peer-property-annotated-property)))
-
-(provide 'dbus-codegen-tests)
-
-;;; dbus-codegen-tests.el ends here
diff --git a/packages/enwc/.bzrignore b/packages/enwc/.bzrignore
deleted file mode 100644
index c531d98..0000000
--- a/packages/enwc/.bzrignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/packages/enwc/.hgignore b/packages/enwc/.hgignore
deleted file mode 100644
index e1b6cde..0000000
--- a/packages/enwc/.hgignore
+++ /dev/null
@@ -1,4 +0,0 @@
-syntax: glob
-
-*.elc
-enwc-autoloads.el
\ No newline at end of file
diff --git a/packages/enwc/.hgtags b/packages/enwc/.hgtags
deleted file mode 100644
index 39afd88..0000000
--- a/packages/enwc/.hgtags
+++ /dev/null
@@ -1,7 +0,0 @@
-3e2cab525cbc1c8664207fe9c01978335911b0a3 2.0
-3e2cab525cbc1c8664207fe9c01978335911b0a3 2.0
-0000000000000000000000000000000000000000 2.0
-0000000000000000000000000000000000000000 2.0
-cc2f7aa4ed369769e4aec5cdc4a6b1a2d28375b3 2.0
-cc2f7aa4ed369769e4aec5cdc4a6b1a2d28375b3 2.0
-0000000000000000000000000000000000000000 2.0
diff --git a/packages/enwc/COPYING b/packages/enwc/COPYING
deleted file mode 100644
index 94a9ed0..0000000
--- a/packages/enwc/COPYING
+++ /dev/null
@@ -1,674 +0,0 @@
- GNU GENERAL PUBLIC LICENSE
- Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The GNU General Public License is a free, copyleft license for
-software and other kinds of works.
-
- The licenses for most software and other practical works are designed
-to take away your freedom to share and change the works. By contrast,
-the GNU General Public License is intended to guarantee your freedom to
-share and change all versions of a program--to make sure it remains free
-software for all its users. We, the Free Software Foundation, use the
-GNU General Public License for most of our software; it applies also to
-any other work released this way by its authors. You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-them if you wish), that you receive source code or can get it if you
-want it, that you can change the software or use pieces of it in new
-free programs, and that you know you can do these things.
-
- To protect your rights, we need to prevent others from denying you
-these rights or asking you to surrender the rights. Therefore, you have
-certain responsibilities if you distribute copies of the software, or if
-you modify it: responsibilities to respect the freedom of others.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must pass on to the recipients the same
-freedoms that you received. You must make sure that they, too, receive
-or can get the source code. And you must show them these terms so they
-know their rights.
-
- Developers that use the GNU GPL protect your rights with two steps:
-(1) assert copyright on the software, and (2) offer you this License
-giving you legal permission to copy, distribute and/or modify it.
-
- For the developers' and authors' protection, the GPL clearly explains
-that there is no warranty for this free software. For both users' and
-authors' sake, the GPL requires that modified versions be marked as
-changed, so that their problems will not be attributed erroneously to
-authors of previous versions.
-
- Some devices are designed to deny users access to install or run
-modified versions of the software inside them, although the manufacturer
-can do so. This is fundamentally incompatible with the aim of
-protecting users' freedom to change the software. The systematic
-pattern of such abuse occurs in the area of products for individuals to
-use, which is precisely where it is most unacceptable. Therefore, we
-have designed this version of the GPL to prohibit the practice for those
-products. If such problems arise substantially in other domains, we
-stand ready to extend this provision to those domains in future versions
-of the GPL, as needed to protect the freedom of users.
-
- Finally, every program is threatened constantly by software patents.
-States should not allow patents to restrict development and use of
-software on general-purpose computers, but in those that do, we wish to
-avoid the special danger that patents applied to a free program could
-make it effectively proprietary. To prevent this, the GPL assures that
-patents cannot be used to render the program non-free.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- TERMS AND CONDITIONS
-
- 0. Definitions.
-
- "This License" refers to version 3 of the GNU General Public License.
-
- "Copyright" also means copyright-like laws that apply to other kinds of
-works, such as semiconductor masks.
-
- "The Program" refers to any copyrightable work licensed under this
-License. Each licensee is addressed as "you". "Licensees" and
-"recipients" may be individuals or organizations.
-
- To "modify" a work means to copy from or adapt all or part of the work
-in a fashion requiring copyright permission, other than the making of an
-exact copy. The resulting work is called a "modified version" of the
-earlier work or a work "based on" the earlier work.
-
- A "covered work" means either the unmodified Program or a work based
-on the Program.
-
- To "propagate" a work means to do anything with it that, without
-permission, would make you directly or secondarily liable for
-infringement under applicable copyright law, except executing it on a
-computer or modifying a private copy. Propagation includes copying,
-distribution (with or without modification), making available to the
-public, and in some countries other activities as well.
-
- To "convey" a work means any kind of propagation that enables other
-parties to make or receive copies. Mere interaction with a user through
-a computer network, with no transfer of a copy, is not conveying.
-
- An interactive user interface displays "Appropriate Legal Notices"
-to the extent that it includes a convenient and prominently visible
-feature that (1) displays an appropriate copyright notice, and (2)
-tells the user that there is no warranty for the work (except to the
-extent that warranties are provided), that licensees may convey the
-work under this License, and how to view a copy of this License. If
-the interface presents a list of user commands or options, such as a
-menu, a prominent item in the list meets this criterion.
-
- 1. Source Code.
-
- The "source code" for a work means the preferred form of the work
-for making modifications to it. "Object code" means any non-source
-form of a work.
-
- A "Standard Interface" means an interface that either is an official
-standard defined by a recognized standards body, or, in the case of
-interfaces specified for a particular programming language, one that
-is widely used among developers working in that language.
-
- The "System Libraries" of an executable work include anything, other
-than the work as a whole, that (a) is included in the normal form of
-packaging a Major Component, but which is not part of that Major
-Component, and (b) serves only to enable use of the work with that
-Major Component, or to implement a Standard Interface for which an
-implementation is available to the public in source code form. A
-"Major Component", in this context, means a major essential component
-(kernel, window system, and so on) of the specific operating system
-(if any) on which the executable work runs, or a compiler used to
-produce the work, or an object code interpreter used to run it.
-
- The "Corresponding Source" for a work in object code form means all
-the source code needed to generate, install, and (for an executable
-work) run the object code and to modify the work, including scripts to
-control those activities. However, it does not include the work's
-System Libraries, or general-purpose tools or generally available free
-programs which are used unmodified in performing those activities but
-which are not part of the work. For example, Corresponding Source
-includes interface definition files associated with source files for
-the work, and the source code for shared libraries and dynamically
-linked subprograms that the work is specifically designed to require,
-such as by intimate data communication or control flow between those
-subprograms and other parts of the work.
-
- The Corresponding Source need not include anything that users
-can regenerate automatically from other parts of the Corresponding
-Source.
-
- The Corresponding Source for a work in source code form is that
-same work.
-
- 2. Basic Permissions.
-
- All rights granted under this License are granted for the term of
-copyright on the Program, and are irrevocable provided the stated
-conditions are met. This License explicitly affirms your unlimited
-permission to run the unmodified Program. The output from running a
-covered work is covered by this License only if the output, given its
-content, constitutes a covered work. This License acknowledges your
-rights of fair use or other equivalent, as provided by copyright law.
-
- You may make, run and propagate covered works that you do not
-convey, without conditions so long as your license otherwise remains
-in force. You may convey covered works to others for the sole purpose
-of having them make modifications exclusively for you, or provide you
-with facilities for running those works, provided that you comply with
-the terms of this License in conveying all material for which you do
-not control copyright. Those thus making or running the covered works
-for you must do so exclusively on your behalf, under your direction
-and control, on terms that prohibit them from making any copies of
-your copyrighted material outside their relationship with you.
-
- Conveying under any other circumstances is permitted solely under
-the conditions stated below. Sublicensing is not allowed; section 10
-makes it unnecessary.
-
- 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
-
- No covered work shall be deemed part of an effective technological
-measure under any applicable law fulfilling obligations under article
-11 of the WIPO copyright treaty adopted on 20 December 1996, or
-similar laws prohibiting or restricting circumvention of such
-measures.
-
- When you convey a covered work, you waive any legal power to forbid
-circumvention of technological measures to the extent such circumvention
-is effected by exercising rights under this License with respect to
-the covered work, and you disclaim any intention to limit operation or
-modification of the work as a means of enforcing, against the work's
-users, your or third parties' legal rights to forbid circumvention of
-technological measures.
-
- 4. Conveying Verbatim Copies.
-
- You may convey verbatim copies of the Program's source code as you
-receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice;
-keep intact all notices stating that this License and any
-non-permissive terms added in accord with section 7 apply to the code;
-keep intact all notices of the absence of any warranty; and give all
-recipients a copy of this License along with the Program.
-
- You may charge any price or no price for each copy that you convey,
-and you may offer support or warranty protection for a fee.
-
- 5. Conveying Modified Source Versions.
-
- You may convey a work based on the Program, or the modifications to
-produce it from the Program, in the form of source code under the
-terms of section 4, provided that you also meet all of these conditions:
-
- a) The work must carry prominent notices stating that you modified
- it, and giving a relevant date.
-
- b) The work must carry prominent notices stating that it is
- released under this License and any conditions added under section
- 7. This requirement modifies the requirement in section 4 to
- "keep intact all notices".
-
- c) You must license the entire work, as a whole, under this
- License to anyone who comes into possession of a copy. This
- License will therefore apply, along with any applicable section 7
- additional terms, to the whole of the work, and all its parts,
- regardless of how they are packaged. This License gives no
- permission to license the work in any other way, but it does not
- invalidate such permission if you have separately received it.
-
- d) If the work has interactive user interfaces, each must display
- Appropriate Legal Notices; however, if the Program has interactive
- interfaces that do not display Appropriate Legal Notices, your
- work need not make them do so.
-
- A compilation of a covered work with other separate and independent
-works, which are not by their nature extensions of the covered work,
-and which are not combined with it such as to form a larger program,
-in or on a volume of a storage or distribution medium, is called an
-"aggregate" if the compilation and its resulting copyright are not
-used to limit the access or legal rights of the compilation's users
-beyond what the individual works permit. Inclusion of a covered work
-in an aggregate does not cause this License to apply to the other
-parts of the aggregate.
-
- 6. Conveying Non-Source Forms.
-
- You may convey a covered work in object code form under the terms
-of sections 4 and 5, provided that you also convey the
-machine-readable Corresponding Source under the terms of this License,
-in one of these ways:
-
- a) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by the
- Corresponding Source fixed on a durable physical medium
- customarily used for software interchange.
-
- b) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by a
- written offer, valid for at least three years and valid for as
- long as you offer spare parts or customer support for that product
- model, to give anyone who possesses the object code either (1) a
- copy of the Corresponding Source for all the software in the
- product that is covered by this License, on a durable physical
- medium customarily used for software interchange, for a price no
- more than your reasonable cost of physically performing this
- conveying of source, or (2) access to copy the
- Corresponding Source from a network server at no charge.
-
- c) Convey individual copies of the object code with a copy of the
- written offer to provide the Corresponding Source. This
- alternative is allowed only occasionally and noncommercially, and
- only if you received the object code with such an offer, in accord
- with subsection 6b.
-
- d) Convey the object code by offering access from a designated
- place (gratis or for a charge), and offer equivalent access to the
- Corresponding Source in the same way through the same place at no
- further charge. You need not require recipients to copy the
- Corresponding Source along with the object code. If the place to
- copy the object code is a network server, the Corresponding Source
- may be on a different server (operated by you or a third party)
- that supports equivalent copying facilities, provided you maintain
- clear directions next to the object code saying where to find the
- Corresponding Source. Regardless of what server hosts the
- Corresponding Source, you remain obligated to ensure that it is
- available for as long as needed to satisfy these requirements.
-
- e) Convey the object code using peer-to-peer transmission, provided
- you inform other peers where the object code and Corresponding
- Source of the work are being offered to the general public at no
- charge under subsection 6d.
-
- A separable portion of the object code, whose source code is excluded
-from the Corresponding Source as a System Library, need not be
-included in conveying the object code work.
-
- A "User Product" is either (1) a "consumer product", which means any
-tangible personal property which is normally used for personal, family,
-or household purposes, or (2) anything designed or sold for incorporation
-into a dwelling. In determining whether a product is a consumer product,
-doubtful cases shall be resolved in favor of coverage. For a particular
-product received by a particular user, "normally used" refers to a
-typical or common use of that class of product, regardless of the status
-of the particular user or of the way in which the particular user
-actually uses, or expects or is expected to use, the product. A product
-is a consumer product regardless of whether the product has substantial
-commercial, industrial or non-consumer uses, unless such uses represent
-the only significant mode of use of the product.
-
- "Installation Information" for a User Product means any methods,
-procedures, authorization keys, or other information required to install
-and execute modified versions of a covered work in that User Product from
-a modified version of its Corresponding Source. The information must
-suffice to ensure that the continued functioning of the modified object
-code is in no case prevented or interfered with solely because
-modification has been made.
-
- If you convey an object code work under this section in, or with, or
-specifically for use in, a User Product, and the conveying occurs as
-part of a transaction in which the right of possession and use of the
-User Product is transferred to the recipient in perpetuity or for a
-fixed term (regardless of how the transaction is characterized), the
-Corresponding Source conveyed under this section must be accompanied
-by the Installation Information. But this requirement does not apply
-if neither you nor any third party retains the ability to install
-modified object code on the User Product (for example, the work has
-been installed in ROM).
-
- The requirement to provide Installation Information does not include a
-requirement to continue to provide support service, warranty, or updates
-for a work that has been modified or installed by the recipient, or for
-the User Product in which it has been modified or installed. Access to a
-network may be denied when the modification itself materially and
-adversely affects the operation of the network or violates the rules and
-protocols for communication across the network.
-
- Corresponding Source conveyed, and Installation Information provided,
-in accord with this section must be in a format that is publicly
-documented (and with an implementation available to the public in
-source code form), and must require no special password or key for
-unpacking, reading or copying.
-
- 7. Additional Terms.
-
- "Additional permissions" are terms that supplement the terms of this
-License by making exceptions from one or more of its conditions.
-Additional permissions that are applicable to the entire Program shall
-be treated as though they were included in this License, to the extent
-that they are valid under applicable law. If additional permissions
-apply only to part of the Program, that part may be used separately
-under those permissions, but the entire Program remains governed by
-this License without regard to the additional permissions.
-
- When you convey a copy of a covered work, you may at your option
-remove any additional permissions from that copy, or from any part of
-it. (Additional permissions may be written to require their own
-removal in certain cases when you modify the work.) You may place
-additional permissions on material, added by you to a covered work,
-for which you have or can give appropriate copyright permission.
-
- Notwithstanding any other provision of this License, for material you
-add to a covered work, you may (if authorized by the copyright holders of
-that material) supplement the terms of this License with terms:
-
- a) Disclaiming warranty or limiting liability differently from the
- terms of sections 15 and 16 of this License; or
-
- b) Requiring preservation of specified reasonable legal notices or
- author attributions in that material or in the Appropriate Legal
- Notices displayed by works containing it; or
-
- c) Prohibiting misrepresentation of the origin of that material, or
- requiring that modified versions of such material be marked in
- reasonable ways as different from the original version; or
-
- d) Limiting the use for publicity purposes of names of licensors or
- authors of the material; or
-
- e) Declining to grant rights under trademark law for use of some
- trade names, trademarks, or service marks; or
-
- f) Requiring indemnification of licensors and authors of that
- material by anyone who conveys the material (or modified versions of
- it) with contractual assumptions of liability to the recipient, for
- any liability that these contractual assumptions directly impose on
- those licensors and authors.
-
- All other non-permissive additional terms are considered "further
-restrictions" within the meaning of section 10. If the Program as you
-received it, or any part of it, contains a notice stating that it is
-governed by this License along with a term that is a further
-restriction, you may remove that term. If a license document contains
-a further restriction but permits relicensing or conveying under this
-License, you may add to a covered work material governed by the terms
-of that license document, provided that the further restriction does
-not survive such relicensing or conveying.
-
- If you add terms to a covered work in accord with this section, you
-must place, in the relevant source files, a statement of the
-additional terms that apply to those files, or a notice indicating
-where to find the applicable terms.
-
- Additional terms, permissive or non-permissive, may be stated in the
-form of a separately written license, or stated as exceptions;
-the above requirements apply either way.
-
- 8. Termination.
-
- You may not propagate or modify a covered work except as expressly
-provided under this License. Any attempt otherwise to propagate or
-modify it is void, and will automatically terminate your rights under
-this License (including any patent licenses granted under the third
-paragraph of section 11).
-
- However, if you cease all violation of this License, then your
-license from a particular copyright holder is reinstated (a)
-provisionally, unless and until the copyright holder explicitly and
-finally terminates your license, and (b) permanently, if the copyright
-holder fails to notify you of the violation by some reasonable means
-prior to 60 days after the cessation.
-
- Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
- Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License. If your rights have been terminated and not permanently
-reinstated, you do not qualify to receive new licenses for the same
-material under section 10.
-
- 9. Acceptance Not Required for Having Copies.
-
- You are not required to accept this License in order to receive or
-run a copy of the Program. Ancillary propagation of a covered work
-occurring solely as a consequence of using peer-to-peer transmission
-to receive a copy likewise does not require acceptance. However,
-nothing other than this License grants you permission to propagate or
-modify any covered work. These actions infringe copyright if you do
-not accept this License. Therefore, by modifying or propagating a
-covered work, you indicate your acceptance of this License to do so.
-
- 10. Automatic Licensing of Downstream Recipients.
-
- Each time you convey a covered work, the recipient automatically
-receives a license from the original licensors, to run, modify and
-propagate that work, subject to this License. You are not responsible
-for enforcing compliance by third parties with this License.
-
- An "entity transaction" is a transaction transferring control of an
-organization, or substantially all assets of one, or subdividing an
-organization, or merging organizations. If propagation of a covered
-work results from an entity transaction, each party to that
-transaction who receives a copy of the work also receives whatever
-licenses to the work the party's predecessor in interest had or could
-give under the previous paragraph, plus a right to possession of the
-Corresponding Source of the work from the predecessor in interest, if
-the predecessor has it or can get it with reasonable efforts.
-
- You may not impose any further restrictions on the exercise of the
-rights granted or affirmed under this License. For example, you may
-not impose a license fee, royalty, or other charge for exercise of
-rights granted under this License, and you may not initiate litigation
-(including a cross-claim or counterclaim in a lawsuit) alleging that
-any patent claim is infringed by making, using, selling, offering for
-sale, or importing the Program or any portion of it.
-
- 11. Patents.
-
- A "contributor" is a copyright holder who authorizes use under this
-License of the Program or a work on which the Program is based. The
-work thus licensed is called the contributor's "contributor version".
-
- A contributor's "essential patent claims" are all patent claims
-owned or controlled by the contributor, whether already acquired or
-hereafter acquired, that would be infringed by some manner, permitted
-by this License, of making, using, or selling its contributor version,
-but do not include claims that would be infringed only as a
-consequence of further modification of the contributor version. For
-purposes of this definition, "control" includes the right to grant
-patent sublicenses in a manner consistent with the requirements of
-this License.
-
- Each contributor grants you a non-exclusive, worldwide, royalty-free
-patent license under the contributor's essential patent claims, to
-make, use, sell, offer for sale, import and otherwise run, modify and
-propagate the contents of its contributor version.
-
- In the following three paragraphs, a "patent license" is any express
-agreement or commitment, however denominated, not to enforce a patent
-(such as an express permission to practice a patent or covenant not to
-sue for patent infringement). To "grant" such a patent license to a
-party means to make such an agreement or commitment not to enforce a
-patent against the party.
-
- If you convey a covered work, knowingly relying on a patent license,
-and the Corresponding Source of the work is not available for anyone
-to copy, free of charge and under the terms of this License, through a
-publicly available network server or other readily accessible means,
-then you must either (1) cause the Corresponding Source to be so
-available, or (2) arrange to deprive yourself of the benefit of the
-patent license for this particular work, or (3) arrange, in a manner
-consistent with the requirements of this License, to extend the patent
-license to downstream recipients. "Knowingly relying" means you have
-actual knowledge that, but for the patent license, your conveying the
-covered work in a country, or your recipient's use of the covered work
-in a country, would infringe one or more identifiable patents in that
-country that you have reason to believe are valid.
-
- If, pursuant to or in connection with a single transaction or
-arrangement, you convey, or propagate by procuring conveyance of, a
-covered work, and grant a patent license to some of the parties
-receiving the covered work authorizing them to use, propagate, modify
-or convey a specific copy of the covered work, then the patent license
-you grant is automatically extended to all recipients of the covered
-work and works based on it.
-
- A patent license is "discriminatory" if it does not include within
-the scope of its coverage, prohibits the exercise of, or is
-conditioned on the non-exercise of one or more of the rights that are
-specifically granted under this License. You may not convey a covered
-work if you are a party to an arrangement with a third party that is
-in the business of distributing software, under which you make payment
-to the third party based on the extent of your activity of conveying
-the work, and under which the third party grants, to any of the
-parties who would receive the covered work from you, a discriminatory
-patent license (a) in connection with copies of the covered work
-conveyed by you (or copies made from those copies), or (b) primarily
-for and in connection with specific products or compilations that
-contain the covered work, unless you entered into that arrangement,
-or that patent license was granted, prior to 28 March 2007.
-
- Nothing in this License shall be construed as excluding or limiting
-any implied license or other defenses to infringement that may
-otherwise be available to you under applicable patent law.
-
- 12. No Surrender of Others' Freedom.
-
- If conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot convey a
-covered work so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you may
-not convey it at all. For example, if you agree to terms that obligate you
-to collect a royalty for further conveying from those to whom you convey
-the Program, the only way you could satisfy both those terms and this
-License would be to refrain entirely from conveying the Program.
-
- 13. Use with the GNU Affero General Public License.
-
- Notwithstanding any other provision of this License, you have
-permission to link or combine any covered work with a work licensed
-under version 3 of the GNU Affero General Public License into a single
-combined work, and to convey the resulting work. The terms of this
-License will continue to apply to the part which is the covered work,
-but the special requirements of the GNU Affero General Public License,
-section 13, concerning interaction through a network will apply to the
-combination as such.
-
- 14. Revised Versions of this License.
-
- The Free Software Foundation may publish revised and/or new versions of
-the GNU General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
- Each version is given a distinguishing version number. If the
-Program specifies that a certain numbered version of the GNU General
-Public License "or any later version" applies to it, you have the
-option of following the terms and conditions either of that numbered
-version or of any later version published by the Free Software
-Foundation. If the Program does not specify a version number of the
-GNU General Public License, you may choose any version ever published
-by the Free Software Foundation.
-
- If the Program specifies that a proxy can decide which future
-versions of the GNU General Public License can be used, that proxy's
-public statement of acceptance of a version permanently authorizes you
-to choose that version for the Program.
-
- Later license versions may give you additional or different
-permissions. However, no additional obligations are imposed on any
-author or copyright holder as a result of your choosing to follow a
-later version.
-
- 15. Disclaimer of Warranty.
-
- THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
-APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
-IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. Limitation of Liability.
-
- IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
-
- 17. Interpretation of Sections 15 and 16.
-
- If the disclaimer of warranty and limitation of liability provided
-above cannot be given local legal effect according to their terms,
-reviewing courts shall apply local law that most closely approximates
-an absolute waiver of all civil liability in connection with the
-Program, unless a warranty or assumption of liability accompanies a
-copy of the Program in return for a fee.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-state the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- 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/>.
-
-Also add information on how to contact you by electronic and paper mail.
-
- If the program does terminal interaction, make it output a short
-notice like this when it starts in an interactive mode:
-
- <program> Copyright (C) <year> <name of author>
- This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, your program's commands
-might be different; for a GUI interface, you would use an "about box".
-
- You should also get your employer (if you work as a programmer) or school,
-if any, to sign a "copyright disclaimer" for the program, if necessary.
-For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
-
- The GNU General Public License does not permit incorporating your program
-into proprietary programs. If your program is a subroutine library, you
-may consider it more useful to permit linking proprietary applications with
-the library. If this is what you want to do, use the GNU Lesser General
-Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/packages/enwc/Makefile b/packages/enwc/Makefile
deleted file mode 100644
index 69deb30..0000000
--- a/packages/enwc/Makefile
+++ /dev/null
@@ -1,59 +0,0 @@
-# This is part of ENWC
-#
-# Copyright (C) 2012-2017 Ian Dunn.
-#
-# 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/>.
-
-DOCDIR=doc/
-
-PREFIX=/usr/local
-INFODIR=$(PREFIX)/info
-SITELISP=$(PREFIX)/share/emacs/site-lisp/enwc
-
-EMACS=emacs --batch
-ALLSRC= enwc-backend.el enwc.el enwc-wicd.el enwc-nm.el
-ALLELC=$(patsubst %.el,%.elc,$(SOURCE))
-
-SOURCE=$(ALLSRC)
-TARGET=$(ALLELC)
-
-.PHONY: all install lisp clean
-.PRECIOUS: %.elc
-all: lisp
-
-lisp: $(TARGET)
-
-%.elc: %.el
- @$(EMACS) \
- -L "." \
- -f batch-byte-compile $<
-
-autoloads: enwc-autoloads.el
-
-enwc-autoloads.el: $(SOURCE)
- @$(EMACS) \
- --eval "(require 'package)" \
- --eval "(setq inhibit-message t)" \
- --eval "(package-generate-autoloads \"enwc\" \"$$(pwd)\")"
-
-clean:
- -rm -f *.elc
-
-install:
- install -m 644 $(ALLELC) $(SITELISP)
- install -m 644 $(ALLSRC) $(SITELISP)
-
-uninstall:
- -rm -f $(SITELISP)/*.elc
- -rm -f $(SITELISP)/*.el
diff --git a/packages/enwc/doc/enwc.texi b/packages/enwc/doc/enwc.texi
deleted file mode 100644
index dddb66d..0000000
--- a/packages/enwc/doc/enwc.texi
+++ /dev/null
@@ -1,78 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@c %**start of header
-@setfilename enwc.info
-@settitle ENWC Manual
-@c %**end of header
-
-@include version.texi
-@include fdl.texi
-
-@dircategory Emacs
-@direntry
-* ENWC: (enwc). The Emacs Network Client.
-@end direntry
-
-@copying
-This manual is for ENWC, the Emacs Network Client.
-
-Copyright (C) 2012,2013,2014 Ian Dunn
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.3 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
-Texts. A copy of the license is included in the section entitled
-``GNU Free Documentation License''.
-@end quotation
-@end copying
-
-@titlepage
-@title ENWC
-@subtitle Edition @value{EDITION}, for @code{enwc} version @value{VERSION}
-@subtitle @value{UPDATED}
-@author by Ian Dunn
-
-@page
-@vskip 0pt plus 1filll
-@insertcopying{}
-@end titlepage
-
-@contents
-
-@ifnottex
-@node Top
-@top ENWC
-
-@insertcopying
-
-This manual is for ENWC, the Emacs Network Client.
-
-This is edition @value{EDITION}, for @code{enwc} version @value{VERSION}
-@end ifnottex
-
-@menu
-* Introduction:: Overview of ENWC.
-* Setup:: Getting ready to use ENWC.
-* Configuration:: All of the configuration options.
-* Commands:: The commands that ENWC uses.
-@end menu
-
-@node Introduction
-@chapter Introduction
-
-ENWC is the Emacs Network Client. It uses several backends to allow the user
to control network connections through GNU Emacs, while still allowing control
to remain with the actual network manager. ENWC makes uses of the D-Bus
interfaces provided by these network managers.
-
-@node Setup
-@chapter Setup
-
-First, the path to ENWC must be added to the @var{load-path} variable. Then,
in the @file{.emacs} file, the following must be added:
-
-@lisp
-(require 'enwc-setup)
-(enwc-setup)
-@end lisp
-
-Now, simply press @kbd{M+x}, and type @kbd{ENWC}, and press @kbd{RET}. ENWC
will begin scanning for networks on the wireless interface, and display them in
its buffer.
-
-@bye
diff --git a/packages/enwc/doc/fdl.texi b/packages/enwc/doc/fdl.texi
deleted file mode 100644
index cb71f05..0000000
--- a/packages/enwc/doc/fdl.texi
+++ /dev/null
@@ -1,505 +0,0 @@
-@c The GNU Free Documentation License.
-@center Version 1.3, 3 November 2008
-
-@c This file is intended to be included within another document,
-@c hence no sectioning command or @node.
-
-@display
-Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation,
Inc.
-@uref{http://fsf.org/}
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-@end display
-
-@enumerate 0
-@item
-PREAMBLE
-
-The purpose of this License is to make a manual, textbook, or other
-functional and useful document @dfn{free} in the sense of freedom: to
-assure everyone the effective freedom to copy and redistribute it,
-with or without modifying it, either commercially or noncommercially.
-Secondarily, this License preserves for the author and publisher a way
-to get credit for their work, while not being considered responsible
-for modifications made by others.
-
-This License is a kind of ``copyleft'', which means that derivative
-works of the document must themselves be free in the same sense. It
-complements the GNU General Public License, which is a copyleft
-license designed for free software.
-
-We have designed this License in order to use it for manuals for free
-software, because free software needs free documentation: a free
-program should come with manuals providing the same freedoms that the
-software does. But this License is not limited to software manuals;
-it can be used for any textual work, regardless of subject matter or
-whether it is published as a printed book. We recommend this License
-principally for works whose purpose is instruction or reference.
-
-@item
-APPLICABILITY AND DEFINITIONS
-
-This License applies to any manual or other work, in any medium, that
-contains a notice placed by the copyright holder saying it can be
-distributed under the terms of this License. Such a notice grants a
-world-wide, royalty-free license, unlimited in duration, to use that
-work under the conditions stated herein. The ``Document'', below,
-refers to any such manual or work. Any member of the public is a
-licensee, and is addressed as ``you''. You accept the license if you
-copy, modify or distribute the work in a way requiring permission
-under copyright law.
-
-A ``Modified Version'' of the Document means any work containing the
-Document or a portion of it, either copied verbatim, or with
-modifications and/or translated into another language.
-
-A ``Secondary Section'' is a named appendix or a front-matter section
-of the Document that deals exclusively with the relationship of the
-publishers or authors of the Document to the Document's overall
-subject (or to related matters) and contains nothing that could fall
-directly within that overall subject. (Thus, if the Document is in
-part a textbook of mathematics, a Secondary Section may not explain
-any mathematics.) The relationship could be a matter of historical
-connection with the subject or with related matters, or of legal,
-commercial, philosophical, ethical or political position regarding
-them.
-
-The ``Invariant Sections'' are certain Secondary Sections whose titles
-are designated, as being those of Invariant Sections, in the notice
-that says that the Document is released under this License. If a
-section does not fit the above definition of Secondary then it is not
-allowed to be designated as Invariant. The Document may contain zero
-Invariant Sections. If the Document does not identify any Invariant
-Sections then there are none.
-
-The ``Cover Texts'' are certain short passages of text that are listed,
-as Front-Cover Texts or Back-Cover Texts, in the notice that says that
-the Document is released under this License. A Front-Cover Text may
-be at most 5 words, and a Back-Cover Text may be at most 25 words.
-
-A ``Transparent'' copy of the Document means a machine-readable copy,
-represented in a format whose specification is available to the
-general public, that is suitable for revising the document
-straightforwardly with generic text editors or (for images composed of
-pixels) generic paint programs or (for drawings) some widely available
-drawing editor, and that is suitable for input to text formatters or
-for automatic translation to a variety of formats suitable for input
-to text formatters. A copy made in an otherwise Transparent file
-format whose markup, or absence of markup, has been arranged to thwart
-or discourage subsequent modification by readers is not Transparent.
-An image format is not Transparent if used for any substantial amount
-of text. A copy that is not ``Transparent'' is called ``Opaque''.
-
-Examples of suitable formats for Transparent copies include plain
-ASCII without markup, Texinfo input format, La@TeX{} input
-format, SGML or XML using a publicly available
-DTD, and standard-conforming simple HTML,
-PostScript or PDF designed for human modification. Examples
-of transparent image formats include PNG, XCF and
-JPG. Opaque formats include proprietary formats that can be
-read and edited only by proprietary word processors, SGML or
-XML for which the DTD and/or processing tools are
-not generally available, and the machine-generated HTML,
-PostScript or PDF produced by some word processors for
-output purposes only.
-
-The ``Title Page'' means, for a printed book, the title page itself,
-plus such following pages as are needed to hold, legibly, the material
-this License requires to appear in the title page. For works in
-formats which do not have any title page as such, ``Title Page'' means
-the text near the most prominent appearance of the work's title,
-preceding the beginning of the body of the text.
-
-The ``publisher'' means any person or entity that distributes copies
-of the Document to the public.
-
-A section ``Entitled XYZ'' means a named subunit of the Document whose
-title either is precisely XYZ or contains XYZ in parentheses following
-text that translates XYZ in another language. (Here XYZ stands for a
-specific section name mentioned below, such as ``Acknowledgements'',
-``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title''
-of such a section when you modify the Document means that it remains a
-section ``Entitled XYZ'' according to this definition.
-
-The Document may include Warranty Disclaimers next to the notice which
-states that this License applies to the Document. These Warranty
-Disclaimers are considered to be included by reference in this
-License, but only as regards disclaiming warranties: any other
-implication that these Warranty Disclaimers may have is void and has
-no effect on the meaning of this License.
-
-@item
-VERBATIM COPYING
-
-You may copy and distribute the Document in any medium, either
-commercially or noncommercially, provided that this License, the
-copyright notices, and the license notice saying this License applies
-to the Document are reproduced in all copies, and that you add no other
-conditions whatsoever to those of this License. You may not use
-technical measures to obstruct or control the reading or further
-copying of the copies you make or distribute. However, you may accept
-compensation in exchange for copies. If you distribute a large enough
-number of copies you must also follow the conditions in section 3.
-
-You may also lend copies, under the same conditions stated above, and
-you may publicly display copies.
-
-@item
-COPYING IN QUANTITY
-
-If you publish printed copies (or copies in media that commonly have
-printed covers) of the Document, numbering more than 100, and the
-Document's license notice requires Cover Texts, you must enclose the
-copies in covers that carry, clearly and legibly, all these Cover
-Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
-the back cover. Both covers must also clearly and legibly identify
-you as the publisher of these copies. The front cover must present
-the full title with all words of the title equally prominent and
-visible. You may add other material on the covers in addition.
-Copying with changes limited to the covers, as long as they preserve
-the title of the Document and satisfy these conditions, can be treated
-as verbatim copying in other respects.
-
-If the required texts for either cover are too voluminous to fit
-legibly, you should put the first ones listed (as many as fit
-reasonably) on the actual cover, and continue the rest onto adjacent
-pages.
-
-If you publish or distribute Opaque copies of the Document numbering
-more than 100, you must either include a machine-readable Transparent
-copy along with each Opaque copy, or state in or with each Opaque copy
-a computer-network location from which the general network-using
-public has access to download using public-standard network protocols
-a complete Transparent copy of the Document, free of added material.
-If you use the latter option, you must take reasonably prudent steps,
-when you begin distribution of Opaque copies in quantity, to ensure
-that this Transparent copy will remain thus accessible at the stated
-location until at least one year after the last time you distribute an
-Opaque copy (directly or through your agents or retailers) of that
-edition to the public.
-
-It is requested, but not required, that you contact the authors of the
-Document well before redistributing any large number of copies, to give
-them a chance to provide you with an updated version of the Document.
-
-@item
-MODIFICATIONS
-
-You may copy and distribute a Modified Version of the Document under
-the conditions of sections 2 and 3 above, provided that you release
-the Modified Version under precisely this License, with the Modified
-Version filling the role of the Document, thus licensing distribution
-and modification of the Modified Version to whoever possesses a copy
-of it. In addition, you must do these things in the Modified Version:
-
-@enumerate A
-@item
-Use in the Title Page (and on the covers, if any) a title distinct
-from that of the Document, and from those of previous versions
-(which should, if there were any, be listed in the History section
-of the Document). You may use the same title as a previous version
-if the original publisher of that version gives permission.
-
-@item
-List on the Title Page, as authors, one or more persons or entities
-responsible for authorship of the modifications in the Modified
-Version, together with at least five of the principal authors of the
-Document (all of its principal authors, if it has fewer than five),
-unless they release you from this requirement.
-
-@item
-State on the Title page the name of the publisher of the
-Modified Version, as the publisher.
-
-@item
-Preserve all the copyright notices of the Document.
-
-@item
-Add an appropriate copyright notice for your modifications
-adjacent to the other copyright notices.
-
-@item
-Include, immediately after the copyright notices, a license notice
-giving the public permission to use the Modified Version under the
-terms of this License, in the form shown in the Addendum below.
-
-@item
-Preserve in that license notice the full lists of Invariant Sections
-and required Cover Texts given in the Document's license notice.
-
-@item
-Include an unaltered copy of this License.
-
-@item
-Preserve the section Entitled ``History'', Preserve its Title, and add
-to it an item stating at least the title, year, new authors, and
-publisher of the Modified Version as given on the Title Page. If
-there is no section Entitled ``History'' in the Document, create one
-stating the title, year, authors, and publisher of the Document as
-given on its Title Page, then add an item describing the Modified
-Version as stated in the previous sentence.
-
-@item
-Preserve the network location, if any, given in the Document for
-public access to a Transparent copy of the Document, and likewise
-the network locations given in the Document for previous versions
-it was based on. These may be placed in the ``History'' section.
-You may omit a network location for a work that was published at
-least four years before the Document itself, or if the original
-publisher of the version it refers to gives permission.
-
-@item
-For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve
-the Title of the section, and preserve in the section all the
-substance and tone of each of the contributor acknowledgements and/or
-dedications given therein.
-
-@item
-Preserve all the Invariant Sections of the Document,
-unaltered in their text and in their titles. Section numbers
-or the equivalent are not considered part of the section titles.
-
-@item
-Delete any section Entitled ``Endorsements''. Such a section
-may not be included in the Modified Version.
-
-@item
-Do not retitle any existing section to be Entitled ``Endorsements'' or
-to conflict in title with any Invariant Section.
-
-@item
-Preserve any Warranty Disclaimers.
-@end enumerate
-
-If the Modified Version includes new front-matter sections or
-appendices that qualify as Secondary Sections and contain no material
-copied from the Document, you may at your option designate some or all
-of these sections as invariant. To do this, add their titles to the
-list of Invariant Sections in the Modified Version's license notice.
-These titles must be distinct from any other section titles.
-
-You may add a section Entitled ``Endorsements'', provided it contains
-nothing but endorsements of your Modified Version by various
-parties---for example, statements of peer review or that the text has
-been approved by an organization as the authoritative definition of a
-standard.
-
-You may add a passage of up to five words as a Front-Cover Text, and a
-passage of up to 25 words as a Back-Cover Text, to the end of the list
-of Cover Texts in the Modified Version. Only one passage of
-Front-Cover Text and one of Back-Cover Text may be added by (or
-through arrangements made by) any one entity. If the Document already
-includes a cover text for the same cover, previously added by you or
-by arrangement made by the same entity you are acting on behalf of,
-you may not add another; but you may replace the old one, on explicit
-permission from the previous publisher that added the old one.
-
-The author(s) and publisher(s) of the Document do not by this License
-give permission to use their names for publicity for or to assert or
-imply endorsement of any Modified Version.
-
-@item
-COMBINING DOCUMENTS
-
-You may combine the Document with other documents released under this
-License, under the terms defined in section 4 above for modified
-versions, provided that you include in the combination all of the
-Invariant Sections of all of the original documents, unmodified, and
-list them all as Invariant Sections of your combined work in its
-license notice, and that you preserve all their Warranty Disclaimers.
-
-The combined work need only contain one copy of this License, and
-multiple identical Invariant Sections may be replaced with a single
-copy. If there are multiple Invariant Sections with the same name but
-different contents, make the title of each such section unique by
-adding at the end of it, in parentheses, the name of the original
-author or publisher of that section if known, or else a unique number.
-Make the same adjustment to the section titles in the list of
-Invariant Sections in the license notice of the combined work.
-
-In the combination, you must combine any sections Entitled ``History''
-in the various original documents, forming one section Entitled
-``History''; likewise combine any sections Entitled ``Acknowledgements'',
-and any sections Entitled ``Dedications''. You must delete all
-sections Entitled ``Endorsements.''
-
-@item
-COLLECTIONS OF DOCUMENTS
-
-You may make a collection consisting of the Document and other documents
-released under this License, and replace the individual copies of this
-License in the various documents with a single copy that is included in
-the collection, provided that you follow the rules of this License for
-verbatim copying of each of the documents in all other respects.
-
-You may extract a single document from such a collection, and distribute
-it individually under this License, provided you insert a copy of this
-License into the extracted document, and follow this License in all
-other respects regarding verbatim copying of that document.
-
-@item
-AGGREGATION WITH INDEPENDENT WORKS
-
-A compilation of the Document or its derivatives with other separate
-and independent documents or works, in or on a volume of a storage or
-distribution medium, is called an ``aggregate'' if the copyright
-resulting from the compilation is not used to limit the legal rights
-of the compilation's users beyond what the individual works permit.
-When the Document is included in an aggregate, this License does not
-apply to the other works in the aggregate which are not themselves
-derivative works of the Document.
-
-If the Cover Text requirement of section 3 is applicable to these
-copies of the Document, then if the Document is less than one half of
-the entire aggregate, the Document's Cover Texts may be placed on
-covers that bracket the Document within the aggregate, or the
-electronic equivalent of covers if the Document is in electronic form.
-Otherwise they must appear on printed covers that bracket the whole
-aggregate.
-
-@item
-TRANSLATION
-
-Translation is considered a kind of modification, so you may
-distribute translations of the Document under the terms of section 4.
-Replacing Invariant Sections with translations requires special
-permission from their copyright holders, but you may include
-translations of some or all Invariant Sections in addition to the
-original versions of these Invariant Sections. You may include a
-translation of this License, and all the license notices in the
-Document, and any Warranty Disclaimers, provided that you also include
-the original English version of this License and the original versions
-of those notices and disclaimers. In case of a disagreement between
-the translation and the original version of this License or a notice
-or disclaimer, the original version will prevail.
-
-If a section in the Document is Entitled ``Acknowledgements'',
-``Dedications'', or ``History'', the requirement (section 4) to Preserve
-its Title (section 1) will typically require changing the actual
-title.
-
-@item
-TERMINATION
-
-You may not copy, modify, sublicense, or distribute the Document
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense, or distribute it is void, and
-will automatically terminate your rights under this License.
-
-However, if you cease all violation of this License, then your license
-from a particular copyright holder is reinstated (a) provisionally,
-unless and until the copyright holder explicitly and finally
-terminates your license, and (b) permanently, if the copyright holder
-fails to notify you of the violation by some reasonable means prior to
-60 days after the cessation.
-
-Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
-Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License. If your rights have been terminated and not permanently
-reinstated, receipt of a copy of some or all of the same material does
-not give you any rights to use it.
-
-@item
-FUTURE REVISIONS OF THIS LICENSE
-
-The Free Software Foundation may publish new, revised versions
-of the GNU Free Documentation License from time to time. Such new
-versions will be similar in spirit to the present version, but may
-differ in detail to address new problems or concerns. See
-@uref{http://www.gnu.org/copyleft/}.
-
-Each version of the License is given a distinguishing version number.
-If the Document specifies that a particular numbered version of this
-License ``or any later version'' applies to it, you have the option of
-following the terms and conditions either of that specified version or
-of any later version that has been published (not as a draft) by the
-Free Software Foundation. If the Document does not specify a version
-number of this License, you may choose any version ever published (not
-as a draft) by the Free Software Foundation. If the Document
-specifies that a proxy can decide which future versions of this
-License can be used, that proxy's public statement of acceptance of a
-version permanently authorizes you to choose that version for the
-Document.
-
-@item
-RELICENSING
-
-``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any
-World Wide Web server that publishes copyrightable works and also
-provides prominent facilities for anybody to edit those works. A
-public wiki that anybody can edit is an example of such a server. A
-``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the
-site means any set of copyrightable works thus published on the MMC
-site.
-
-``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0
-license published by Creative Commons Corporation, a not-for-profit
-corporation with a principal place of business in San Francisco,
-California, as well as future copyleft versions of that license
-published by that same organization.
-
-``Incorporate'' means to publish or republish a Document, in whole or
-in part, as part of another Document.
-
-An MMC is ``eligible for relicensing'' if it is licensed under this
-License, and if all works that were first published under this License
-somewhere other than this MMC, and subsequently incorporated in whole
-or in part into the MMC, (1) had no cover texts or invariant sections,
-and (2) were thus incorporated prior to November 1, 2008.
-
-The operator of an MMC Site may republish an MMC contained in the site
-under CC-BY-SA on the same site at any time before August 1, 2009,
-provided the MMC is eligible for relicensing.
-
-@end enumerate
-
-@page
-@heading ADDENDUM: How to use this License for your documents
-
-To use this License in a document you have written, include a copy of
-the License in the document and put the following copyright and
-license notices just after the title page:
-
-@smallexample
-@group
- Copyright (C) @var{year} @var{your name}.
- Permission is granted to copy, distribute and/or modify this document
- under the terms of the GNU Free Documentation License, Version 1.3
- or any later version published by the Free Software Foundation;
- with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
- Texts. A copy of the license is included in the section entitled ``GNU
- Free Documentation License''.
-@end group
-@end smallexample
-
-If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
-replace the ``with@dots{}Texts.''@: line with this:
-
-@smallexample
-@group
- with the Invariant Sections being @var{list their titles}, with
- the Front-Cover Texts being @var{list}, and with the Back-Cover Texts
- being @var{list}.
-@end group
-@end smallexample
-
-If you have Invariant Sections without Cover Texts, or some other
-combination of the three, merge those two alternatives to suit the
-situation.
-
-If your document contains nontrivial examples of program code, we
-recommend releasing these examples in parallel under your choice of
-free software license, such as the GNU General Public License,
-to permit their use in free software.
-
-@c Local Variables:
-@c ispell-local-pdict: "ispell-dict"
-@c End:
diff --git a/packages/enwc/doc/version.texi b/packages/enwc/doc/version.texi
deleted file mode 100644
index f910a9b..0000000
--- a/packages/enwc/doc/version.texi
+++ /dev/null
@@ -1,4 +0,0 @@
-@set UPDATED 15 December 2012
-@set UPDATED-MONTH December 2012
-@set EDITION 1.0
-@set VERSION 1.0
diff --git a/packages/enwc/enwc-backend.el b/packages/enwc/enwc-backend.el
deleted file mode 100644
index a8b8f92..0000000
--- a/packages/enwc/enwc-backend.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; enwc-backend.el --- Back-end functions for ENWC.
-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
-
-;; Author: Ian Dunn <dunni@gnu.org>
-;; Keywords: external, network, wicd, manager, nm
-;; Version: 2.0
-;; Homepage: https://savannah.nongnu.org/p/enwc
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
-;; 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'map)
-
-(cl-defstruct enwc-backend
- key ;; The symbol that identifies this backend.
- ;; Loading/unloading functions
- can-load-p
- load
- unload
- ;; Scan interface
- network-ids
- scan
- nw-props
- ;; Connect/disconnect
- connect
- disconnect
- ;; Maintenance
- current-nw-id
- is-connecting-p
- is-wired-p
- ;; get-profile-info
- ;; save-nw-settings
- )
-
-(defvar enwc-registered-backend-alist nil
- "Alist of registered ENWC backends.
-
-Each entry in this list is of the form
-
- (KEY . DEFINITION)
-
-Where KEY is a symbol identifying the backend, and DEFINITION is
-an enwc-backend struct.")
-
-(defcustom enwc-default-backend nil
- "Key of the default backend to use."
- :type 'symbol
- :group 'enwc)
-
-(defcustom enwc-force-backend-loading nil
- "Non-nil if backends should be loaded during `enwc-setup' even if they claim
they cannot."
- :type 'boolean
- :group 'enwc)
-
-(defvar enwc--current-backend nil)
-
-;;;###autoload
-(defun enwc-register-backend (definition &optional forcep)
- "Register the backend KEY with DEFINITION.
-
-Signals an error if a backend with KEY already exists and FORCEP is nil."
- (cl-check-type definition enwc-backend)
- (let ((key (enwc-backend-key definition)))
- (when (and (map-contains-key enwc-registered-backend-alist key) (not
forcep))
- (error "An ENWC backend with key '%s' has already been registered." key))
- (map-put enwc-registered-backend-alist key definition)))
-
-;; Convenience functions to work with backends
-
-(defun enwc--can-load-p (backend)
- (funcall (enwc-backend-can-load-p backend)))
-
-(defun enwc--load (backend)
- (funcall (enwc-backend-load backend)))
-
-(defun enwc--unload (backend)
- (funcall (enwc-backend-unload backend)))
-
-(defun enwc--scan (backend)
- (funcall (enwc-backend-scan backend)))
-
-(defun enwc--network-ids (backend &optional wired-p)
- (funcall (enwc-backend-network-ids backend) wired-p))
-
-(defun enwc--nw-props (backend id &optional wired-p)
- (funcall (enwc-backend-nw-props backend) id wired-p))
-
-(defun enwc--connect (backend id &optional wired-p)
- (funcall (enwc-backend-connect backend) id wired-p))
-
-(defun enwc--disconnect (backend &optional wired-p)
- (funcall (enwc-backend-disconnect backend) wired-p))
-
-(defun enwc--current-nw-id (backend &optional wired-p)
- (funcall (enwc-backend-current-nw-id backend) wired-p))
-
-(defun enwc--is-connecting-p (backend)
- (funcall (enwc-backend-is-connecting-p backend)))
-
-(defun enwc--is-wired-p (backend)
- (funcall (enwc-backend-is-wired-p backend)))
-
-;; Handle loading/unloading
-
-(defun enwc-load-backend (backend &optional force)
- "Load BACKEND, which is a symbol denoting the backend to use."
- (interactive
- (list
- (intern (completing-read "Backend: " enwc-registered-backend-alist nil t))
- current-prefix-arg))
- (when (and enwc--current-backend
- (not (eq (enwc-backend-key enwc--current-backend) backend)))
- (enwc-unload-current-backend))
-
- (unless (require (intern (format "enwc-%s" backend)) nil t)
- (error "Cannot find enwc feature for backend %s" backend))
-
- (let ((new-backend (map-elt enwc-registered-backend-alist backend)))
- (unless new-backend
- (error "No registered backend %s" backend))
-
- (if (not (or force (enwc--can-load-p new-backend)))
- (warn "Backend %s is not usable." backend)
- (enwc--load new-backend)
- (setq enwc--current-backend new-backend))))
-
-(defun enwc-load-default-backend (&optional force)
- (enwc-load-backend enwc-default-backend force))
-
-(defun enwc-unload-current-backend ()
- "Unload the current backend."
- (when enwc--current-backend
- (enwc--unload enwc--current-backend)
- (setq enwc--current-backend nil)))
-
-(provide 'enwc-backend)
-
-;;; enwc-backend.el ends here
diff --git a/packages/enwc/enwc-cm.el b/packages/enwc/enwc-cm.el
deleted file mode 100644
index 0dc64a7..0000000
--- a/packages/enwc/enwc-cm.el
+++ /dev/null
@@ -1,372 +0,0 @@
-;; enwc-cm.el --- The ConnMan back-end to ENWC.
-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
-
-;; Author: Ian Dunn <dunni@gnu.org>
-;; Keywords: external, network, wicd, manager, nm
-;; Version: 2.0
-;; Homepage: https://savannah.nongnu.org/p/enwc
-
-;; This file is part of GNU Emacs
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
-;; 02110-1301, USA.
-
-;;; Commentary:
-
-;; ConnMan support is still experimental.
-
-;;; Code:
-
-(require 'enwc)
-
-(defgroup enwc-cm nil
- "*ConnMan variables for ENWC"
- :prefix "enwc-cm-"
- :group 'enwc)
-
-(defcustom enwc-cm-dbus-service "net.connman"
- "ConnMan D-Bus service."
- :group 'enwc-cm
- :type 'string)
-
-(defcustom enwc-cm-dbus-manager-interface "net.connman.Manager"
- "ConnMan D-Bus Manager interface."
- :group 'enwc-cm
- :type 'string)
-
-(defcustom enwc-cm-dbus-service-interface "net.connman.Service"
- "ConnMan D-Bus Service interface."
- :group 'enwc-cm
- :type 'string)
-
-(defcustom enwc-cm-dbus-technology-interface "net.connman.Technology"
- "ConnMan D-Bus Technology Interface"
- :group 'enwc-cm
- :type 'string)
-
-(defcustom enwc-cm-dbus-technology-path "/net/connman/technology/"
- "ConnMan D-Bus Technology Path"
- :group 'enwc-cm
- :type 'string)
-
-(defcustom enwc-cm-dbus-service-path "/net/connman/service"
- "ConnMan D-Bus Service Path"
- :group 'enwc-cm
- :type 'string)
-
-(defcustom enwc-cm-dbus-agent-service "org.gnu.enwc.agent"
- "The service for the ConnMan Agent for ENWC to use."
- :group 'enwc-cm
- :type 'string)
-
-(defcustom enwc-cm-dbus-agent-path "/org/gnu/enwc/agent"
- "The path to the Agent for ENWC to use for ConnMan security."
- :group 'enwc-cm
- :type 'string)
-
-(defcustom enwc-cm-dbus-agent-interface "org.gnu.enwc.agent"
- "The interface for the ConnMan Agent for ENWC to use."
- :group 'enwc-cm
- :type 'string)
-
-(defvar enwc-cm-details-list
- '("Name" "Ethernet/Address" "Strength" "Security" "mode" "channel"))
-
-(defun enwc-cm-get-wifi-tech-path ()
- "Return the ConnMan Wifi Technology path."
- (concat enwc-cm-dbus-technology-path "wifi"))
-
-(defun enwc-cm-get-wired-tech-path ()
- "Return the ConnMan Ethernet Technology path."
- (concat enwc-cm-dbus-technology-path "ethernet"))
-
-(defun enwc-cm-get-network (id)
- (nth id (enwc-cm-get-services)))
-
-;; connect
-(defun enwc-cm-connect (wired id)
- (let ((path (concat enwc-cm-dbus-service-path (number-to-string id))))
- (dbus-call-method :system
- enwc-cm-dbus-service
- path
- enwc-cm-dbus-service-interface
- "Connect")))
-
-;; disconnect
-(defun enwc-cm-disconnect (wired)
- (dbus-call-method :system
- enwc-cm-dbus-service
- "/net/connman/service/CONNECTED-SERVICE"
- enwc-cm-dbus-service-interface
- "Disconnect"))
-
-;; scan
-(defun enwc-cm-scan (wired)
- (let ((path (if wired
- (enwc-cm-get-wired-tech-path)
- (enwc-cm-get-wifi-tech-path))))
- (dbus-call-method-asynchronously :system
- path
- enwc-cm-dbus-technology-interface
- "Scan"
- 'enwc-process-scan
- :timeout 6000)))
-
-;; (defun enwc-cm-scan (wired)
-;; (dbus-call-method :system
-;; enwc-cm-dbus-service
-;; "/net/connman/technology/(ethernet|wifi)"
-;; "net.connman.Technology"
-;; "Scan"))
-
-;; get-network-props
-;; Might combine this with enwc-nm-get-dbus-dict-entry
-(defun enwc-cm-dict-assoc (dict prop)
- (let ((path-list (split-string prop "/"))
- (cur-list dict))
- (while (and path-list cur-list)
- (let ((cur-path (pop path-list)))
- (setq cur-list
- (when (assoc cur-path cur-list)
- (caadr (assoc cur-path cur-list))))))
- (if (and cur-list (consp cur-list)) (car cur-list) cur-list)))
-
-(defun enwc-cm-get-nw-prop (id prop)
- (let ((network (enwc-cm-get-network id)))
- (car (cadr (assoc prop (cadr network))))))
-
-(defun enwc-cm-get-network-props (id wired)
- (let ((network (enwc-cm-get-network id))
- props)
- ;; network should be a pair, (path . props)
- (unless network
- (error "Invalid Network Id %d" id))
- (setq props (cadr network))
- (mapcar
- (lambda (det)
- (enwc-cm-dict-assoc props det))
- enwc-cm-details-list)))
-
-(defun enwc-cm-get-wireless-network-property (id prop)
- (enwc-cm-get-nw-prop id prop))
-
-;; get-profile-props
-(defun enwc-cm-get-profile-props (prof wired)
- (let ((network (enwc-cm-get-network prof))
- props
- ipv4-settings
- dns-settings)
- (unless network
- (error "Invalid Network Id %d" id))
- (setq props (cadr network))
- (setq ipv4-settings (enwc-cm-dict-assoc "IPv4/Configuration" props)
- dns-settings (enwc-cm-dict-assoc "Domains/Configuration" props))
- `((addr . ,(cadr (assoc "Address" ipv4-settings)))
- (netmask . ,(cadr (assoc "Netmask" ipv4-settings)))
- (gateway . ,(cadr (assoc "Gateway" ipv4-settings)))
- (dns1 . ,(nth 0 dns-settings))
- (dns2 . ,(nth 1 dns-settings)))))
-
-;; get-current-nw-id
-(defun enwc-cm-is-disconnected-p (service)
- (member (enwc-cm-dict-assoc (cadr service) "State")
- '("idle" "disconnect")))
-
-(defun enwc-cm-is-connecting-p (service)
- (member (enwc-cm-dict-assoc (cadr service) "State")
- '("association" "configuration")))
-
-(defun enwc-cm-is-connected-p (service)
- (member (enwc-cm-dict-assoc (cadr service) "State")
- '("ready" "online")))
-
-(defun enwc-cm--find-connected-service (services num)
- (if services
- (if (enwc-cm-is-connected-p (car services))
- num
- (enwc-cm--find-connected-service (cdr services) (1+ num)))
- -1))
-
-(defun enwc-cm-get-current-nw-id ()
- "Get the current network id."
- (let* ((services (enwc-cm-get-services)))
- (enwc-cm--find-connected-service services 0)))
-
-;; save-profile
-(defun enwc-cm-set-nw-prop (nw prop val &optional wired)
- (dbus-call-method :system
- enwc-cm-dbus-service
- (car nw)
- enwc-cm-dbus-service-interface
- "SetProperty"
- :string prop
- val))
-
-(defun enwc-cm-save-profile (prof settings wired)
- (let ((network (enwc-cm-get-network prof))
- props
- ipv4-settings
- dns-settings)
- (unless network
- (error "Invalid Network Id %d" id))
- (setq props (cadr network))
- (setq ipv4-settings
- `((("Method" ("manual"))
- ("Address" (,(alist-get 'addr settings "")))
- ("Netmask" (,(alist-get 'netmask settings "")))
- ("Gateway" (,(alist-get 'gateway settings ""))))))
- (setq dns-settings
- `((,(alist-get 'dns1 settings ""))
- (,(alist-get 'dns2 settings ""))))
- (enwc-cm-set-nw-prop prof "IPv4.Configuration" ipv4-settings wired)
- (enwc-cm-set-nw-prop prof "Domains.Configuration" dns-settings wired)))
-
-;; check-connecting-p
-(defun enwc-cm--find-connecting-service (services)
- (when services
- (or (enwc-cm-is-connecting-p (car services))
- (enwc-cm--find-connecting-service (cdr services)))))
-
-(defun enwc-cm-check-connecting-p ()
- (let ((services (enwc-cm-get-services)))
- (enwc-cm--find-connecting-service services)))
-
-;; get-networks
-(defun enwc-cm-get-services ()
- (dbus-call-method :system
- enwc-cm-dbus-service
- "/"
- enwc-cm-dbus-manager-interface
- "GetServices"))
-
-(defun enwc-cm-get-networks ()
- (let ((services (enwc-cm-get-services)))
- (mapcar 'car services)))
-
-;; Agent
-;; ConnMan requires that an agent is registered, so we create one here.
-
-(defun enwc-cm-agent-release (&rest args)
- )
-
-(defun enwc-cm-agent-report-error (service err)
- )
-
-(defun enwc-cm-agent-report-peer-error (peer err))
-
-(defun enwc-cm-agent-request-browser (service url)
- (browse-url url))
-
-(defun enwc-cm-agent-request-input (service fields)
- "Called when a user requests input.
-SERVICE is the current service.
-FIELDS is an associative list of requested fields."
- ;; Obtain the information from somewhere.
- )
-
-(defun enwc-cm-agent-request-peer-authorization (peer fields))
-
-(defun enwc-cm-agent-cancel ())
-
-(defun enwc-cm-method-to-defun (method)
- (let ((case-fold-search nil))
- (combine-and-quote-strings
- (mapcar 'downcase
- (cdr (split-string
- (replace-regexp-in-string "\\([[:upper:]]\\)" " \\1" method)
- " ")))
- "-")))
-
-(defmacro enwc-cm-agent-register-method (method)
- "Register a method METHOD with D-Bus.
-METHOD is assumed to be the camel-case D-Bus method."
- `((dbus-register-method :session
- enwc-cm-dbus-agent-service
- enwc-cm-dbus-agent-path
- enwc-cm-dbus-agent-interface
- ,method
- (quote ,(car (read-from-string
- (concat
- "enwc-cm-agent-"
- (enwc-cm-method-to-defun
method))))))))
-
-;; Run during setup.
-(defun enwc-cm-setup ()
-
- ;; Setup the agent.
- (dbus-register-service :session enwc-cm-dbus-agent-service)
-
- (enwc-cm-agent-register-method "Release")
- (enwc-cm-agent-register-method "ReportError")
- (enwc-cm-agent-register-method "ReportPeerError")
- (enwc-cm-agent-register-method "RequestBrowser")
- (enwc-cm-agent-register-method "RequestInput")
- (enwc-cm-agent-register-method "RequestPeerAuthorization")
- (enwc-cm-agent-register-method "Cancel")
-
- (dbus-call-method :system
- enwc-cm-dbus-manager-service
- enwc-cm-dbus-manager-path
- enwc-cm-dbus-manager-interface
- "RegisterAgent"
- :string enwc-cm-dbus-agent-path))
-
-
-;; (defun enwc-cm-get-encryption-type (id)
-;; (enwc-cm-get-nw-prop id "Security"))
-
-;; (defun enwc-cm-get-ip-addr (wired id)
-;; (let ((ipv4-config (enwc-cm-get-nw-prop id "IPv4.Configuration")))
-;; (car (cadr (assoc "Address" ipv4-config)))))
-
-;; (defun enwc-cm-get-netmask (wired id)
-;; (let ((ipv4-config (enwc-cm-get-nw-prop id "IPv4.Configuration")))
-;; (car (cadr (assoc "Netmask" ipv4-config)))))
-
-;; (defun enwc-cm-get-gateway (wired id)
-;; (let ((ipv4-config (enwc-cm-get-nw-prop id "IPv4.Configuration")))
-;; (car (cadr (assoc "Gateway" ipv4-config)))))
-
-;; (defun enwc-cm-get-dns (wired id)
-;; (enwc-cm-get-nw-prop id "Nameservers.Configuration"))
-
-;; (defun enwc-cm-save-nw-settings (wired id settings)
-;; (let* ((ipv4 (enwc-cm-get-nw-prop id "IPv4.Configuration"))
-;; (method (car (cadr (assoc "Method" ipv4))))
-;; (ip-addr (cdr (assoc "addr" settings)))
-;; (netmask (cdr (assoc "netmask" settings)))
-;; (gateway (cdr (assoc "gateway" settings)))
-;; new-ipv4-config new-dns-config)
-;; (setq new-ipv4-config
-;; (list (list (cons "Method" (cons (cons method nil) nil))
-;; (cons "Address" (cons (cons ip-addr nil) nil))
-;; (cons "Netmask" (cons (cons netmask nil) nil))
-;; (cons "Gateway" (cons (cons gateway nil) nil)))))
-;; (setq new-dns-config
-;; (list (list (cdr (assoc "dns1" settings))
-;; (cdr (assoc "dns2" settings)))))
-;; (enwc-cm-set-nw-prop wired id "IPv4.Configuration"
-;; new-ipv4-config)
-;; (enwc-cm-set-nw-prop wired id "Nameservers.Configuration"
-;; new-dns-config)))
-
-(provide 'enwc-cm)
-
-;; Local Variables:
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; enwc-cm.el ends here
diff --git a/packages/enwc/enwc-edit.el b/packages/enwc/enwc-edit.el
deleted file mode 100644
index 7aee28b..0000000
--- a/packages/enwc/enwc-edit.el
+++ /dev/null
@@ -1,434 +0,0 @@
-;;; enwc-edit.el --- Support for editing wireless network profiles
-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
-
-;; Author: Ian Dunn <dunni@gnu.org>
-;; Keywords: external, network, wicd, manager, nm
-;; Version: 2.0
-;; Homepage: https://savannah.nongnu.org/p/enwc
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
-;; 02110-1301, USA.
-
-;;; Commentary:
-
-;; THIS IS EXPERIMENTAL
-
-;;; Code:
-
-(require 'wid-edit)
-
-(eval-when-compile
- (defun enwc--break-by-words (str)
- "Break up string STR into a list of words."
- (cl-check-type str string)
- (split-string str "-\\|_\\| "))
-
- (defun enwc--sym-to-str (sym &optional seps)
- "Create a string from symbol SYM.
-SEPS is a string specifying the separator to use to combine the words,
-or \" \" if not specified."
- (cl-check-type sym symbol)
- (unless seps
- (setq seps " "))
- (cl-check-type seps string)
- (combine-and-quote-strings (enwc--break-by-words (symbol-name sym)) seps))
-
- (defun enwc--str-to-sym (str &optional seps)
- "Create a symbol from the string STR.
-This will break STR into words, and then put it back together separating
-each word by SEPS, which defaults to \"-\"."
- (cl-check-type str string)
- (unless seps
- (setq seps "-"))
- (cl-check-type seps string)
- (intern (combine-and-quote-strings (enwc--break-by-words str) seps))))
-
-(defun enwc--int-to-byte-list (n)
- "Convert 32-bit integer N into a byte list."
- (cl-check-type n integer)
- (let (ret)
- (dotimes (x 4 ret)
- (push (logand n 255) ret)
- (setq n (lsh n -8)))))
-
-(defun enwc--byte-list-to-int (bl)
- "Convert byte list BL into a 32-bit integer."
- (cl-check-type bl list)
- (let ((ret 0))
- (dolist (x bl ret)
- (setq ret (logior (lsh ret 8) x)))))
-
-(defun enwc--htonl (n)
- "Convert 32-bit integer N from hardware to network byte order."
- (cl-check-type n integer)
- (enwc--byte-list-to-int (nreverse (enwc--int-to-byte-list n))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;
-;; Profile Properties ;;
-;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Settings for access point AP
-;;
-;; IPv4 Settings:
-;; Address =
-;; Netmask =
-;; Gateway =
-;;
-;; DNS 1 =
-;; DNS 2 =
-;;
-;; Security:
-;; Type =
-;;
-
-(defun enwc-edit-view-entry ()
- "View the text of the entry at point.
-This is mostly useful to view the text of the hidden entries."
- (interactive)
- (unless (get-buffer "*ENWC Edit*")
- (error "Not editing a network entry."))
- (unless (eq (current-buffer) (get-buffer "*ENWC Edit*"))
- (switch-to-buffer "*ENWC Edit*"))
- (unless (widget-at)
- (error "No widget at point"))
- (message (widget-field-value-get (widget-at))))
-
-(define-widget 'enwc-profile-props-widget 'group
- "ENWC edit widget."
- :convert-widget 'identity
- :format "IPv4 Settings:\n %v"
- :value-to-internal 'enwc-profile-props-to-widget
- :value-to-external 'enwc-widget-to-profile-props
- :match #'(lambda nil t)
- :indent 1
- :args '((string :tag "Address")
- (string :tag "Netmask")
- (string :tag "Gateway")
- (string :tag "DNS1")
- (string :tag "DNS2")))
-
-(defun enwc-profile-props-to-widget (widget props)
- "Create a profile props widget."
- (list
- (alist-get 'addr props "")
- (alist-get 'netmask props "")
- (alist-get 'gateway props "")
- (alist-get 'dns1 props "")
- (alist-get 'dns2 props "")))
-
-(defun enwc-widget-to-profile-props (widget vals)
- "Convert widget values to a profile properties alist.
-WIDGET is unused.
-VALS is the list of widget values."
- (let ((addr (nth 0 vals))
- (netmask (nth 1 vals))
- (gateway (nth 2 vals))
- (dns1 (nth 3 vals))
- (dns2 (nth 4 vals)))
- `((addr . ,addr)
- (netmask . ,netmask)
- (gateway . ,gateway)
- (dns1 . ,dns1)
- (dns2 . ,dns2))))
-
-;;;;;;;;;;;;;;
-;; Security ;;
-;;;;;;;;;;;;;;
-
-(eval-when-compile
- (defmacro enwc--make-supplicant-multi (key &rest args)
- `(cons (quote ,key)
- (quote (checklist :tag ,(capitalize (enwc--sym-to-str key))
- :format "%{%t%}: %v"
- :sample-face bold
- :indent ,(+ 4 (length (enwc--sym-to-str key)))
- :args ,(mapcar
- (lambda (arg)
- `(item :tag ,(upcase arg) :value
,(downcase arg)))
- args)))))
-
- (defmacro enwc--make-supplicant-choice (key &rest args)
- `(cons (quote ,key)
- (quote (menu-choice :tag ,(capitalize (enwc--sym-to-str key))
- :format "%[%t%]: %v"
- :sample-face bold
- :args
- ,(mapcar
- (lambda (arg)
- `(item :tag ,(upcase arg) :value (downcase
,arg)))
- args)))))
-
- (defmacro enwc--make-supplicant-secret (key)
- `(cons (quote ,key)
- (quote (editable-field :tag ,(capitalize (enwc--sym-to-str key))
- :format "%{%t%}: %v"
- :sample-face bold
- :keymap enwc-edit-field-map
- :secret ?*))))
-
- (defmacro enwc--make-supplicant-entry (key)
- `(cons (quote ,key)
- (quote (editable-field :tag ,(capitalize (enwc--sym-to-str key))
- :sample-face bold
- :format "%{%t%}: %v"))))
-
- (defmacro enwc--make-supplicant-file (key)
- `(cons (quote ,key)
- (quote (file :tag ,(capitalize (enwc--sym-to-str key))
- :format "%{%t%}: %v"
- :sample-face bold
- :must-match t))))
-
- (defmacro enwc--make-supplicant-list (key &rest args)
- `(cons (quote ,key)
- (quote (list :tag ,(capitalize (enwc--sym-to-str key))
- :format "%{%t%}: %v"
- :sample-face bold
- :indent ,(length (enwc--sym-to-str key))
- :args ,(mapcar (lambda (x) (cdr (eval x))) args))))))
-
-(defconst enwc-supplicant-alist
- (list
- (enwc--make-supplicant-multi proto "WPA" "RSN")
- (enwc--make-supplicant-multi key-mgmt "None" "WPA-PSK" "WPA-EAP"
"IEEE8021X")
- (enwc--make-supplicant-choice auth-alg "OPEN" "SHARED" "LEAP")
- (enwc--make-supplicant-multi pairwise "CCMP" "TKIP" "NONE")
- (enwc--make-supplicant-multi group "CCMP" "TKIP" "WEP104" "WEP40")
- (enwc--make-supplicant-secret psk)
- (enwc--make-supplicant-secret wep-key0)
- (enwc--make-supplicant-secret wep-key1)
- (enwc--make-supplicant-secret wep-key2)
- (enwc--make-supplicant-secret wep-key3)
- (enwc--make-supplicant-choice wep-tx-keyidx "0" "1" "2" "3")
- (enwc--make-supplicant-choice eap "TLS" "PEAP" "TTLS" "LEAP" "FAST")
- (enwc--make-supplicant-entry identity)
- (enwc--make-supplicant-entry anonymous-identity)
- (enwc--make-supplicant-secret password)
- (enwc--make-supplicant-file ca-cert)
- (enwc--make-supplicant-file client-cert)
- (enwc--make-supplicant-file private-key)
- (enwc--make-supplicant-secret private-key-passwd)
- (enwc--make-supplicant-file pac-file)
- (enwc--make-supplicant-list phase1
- (enwc--make-supplicant-choice peapver "" "0"
"1")
- (enwc--make-supplicant-choice peaplabel "" "0"
"1")
- (enwc--make-supplicant-choice fast-provisioning
"" "0" "1" "2" "3"))
- (enwc--make-supplicant-list phase2
- (enwc--make-supplicant-choice auth "" "MD5"
"MSCHAPV2" "OTP" "GTC" "TLS")
- (enwc--make-supplicant-choice autheap "" "MD5"
"MSCHAPV2" "OTP" "GTC" "TLS")
- (enwc--make-supplicant-file ca-cert)
- (enwc--make-supplicant-file client-cert)
- (enwc--make-supplicant-file private-key)
- (enwc--make-supplicant-secret
private-key-passwd)))
- "An alist that maps supplicant entries to a widget type.
-
-For more information, see the documentation for wpa_supplicant.")
-
-(defcustom enwc-supplicant-template-alist
- `((wep . ((key-mgmt . ("none"))
- (wep-key0 . req)
- (wep-tx-keyidx . "0")))
- (wpa2 . ((proto . ("wpa" "rsn"))
- (key-mgmt . ("wpa-psk"))
- (pairwise . ("ccmp" "tkip"))
- (group . ("ccmp" "tkip"))
- (psk . req)))
- (leap . ((eap . "leap")
- (key-mgmt . ("ieee8021x"))
- (auth-alg . "leap")
- (identity . req)
- (password . req)))
- (eap-fast . ((proto . ("rsn" "wpa"))
- (pairwise . ("ccmp" "tkip"))
- (group . ("ccmp" "tkip"))
- (key-mgmt . ("wpa-eap"))
- (eap . "fast")
- (identity . req)
- (password . req)
- (phase1 . ((fast-provisioning . "1")))
- (pac-file . opt)))
- (eap-tls . ((key-mgmt . ("wpa-eap"))
- (pairwise . ("tkip"))
- (group . ("tkip"))
- (eap . "tls")
- (identity . req)
- (ca-cert . opt)
- (client-cert . opt)
- (private-key . req)
- (private-key-passwd . req)))
- (peap . ((proto . ("rsn"))
- (key-mgmt . ("wpa-eap"))
- (pairwise . ("ccmp"))
- (eap . "peap")
- (identity . req)
- (password . req)))
- (peap-tkip . ((proto . ("wpa"))
- (key-mgmt . ("wpa-eap"))
- (pairwise . ("tkip"))
- (group . ("tkip"))
- (eap . "peap")
- (identity . req)
- (password . req)
- (ca-cert . opt)
- (phase1 . ((peaplabel . "0")))
- (phase2 . ((auth . "mschapv2"))))))
- "The alist of templates for security.
-This should be an alist of the form (KEY . ((SUPPLICANT-KEY . INITIAL-INPUT)
...))
-Each SUPPLICANT-KEY should be a key from `enwc-supplicant-alist', and
INITIAL-INPUT
-should be an acceptable value for SUPPLICANT-KEY.
-
-If INITIAL-INPUT is the symbol req, then this option is required.
-The value opt means that the option is optional."
- :group 'enwc
- :type '(alist :key-type symbol :value-type (alist :key-type symbol)))
-
-(defun enwc--get-supplicant-entry (ent &optional sec-info)
- "Create a widget definition from ENT.
-
-If optional parameter SEC-INFO is non-nil, then use it
-for security information."
- (let ((init (cdr ent))
- (wid (assq (car ent) enwc-supplicant-alist))
- fin)
- (unless wid
- (error "Unknown supplicant type %s" (car ent)))
- ;; Set the initial value for the widget.
- (when (eq (cadr wid) 'list)
- (let (act-init)
- (dolist (arg (widget-get (cdr wid) :args))
- (push (alist-get (enwc--str-to-sym (downcase (widget-get arg :tag)))
init "")
- act-init))
- (setq init (nreverse act-init))))
- (cons (cadr wid)
- (append (pcase init
- (`req `(:required t :value ,(alist-get (car ent) sec-info
"")))
- (`opt `(:value ,(alist-get (car ent) sec-info "")))
- (_ `(:value ,init)))
- (cddr wid)))))
-
-(defun enwc-create-template-menu (&optional sec-info)
- "Create the widget declaration for the menu of templates.
-
-If specified, SEC-INFO is passed to the templates to initialize them."
- `(menu-choice
- :tag "Security"
- :indent 2
- ,@(mapcar
- (lambda (tm)
- `(list
- :tag ,(symbol-name (car tm))
- :menu-tag ,(symbol-name (car tm))
- ,@(mapcar
- (lambda (ent)
- (enwc--get-supplicant-entry ent sec-info))
- (cdr tm))))
- enwc-supplicant-template-alist)))
-
-(defun enwc-display-sec-widget (&optional sec-info)
- "Create the menu of security templates.
-If specified, SEC-INFO is passed to the templates to initialize them."
- (widget-create (enwc-create-template-menu sec-info)))
-
-(defun enwc-sec-widget-data (widget)
- "Get the data from a security widget WIDGET."
- (let* ((type (widget-get (widget-get widget :choice) :tag))
- (values (widget-value widget))
- (template (assq (intern type) enwc-supplicant-template-alist)))
- (unless template
- (error "Unrecognized security template \"%s\"." type))
- (setq template (cdr template))
- (cons
- `(sec-type . ,(intern type))
- (cl-mapcar
- (lambda (val v)
- (let ((vl v))
- (when (or (eq (car val) 'phase1)
- (eq (car val) 'phase2))
- (let ((subs
- (mapcar
- (lambda (arg)
- (enwc--str-to-sym (downcase (widget-get arg :tag))))
- (widget-get (alist-get (car val) enwc-supplicant-alist)
:args))))
- (setq vl (cl-mapcar 'cons subs v))))
- (print vl)
- (cons (car val) vl)))
- template values))))
-
-(defvar enwc-network-edit-widget nil
- "The network information widget used in the edit buffer.")
-
-(defvar enwc-security-edit-widget nil
- "The security widget used in the edit buffer.")
-
-(defun enwc-setup-edit-buffer ()
- "Setup the edit buffer. This removes the old one if neccessary,
-and redisplays the settings from the network profile
- with id `enwc-edit-id', which is set in `enwc-edit-entry-at-point'."
- (when (get-buffer "*ENWC Edit*")
- (kill-buffer "*ENWC Edit*"))
- (with-current-buffer (get-buffer-create "*ENWC Edit*")
- (let ((nw-info (enwc-get-profile-info enwc-edit-id)))
-
- (widget-insert (concat "Settings for access point "
- (enwc-value-from-scan 'essid enwc-edit-id)
- "\n"))
- (widget-insert "\n")
- (setq enwc-network-edit-widget
- (widget-create 'enwc-profile-props-widget :value nw-info))
-
- (widget-insert "\n")
- (setq enwc-security-edit-widget (enwc-display-sec-widget nw-info))
-
- (use-local-map enwc-edit-map)
- (widget-setup)))
-
- (switch-to-buffer "*ENWC Edit*"))
-
-(defun enwc-edit-save ()
- "Save the network settings from the edit buffer."
- (interactive)
- (unless (get-buffer "*ENWC Edit*")
- (error "Not editing a network entry"))
- (unless (eq (current-buffer) (get-buffer "*ENWC Edit*"))
- (switch-to-buffer "*ENWC Edit*"))
-
- (enwc-save-nw-settings
- enwc-edit-id
- (append (widget-value enwc-network-edit-widget)
- (enwc-sec-widget-data enwc-security-edit-widget))))
-
-(defun enwc-edit-entry-at-point ()
- "Edit the current network entry."
- (interactive)
- (setq enwc-edit-id (tabulated-list-get-id))
- ;; TODO: Use pop-to-buffer
- (enwc-setup-edit-buffer))
-
-(defvar enwc-edit-map
- (let ((map (copy-keymap widget-keymap)))
- (define-key map (kbd "C-x C-s") 'enwc-edit-save)
- map)
- "The keymap for editing network profiles with ENWC.")
-
-(defvar enwc-edit-field-map
- (let ((map (copy-keymap widget-field-keymap)))
- (define-key map (kbd "C-x C-a") 'enwc-edit-view-entry)
- map)
- "The keymap for editable fields within the ENWC edit buffer.")
-
-;;; enwc-edit.el ends here
diff --git a/packages/enwc/enwc-nm.el b/packages/enwc/enwc-nm.el
deleted file mode 100644
index 391f4ee..0000000
--- a/packages/enwc/enwc-nm.el
+++ /dev/null
@@ -1,725 +0,0 @@
-;;; enwc-nm.el - The NetworkManager backend to ENWC
-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
-
-;; Author: Ian Dunn <dunni@gnu.org>
-;; Keywords: external, network, wicd, manager, nm
-;; Version: 2.0
-;; Homepage: https://savannah.nongnu.org/p/enwc
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
-;; 02110-1301, USA.
-
-;;; Commentary:
-;;
-;; This requires NetworkManager >= 0.9.6
-;;
-
-(require 'enwc-backend)
-(require 'enwc)
-(require 'dbus)
-(require 'subr-x)
-
-(defgroup enwc-nm nil
- "*NetworkManager variables for ENWC"
- :prefix "enwc-nm-"
- :group 'enwc)
-
-(defcustom enwc-nm-dbus-service "org.freedesktop.NetworkManager"
- "NetworkManager D-Bus service."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-path "/org/freedesktop/NetworkManager"
- "The default D-Bus path for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-settings-path
"/org/freedesktop/NetworkManager/Settings"
- "The settings D-Bus path for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-interface "org.freedesktop.NetworkManager"
- "The default D-Bus interface for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-wireless-interface
"org.freedesktop.NetworkManager.Device.Wireless"
- "The wireless D-Bus interface for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-wired-interface
"org.freedesktop.NetworkManager.Device.Wired"
- "The wired D-Bus interface for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-device-interface
"org.freedesktop.NetworkManager.Device"
- "The device D-Bus interface for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-accesspoint-interface
"org.freedesktop.NetworkManager.AccessPoint"
- "The access point D-Bus interface for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-settings-interface
"org.freedesktop.NetworkManager.Settings"
- "The settings D-Bus interface for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-connections-interface
"org.freedesktop.NetworkManager.Settings.Connection"
- "The connections D-Bus interface for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-(defcustom enwc-nm-dbus-active-interface
"org.freedesktop.NetworkManager.Connection.Active"
- "The active connection D-Bus interface for NetworkManager."
- :group 'enwc-nm
- :type 'string)
-
-;;TODO: Make this customizable.
-(defconst enwc-nm-dbus-settings-groups
- '(("802-11-wireless-security" . ("name"
- "key-mgmt"
- "wep-tx-keyidx"
- "auth-alg"
- "proto"
- "pairwise"
- "group"
- "leap-username"
- "wep-key0"
- "wep-key1"
- "wep-key2"
- "wep-key3"
- "wep-key-type"
- "psk"
- "leap-password"))
- ("ipv4" . ("addresses"
- "dns"))))
-
-(defvar enwc-nm-wired-dev nil
- "The wired device object path.")
-
-(defvar enwc-nm-wireless-dev nil
- "The wireless device object path.")
-
-(defvar enwc-nm-active-ap nil
- "The active access point object path.")
-
-(defvar enwc-nm-connecting-p nil
- "Whether or not NetworkManager is connecting.")
-
-(defvar enwc-nm-wired-p nil
- "Whether or not NetworkManager is wired.")
-
-(defvar enwc-nm-edit-info nil
- "The information for the network connection being edited.")
-
-;; D-Bus Signals:
-
-(defvar enwc-nm-access-point-added-signal nil
- "D-Bus signal object for the \"AccessPointAdded\" signal.")
-
-(defvar enwc-nm-access-point-removed-signal nil
- "D-Bus signal object for the \"AccessPointRemoved\" signal.")
-
-(defvar enwc-nm-properties-changed-signal nil
- "D-Bus signal object for the \"PropertiesChanged\" signal.")
-
-(defvar enwc-nm-wired-state-changed-signal nil
- "D-Bus signal object for the \"StateChanged\" signal for the wired device.")
-
-(defvar enwc-nm-state-changed-signal nil
- "D-Bus signal object for the \"StateChanged\" signal for the default path.")
-
-(defun enwc-nm-dbus-call-method (method &optional path interface &rest args)
- (unless path (setq path enwc-nm-dbus-path))
- (unless interface (setq interface enwc-nm-dbus-interface))
- (apply 'dbus-call-method :system
- enwc-nm-dbus-service
- path
- interface
- method
- :timeout 25000
- args))
-
-(defun enwc-nm-dbus-default-call-method (method &rest args)
- (apply 'enwc-nm-dbus-call-method method nil nil args))
-
-(defun enwc-nm-dbus-settings-call-method (method &rest args)
- (apply 'enwc-nm-dbus-call-method
- method
- enwc-nm-dbus-settings-path
- enwc-nm-dbus-settings-interface
- args))
-
-(defun enwc-nm-dbus-wireless-call-method (method &rest args)
- (apply 'enwc-nm-dbus-call-method
- method
- enwc-nm-wireless-dev
- enwc-nm-dbus-wireless-interface
- args))
-
-(defun enwc-nm-dbus-wired-call-method (method &rest args)
- (apply 'enwc-nm-dbus-call-method
- method
- enwc-nm-wired-dev
- enwc-nm-dbus-wired-interface
- args))
-
-(defun enwc-nm-get-settings (conn)
- "Get the connection settings from CONN."
- (enwc-nm-dbus-call-method "GetSettings" conn
- enwc-nm-dbus-connections-interface))
-
-(defun enwc-nm-list-connections ()
- "List the connections."
- (enwc-nm-dbus-settings-call-method "ListConnections"))
-
-;; Default
-(defun enwc-nm-get-device-by-name (name)
- (enwc-nm-dbus-default-call-method "GetDeviceByIpIface" :string name))
-
-(defun enwc-nm--ap-to-conn (nw)
- "Get the connection that corresponds to NW."
- (let ((ap-ssid (dbus-byte-array-to-string
- (enwc-nm-get-wireless-network-property nw "Ssid")))
- (profile-table (make-hash-table :test #'equal)))
- ;; Create a hash table of connections, indexed by ssid
- ;; TODO: Store this somewhere else
- (dolist (conn (enwc-nm-list-connections))
- (let ((settings (enwc-nm-get-settings conn)))
- (map-put profile-table
- (dbus-byte-array-to-string (enwc-nm-get-dbus-dict-entry
- "802-11-wireless/ssid"
- settings))
- conn)))
- (map-elt profile-table ap-ssid)))
-
-(defun enwc-nm-connection-p (conn)
- "Return non-nil if CONN is a connection object."
- (and conn
- (stringp conn)
- (string-match "^/org/freedesktop/NetworkManager/Settings/[0-9]+$"
conn)))
-
-(defun enwc-nm--profile-wired-p (conn)
- "Return non-nil if CONN is a wired profile."
- (let ((props (enwc-nm-get-settings conn)))
- (string= (enwc-nm-get-dbus-dict-entry "connection/type" props)
- "802-3-ethernet")))
-
-;;;;;;;;;;;;;;;;;;
-;; Get networks ;;
-;;;;;;;;;;;;;;;;;;
-
-(defun enwc-nm-get-networks (&optional wired)
- (if wired
- (enwc-nm-get-wired-profiles)
- (enwc-nm-get-wireless-networks)))
-
-(defun enwc-nm-get-wireless-networks ()
- "The NetworkManager get networks function.
-This returns a list of D-Bus paths to the access points."
- (enwc-nm-dbus-wireless-call-method "GetAccessPoints"))
-
-(defun enwc-nm-get-wired-profiles ()
- (let ((profs-list (enwc-nm-list-connections)))
- (cl-remove-if-not #'enwc-nm--profile-wired-p profs-list)))
-
-;;;;;;;;;;;;;
-;; Connect ;;
-;;;;;;;;;;;;;
-
-(defun enwc-nm-connect (nw &optional wired)
- "The NetworkManager connect function.
-This gets the connection path from NW, and connects to it."
- (if wired
- (enwc-nm-wired-connect nw)
- (enwc-nm-wireless-connect nw)))
-
-(defun enwc-nm-wireless-connect (nw)
- (when-let ((conn (enwc-nm--ap-to-conn nw)))
- (enwc-nm-dbus-default-call-method "ActivateConnection"
- :object-path conn
- :object-path enwc-nm-wireless-dev
- :object-path conn)))
-
-(defun enwc-nm-wired-connect (nw)
- (enwc-nm-dbus-default-call-method "ActivateConnection"
- :object-path nw
- :object-path enwc-nm-wired-dev
- :object-path nw))
-
-;;;;;;;;;;;;;;;;
-;; Disconnect ;;
-;;;;;;;;;;;;;;;;
-
-(defun enwc-nm-disconnect (&optional wired)
- (if wired
- (enwc-nm-wired-disconnect)
- (enwc-nm-disconnect-wireless)))
-
-;; Device
-(defun enwc-nm-disconnect-wireless ()
- (enwc-nm-dbus-call-method "Disconnect"
- enwc-nm-wireless-dev
- enwc-nm-dbus-device-interface))
-
-(defun enwc-nm-wired-disconnect ()
- (enwc-nm-dbus-call-method "Disconnect"
- enwc-nm-wired-dev
- enwc-nm-dbus-device-interface))
-
-;;;;;;;;;;
-;; Scan ;;
-;;;;;;;;;;
-
-(defun enwc-nm-scan (&optional wired)
- "The NetworkManager scan function."
- (let ((dev (if wired
- enwc-nm-wired-dev
- enwc-nm-wireless-dev))
- (interface (if wired
- enwc-nm-dbus-wired-interface
- enwc-nm-dbus-wireless-interface)))
- (enwc-nm-dbus-call-method "RequestScan"
- dev interface
- '(:array :signature "{sv}"))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Get network properties ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-nm-get-wireless-network-property (nw prop)
- "The NetworkManager get wireless network property function.
-This runs like normal, using element ID of `enwc-access-points'
- to determine the access point path, then obtains the property
-PROP from that access point. It also sets the channel from the
- frequency if necessary."
- (dbus-get-property :system
- enwc-nm-dbus-service
- nw
- enwc-nm-dbus-accesspoint-interface
- prop))
-
-(defun enwc-nm--freq-to-channel (freq)
- "Convert a frequency FREQ into a channel."
- (1+ (/ (- freq 2412) 5)))
-
-(defun enwc-nm-get-wireless-nw-props (nw)
- "Get the network properties for the network NW."
- (let ((props (dbus-get-all-properties :system
- enwc-nm-dbus-service
- nw
- enwc-nm-dbus-accesspoint-interface)))
-
- `((essid . ,(dbus-byte-array-to-string (cdr (assoc "Ssid" props))))
- (bssid . ,(cdr (assoc "HwAddress" props)))
- (strength . ,(cdr (assoc "Strength" props)))
- (encrypt . ,(or (enwc-nm-get-encryption-type nw) "Unsecured"))
- (channel . ,(enwc-nm--freq-to-channel
- (cdr (assoc "Frequency" props)))))))
-
-(defun enwc-nm-get-encryption-type (nw)
- "The NetworkManager get encryption type function.
-This gets the WPA flags and RSN flags from access point in NW.
-If both are 0, then it returns WEP, otherwise WPA."
- (let ((wpa-flags (enwc-nm-get-wireless-network-property nw "WpaFlags"))
- (rsn-flags (enwc-nm-get-wireless-network-property nw "RsnFlags")))
- (if (and (= wpa-flags 0) (= rsn-flags 0))
- "WEP"
- "WPA")))
-
-(defun enwc-nm-get-wired-nw-props (nw)
- (let ((settings (enwc-nm-get-settings nw)))
- `((name . ,(enwc-nm-get-dbus-dict-entry "connection/id" settings)))))
-
-(defun enwc-nm-get-nw-props (nw &optional wired-p)
- (if wired-p
- (enwc-nm-get-wired-nw-props nw)
- (enwc-nm-get-wireless-nw-props nw)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Get Current network id ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-nm-wireless-prop-changed (props)
- "Called when network properties are changed.
-PROPS is a list of updated properties."
- (let ((ap (assoc "ActiveAccessPoint" props)))
- (when ap
- (setq enwc-nm-active-ap (car (cadr ap))))))
-
-(defun enwc-nm-get-current-nw-id (wired)
- "The NetworkManager get current network id function.
-This simply checks for the active access point."
- (cond
- (wired 'wired)
- ((string= enwc-nm-active-ap "/") nil)
- (t enwc-nm-active-ap)))
-
-(defun enwc-nm-prop-changed (state)
- "Called when NetworkManager's state is changed.
-STATE is the new state
-
-If STATE is 40, then NetworkManager is connecting to a new AP."
- (setq enwc-nm-connecting-p (eq state 40)))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;; Check Connecting ;;
-;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-nm-check-connecting ()
- "The NetworkManager check connecting function."
- enwc-nm-connecting-p)
-
-(defun enwc-nm-dev-prop-changed (new-state old-state reason)
- (setq enwc-nm-wired-p (eq new-state 100)))
-
-(defun enwc-nm-is-wired ()
- enwc-nm-wired-p)
-
-;;;;;;;;;;;;;;;;;;;;;;
-;; Profile Handling ;;
-;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-nm-gen-uuid ()
- "Generate a UUID."
- (random t)
- (apply 'format
- "%04x%04x-%04x-%04x-%04x-%04x%04x%04x"
- (mapcar (lambda (x)
- (random 65535))
- (number-sequence 0 7))))
-
-(defmacro enwc-nm--hex-substring (str st ed)
- "Get a standard integer from hex string STR starting at ST and ending st ED"
- `(string-to-number (substring ,str ,st ,ed) 16))
-
-(defun enwc-nm-convert-addr (addr)
- "Convert an address ADDR from an integer in network byte order to a string."
- (if (and addr (integerp addr))
- (let* ((hex-addr (format "%08x" addr))
- (subs (mapcar
- (lambda (n)
- (enwc-nm--hex-substring hex-addr n (+ n 2)))
- (number-sequence 6 0 -2))))
- (apply 'format "%i.%i.%i.%i" subs))
- ""))
-
-(defun enwc-nm-addr-back (addr)
- "Convert an IP address ADDR in dots notation to an integer."
- (cl-check-type addr string)
- (let* ((bytes (split-string addr "\\."))
- (byte-string (mapcar
- (lambda (n) (lsh (string-to-number (nth n bytes))
- (* 8 n)))
- (number-sequence 0 3))))
- (apply 'logior byte-string)))
-
-;; These next two come from libnm-util/nm-utils.c in NM's source.
-
-;; (defun enwc-nm-netmask-to-prefix (netmask)
-;; "Convert a netmask to a CIDR prefix.
-;; NETMASK is an ip address in network byte order."
-;; (if (and netmask (integerp netmask))
-;; (progn
-;; (setq netmask (enwc--htonl netmask))
-;; (while (cl-evenp netmask)
-;; (setq netmask (lsh netmask -1)))
-;; (floor (log (1+ netmask) 2)))
-;; 0))
-
-;; (defun enwc-nm-prefix-to-netmask (prefix)
-;; "Convert a CIDR prefix to a netmask.
-;; PREFIX is an integer <= 32."
-;; (if (and prefix (integerp prefix))
-;; (progn
-;; (setq prefix (min prefix 32))
-;; (enwc--htonl (lsh (1- (expt 2 prefix)) (- 32 prefix))))
-;; 0))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;; D-Bus Conversion ;;
-;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-nm-get-dbus-dict-entry (entry dict)
- "Get an entry ENTRY from D-Bus dictionary DICT.
-
-ENTRY is in the form LVL1/LVL2/.../LVLN, where each LVLi is a string
-representing another layer in the dictionary."
- (cl-check-type entry string)
- (cl-check-type dict list)
- (let ((ent-strs (split-string entry "/"))
- (cur-ent dict)
- cur-str)
- (while ent-strs
- (setq cur-str (pop ent-strs))
- (setq cur-ent (assoc cur-str cur-ent))
- (when cur-ent
- (setq cur-ent (cadr cur-ent))))
- (when cur-ent (car cur-ent))))
-
-(defun enwc-nm--recurse-dbus-entry (dict value entries)
- "Look in DICT for ENTRIES, and set the final one to VALUE."
- (if (not entries)
- (setcar dict value)
- (let* ((cur-str (car entries))
- (cur-ent (assoc cur-str dict)))
- (unless cur-ent
- (if (equal dict '(nil))
- (setcar dict `(,cur-str (nil)))
- (nconc dict `((,cur-str (nil)))))
- (setq cur-ent (assoc cur-str dict)))
- (enwc-nm--recurse-dbus-entry (cadr cur-ent) value (cdr entries)))))
-
-(defun enwc-nm-set-dbus-dict-entry (entry dict value)
- "Set entry ENTRY in D-Bus dictionary DICT to VALUE."
- (cl-check-type entry string)
- (cl-check-type dict list)
- (enwc-nm--recurse-dbus-entry dict value (split-string entry "/")))
-
-(defun enwc-nm-convert-dict-list (dict-ent settings)
- "Convert a D-Bus dictionary entry DICT-ENT from SETTINGS to an alist."
- (mapcar
- (lambda (ent)
- (cons
- (intern (car ent))
- (cl-caadr ent)))
- (cadr (assoc dict-ent settings))))
-
-(defun enwc-nm-get-sec-info (settings)
- "Get security information from SETTINGS."
- (append
- (enwc-nm-convert-dict-list "802-11-wireless-security" settings)
- (enwc-nm-convert-dict-list "802-1x" settings)))
-
-(defun enwc-nm-pair-to-dbus-dict-ent (pair)
- "Convert PAIR into a D-Bus dictionary entry."
- (let ((str (car pair))
- (var (cdr pair)))
- `(:dict-entry (:string ,str :variant ,var))))
-
-(defun enwc-nm-alist-to-dbus-dict (alist)
- "Convert ALIST into a D-Bus dictionary."
- (let (dict)
- (append
- '(:array)
- (dolist (pr alist dict)
- (setq dict (apply 'list dict (enwc-nm-pair-to-dbus-dict-ent pr)))))))
-
-(defun enwc-nm-process-profile-info (settings prof-info)
- (dolist (ent prof-info settings)
- ;; Find the corresponding entry in settings, and set it to the new value.
- ;; Check 802-11-wireless-security, then 802-1x, then ipv4.
- (let ((ent-list '("802-11-wireless-security"
- "ipv4"))
- cur-ent)
- (while ent-list
- (setq cur-ent (pop ent-list))
- (when (enwc-nm-set-dbus-dict-entry (concat cur-ent "/"
- (symbol-name (car ent)))
- settings
- (cdr ent))
- (setq ent-list nil))))))
-
-(defun enwc-nm-alist-to-dbus-str-str-var-map-map (alist)
- (let (ret)
- (dolist (ent alist ret)
- (push `(:string (car ent) ,(enwc-nm-alist-to-dbus-dict (cadr ent))) ret)
- (push :dict-entry ret))))
-
-;; (defun enwc-nm-get-profile-info (ap &optional wired)
-;; "Get the profile info for access point AP."
-;; (let ((conn (enwc-nm--ap-to-conn ap))
-;; settings)
-;; (when conn
-;; (setq settings (enwc-nm-get-settings conn)))
-;; (when settings
-;; (let* ((adr-info (caar (enwc-nm-get-dbus-dict-entry "ipv4/addresses"
settings)))
-;; (ip-addr (enwc-nm-convert-addr (nth 0 adr-info)))
-;; (netmask (enwc-nm-convert-addr (enwc-nm-prefix-to-netmask (nth
1 adr-info))))
-;; (gateway (enwc-nm-convert-addr (nth 2 adr-info)))
-;; (dns-list (mapcar 'enwc-nm-convert-addr
-;; (car (enwc-nm-get-dbus-dict-entry "ipv4/dns"
-;;
settings))))
-;; (sec-info (enwc-nm-get-sec-info settings)))
-;; `((addr . ,ip-addr)
-;; (netmask . ,netmask)
-;; (gateway . ,gateway)
-;; (dns1 . ,(nth 0 dns-list))
-;; (dns2 . ,(nth 1 dns-list))
-;; ,@sec-info)))))
-
-(defun enwc-nm-finalize-settings (settings)
- "Set up all of the D-BUS types of a settings list SETTINGS.
-This will place all of the necessary markers in the list, such as :array,
-:dict-entry, etc."
- `(:array ,@(enwc-nm-alist-to-dbus-str-str-var-map-map settings)))
-
-(defun enwc-nm-setup-settings (conn settings wired)
- "Set up NetworkManager settings.
-Get the current network properties of network CONN
-and uses the information in the association list SETTINGS
-to put it in the form that NetworkManager will recognize."
- (let (conn-settings)
- (if (enwc-nm-connection-p conn)
- (setq conn-settings (enwc-nm-get-settings conn))
- (message "Not a connection")
- (print conn)
- ;;TODO: ssid will be invalid for wired connections.
- ;; This would actually throw an error in that case.
- (let ((ssid (dbus-byte-array-to-string
(enwc-nm-get-wireless-network-property
- conn "Ssid")))
- (type (if wired "802-3-ethernet" "802-11-wireless")))
- (setq conn-settings `(("connection"
- (("id" (,(concat ssid " settings")))
- ("uuid" (,(enwc-nm-gen-uuid)))
- ("autoconnect" (nil))
- ("type" (,type))))))))
- (setq conn-settings (enwc-nm-process-profile-info conn-settings settings))
- (pp conn-settings)
- (print conn-settings)
- (enwc-nm-finalize-settings conn-settings)))
-
-(defun enwc-nm-save-nw-settings (ap settings wired)
- "Save network AP with settings SETTINGS."
- (let ((conn (enwc-nm--ap-to-conn ap)))
- (print conn)
- (if conn
- (enwc-nm-dbus-call-method "Update"
- conn
- enwc-nm-dbus-connections-interface
- (enwc-nm-setup-settings conn settings wired))
- (enwc-nm-dbus-call-method "AddConnection"
- enwc-nm-dbus-settings-path
- enwc-nm-dbus-settings-interface
- (enwc-nm-setup-settings ap settings wired)))))
-
-
- ; ;;;;;;;;;;;;;;;;; ;
- ; ;; Load/Unload ;; ;
- ; ;;;;;;;;;;;;;;;;; ;
-
-
-(defun enwc-nm-load ()
- "Setup the NetworkManager back-end."
- ;;TODO: Add way of changing these two after load.
- (setq enwc-nm-wired-dev (enwc-nm-get-device-by-name enwc-wired-device)
- enwc-nm-wireless-dev (enwc-nm-get-device-by-name enwc-wireless-device))
-
- (setq enwc-nm-access-point-added-signal
- (dbus-register-signal :system
- enwc-nm-dbus-service
- enwc-nm-wireless-dev
- enwc-nm-dbus-wireless-interface
- "AccessPointAdded"
- 'enwc-process-scan))
-
- (setq enwc-nm-access-point-removed-signal
- (dbus-register-signal :system
- enwc-nm-dbus-service
- enwc-nm-wireless-dev
- enwc-nm-dbus-wireless-interface
- "AccessPointRemoved"
- 'enwc-process-scan))
-
- (setq enwc-nm-active-ap
- (let ((cur-net (dbus-get-property :system
- enwc-nm-dbus-service
- enwc-nm-wireless-dev
- enwc-nm-dbus-wireless-interface
- "ActiveAccessPoint")))
- (if (string= cur-net "/")
- "/"
- cur-net)))
-
- (setq enwc-nm-properties-changed-signal
- (dbus-register-signal :system
- enwc-nm-dbus-service
- enwc-nm-wireless-dev
- enwc-nm-dbus-wireless-interface
- "PropertiesChanged"
- 'enwc-nm-wireless-prop-changed))
-
- (setq enwc-nm-connecting-p
- (let ((state (dbus-get-property :system
- enwc-nm-dbus-service
- enwc-nm-dbus-path
- enwc-nm-dbus-interface
- "State")))
- (eq state 40)))
-
- (setq enwc-nm-wired-state-changed-signal
- (dbus-register-signal :system
- enwc-nm-dbus-service
- enwc-nm-wired-dev
- enwc-nm-dbus-device-interface
- "StateChanged"
- 'enwc-nm-dev-prop-changed))
-
- (setq enwc-nm-wired-p
- (let ((state (dbus-get-property :system
- enwc-nm-dbus-service
- enwc-nm-wired-dev
- enwc-nm-dbus-device-interface
- "State")))
- (eq state 100)))
- (setq enwc-nm-state-changed-signal
- (dbus-register-signal :system
- enwc-nm-dbus-service
- enwc-nm-dbus-path
- enwc-nm-dbus-interface
- "StateChanged"
- 'enwc-nm-prop-changed)))
-
-(defun enwc-nm-unload ()
- "Unload the NetworkManager back-end.
-
-Unregister all of the D-Bus signals set up during load."
- (dbus-unregister-object enwc-nm-access-point-added-signal)
- (dbus-unregister-object enwc-nm-access-point-removed-signal)
- (dbus-unregister-object enwc-nm-properties-changed-signal)
- (dbus-unregister-object enwc-nm-wired-state-changed-signal)
- (dbus-unregister-object enwc-nm-state-changed-signal))
-
-(defun enwc-nm-can-load-p ()
- ;; (dbus-ping :system enwc-nm-dbus-service)
- ;; NetworkManager doesn't allow Ping, so we have to use an alternative.
- (dbus-introspect :system enwc-nm-dbus-service enwc-nm-dbus-path))
-
-(enwc-register-backend
- (make-enwc-backend
- :key 'nm
- :can-load-p #'enwc-nm-can-load-p
- :load #'enwc-nm-load
- :unload #'enwc-nm-unload
- :network-ids #'enwc-nm-get-networks
- :scan #'enwc-nm-scan
- :connect #'enwc-nm-connect
- :disconnect #'enwc-nm-disconnect
- :current-nw-id #'enwc-nm-get-current-nw-id
- :is-connecting-p #'enwc-nm-check-connecting
- :nw-props #'enwc-nm-get-nw-props
- :is-wired-p #'enwc-nm-is-wired))
-
-(provide 'enwc-nm)
-
-;;; enwc-nm.el ends here
diff --git a/packages/enwc/enwc-test.el b/packages/enwc/enwc-test.el
deleted file mode 100644
index 5b3c6f1..0000000
--- a/packages/enwc/enwc-test.el
+++ /dev/null
@@ -1,66 +0,0 @@
-;;; enwc-test.el --- Tests for ENWC
-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
-
-;; Author: Ian Dunn <dunni@gnu.org>
-;; Keywords: external, network, wicd, manager, nm
-;; Version: 2.0
-;; Package-Requires: ((emacs "25.1"))
-;; Homepage: https://savannah.nongnu.org/p/enwc
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'enwc)
-(require 'ert)
-
-;; Test enwc-setup
-
-(ert-deftest enwc-test-select-interface-save ()
- ;; Test saving the interfaces and using the ip selection back-end
- (let ((enwc-interface-list-function 'enwc--ip-interface-list)
- (enwc-ask-to-save-interfaces t)
- ;; Temporarily save our changes to a different file
- (custom-file (make-temp-file "enwc-custom-"))
- (enwc-wired-device "")
- (enwc-wireless-device ""))
- (enwc--setup-select-interfaces)
- (should (not (string-empty-p enwc-wired-device)))
- (should (not (string-empty-p enwc-wireless-device)))
- ;; Test whether the interfaces were saved
- (let ((enwc-wired-device "")
- (enwc-wireless-device ""))
- (load custom-file)
- (should (not (string-empty-p enwc-wired-device)))
- (should (not (string-empty-p enwc-wireless-device))))
- ;; Delete our temporary custom file
- (delete-file custom-file)))
-
-(ert-deftest enwc-test-select-interface-no-save ()
- ;; Test not saving the interfaces and using the ifconfig selection back-end
- (let ((enwc-interface-list-function 'enwc--ifconfig-interface-list)
- (enwc-ask-to-save-interfaces nil)
- ;; Temporarily save our "changes" to a different file
- (custom-file (make-temp-file "enwc-custom-"))
- (enwc-wired-device "")
- (enwc-wireless-device ""))
- (enwc--setup-select-interfaces)
- (should (not (string-empty-p enwc-wired-device)))
- (should (not (string-empty-p enwc-wireless-device)))
- ;; Test whether the interfaces were saved
- (let ((enwc-wired-device "")
- (enwc-wireless-device ""))
- (load custom-file)
- (should (string-empty-p enwc-wired-device))
- (should (string-empty-p enwc-wireless-device)))
- ;; Delete our temporary custom file
- (delete-file custom-file)))
-
-(provide 'enwc-test)
-
-;; Local Variables:
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; enwc-test.el ends here
diff --git a/packages/enwc/enwc-wicd.el b/packages/enwc/enwc-wicd.el
deleted file mode 100644
index f0e157c..0000000
--- a/packages/enwc/enwc-wicd.el
+++ /dev/null
@@ -1,483 +0,0 @@
-;;; enwc-wicd.el --- The Wicd backend to ENWC
-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
-
-;; Author: Ian Dunn <dunni@gnu.org>
-;; Keywords: external, network, wicd, manager, nm
-;; Version: 2.0
-;; Homepage: https://savannah.nongnu.org/p/enwc
-
-;; This file is part of GNU Emacs
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
-;; 02110-1301, USA.
-
-;;; Commentary:
-
-;; Wicd is one of the default supported back-ends for ENWC.
-
-;;; Code:
-
-(require 'enwc-backend)
-(require 'enwc)
-(require 'dbus)
-
-(defgroup enwc-wicd nil
- "*Wicd variables for ENWC."
- :prefix "enwc-wicd-"
- :group 'enwc)
-
-(defcustom enwc-wicd-dbus-service "org.wicd.daemon"
- "The wicd D-Bus service identifier."
- :group 'enwc-wicd
- :type 'string)
-
-(defcustom enwc-wicd-dbus-wireless-path "/org/wicd/daemon/wireless"
- "The wicd wireless D-Bus path."
- :group 'enwc-wicd
- :type 'string)
-
-(defcustom enwc-wicd-dbus-wireless-interface "org.wicd.daemon.wireless"
- "The wicd wireless D-Bus interface."
- :group 'enwc-wicd
- :type 'string)
-
-(defcustom enwc-wicd-dbus-wired-path "/org/wicd/daemon/wired"
- "The wicd wired D-Bus path."
- :group 'enwc-wicd
- :type 'string)
-
-(defcustom enwc-wicd-dbus-wired-interface "org.wicd.daemon.wired"
- "The wicd wired D-Bus interface."
- :group 'enwc-wicd
- :type 'string)
-
-(defvar enwc-wicd-details-list
- '("essid" "bssid" "quality" "encryption" "channel")
- "The list of the desired details to be obtained from each network.")
-
-(defvar enwc-wicd-current-ap ""
- "Current access point.
-UNUSED")
-
-(defvar enwc-wicd-current-nw-id -1
- "Id of the current network.
-UNUSED")
-
-(defvar enwc-wicd-end-scan-signal nil
- "D-Bus signal object for the \"SendEndScanSignal\" signal.")
-
-(defvar enwc-wicd-status-changed-signal nil
- "D-Bus signal objects for the \"StatusChanged\" signal.")
-
-(defun enwc-wicd-dbus-wireless-call-method (method &rest args)
- "Calls D-Bus method METHOD with arguments ARGS within
-the wicd wireless interface."
- (apply 'dbus-call-method :system
- enwc-wicd-dbus-service
- enwc-wicd-dbus-wireless-path
- enwc-wicd-dbus-wireless-interface
- method
- :timeout 25000
- args))
-
-(defun enwc-wicd-dbus-wired-call-method (method &rest args)
- "Calls D-Bus method METHOD with arguments ARGS within
-the wicd wired interface."
- (apply 'dbus-call-method :system
- enwc-wicd-dbus-service
- enwc-wicd-dbus-wired-path
- enwc-wicd-dbus-wired-interface
- method
- :timeout 25000
- args))
-
-;;;;;;;;;;
-;; Scan ;;
-;;;;;;;;;;
-
-(defun enwc-wicd-scan ()
- "Wicd scan function."
- (enwc-wicd-dbus-wireless-call-method "Scan"))
-
-;;;;;;;;;;;;;;;;;;
-;; Get networks ;;
-;;;;;;;;;;;;;;;;;;
-
-(defun enwc-wicd-get-networks (&optional wired)
- (if wired
- (enwc-wicd-get-wired-profiles)
- (enwc-wicd-get-wireless-networks)))
-
-(defun enwc-wicd-get-wireless-networks ()
- "Wicd get networks function.
-Just returns a number sequence."
- (number-sequence 0 (1- (enwc-wicd-dbus-wireless-call-method
"GetNumberOfNetworks"))))
-
-(defun enwc-wicd-get-wired-profiles ()
- "Get the list of wired network profiles."
- (enwc-wicd-dbus-wired-call-method "GetWiredProfileList"))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Get network properties ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar enwc-wicd-prop-values nil)
-(defvar enwc-wicd-prop-num 0)
-(defvar enwc-wicd-prop-timeout 3)
-
-(defun enwc-wicd-nw-prop-handler (prop &rest args)
- "The handler for `enwc-wicd-get-wireless-network-property'.
-This receives the value of network property PROP,
-and appends the value to `enwc-wicd-prop-values'."
- (push (cons prop (car args)) enwc-wicd-prop-values)
- (setq enwc-wicd-prop-num (1+ enwc-wicd-prop-num)))
-
-(defun enwc-wicd-prop-to-prop (prop)
- "Convert a Wicd network property to an ENWC network property."
- (cond
- ((equal prop "essid") 'essid)
- ((equal prop "bssid") 'bssid)
- ((equal prop "quality") 'strength)
- ((equal prop "encryption") 'encrypt)
- ((equal prop "mode") 'mode)
- ((equal prop "channel") 'channel)))
-
-(defun enwc-wicd-get-wireless-network-property (id prop)
- "Wicd get wireless network property function.
-This calls the D-Bus method on Wicd to get the property PROP
-from wireless network with id ID."
- (dbus-call-method-asynchronously :system
- enwc-wicd-dbus-service
- enwc-wicd-dbus-wireless-path
- enwc-wicd-dbus-wireless-interface
- "GetWirelessProperty"
- `(lambda (x) (enwc-wicd-nw-prop-handler
,prop x))
- :timeout 1000
- :int32 id
- :string prop))
-
-(defun enwc-wicd-build-prop-list (prop-list det-list)
- (mapcar
- (lambda (det)
- (let* ((cur-prop (assoc det prop-list))
- (act-det (enwc-wicd-prop-to-prop det))
- (act-prop (when cur-prop (cdr cur-prop))))
- (when (or (string-equal det "essid")
- (string-equal det "channel"))
- (setq act-prop (string-to-number cur-prop)))
- (cons act-det act-prop)))
- det-list))
-
-(defun enwc-wicd-get-wireless-nw-props (id)
- "Get the network properties of a network.
-This function returns an associative list of properties
-for the network with id ID.
-For a list of properties, see `enwc-wicd-details-list'."
- (setq enwc-wicd-prop-values nil)
- (setq enwc-wicd-prop-num 0)
- (dolist (x enwc-wicd-details-list)
- (enwc-wicd-get-wireless-network-property id x))
-
- (with-timeout (enwc-wicd-prop-timeout)
- (while (< enwc-wicd-prop-num (length enwc-wicd-details-list))
- (read-event nil nil 0.001)))
-
- (if (assoc "encryption" enwc-wicd-prop-values)
- (let ((enc-type (enwc-wicd-get-encryption-type id)))
- (setcdr (assoc "encryption" enwc-wicd-prop-values)
- (or enc-type "Unsecured")))
- (setq enwc-wicd-prop-values
- (cons (cons "encryption" "Unsecured")
- enwc-wicd-prop-values)))
-
- (enwc-wicd-build-prop-list enwc-wicd-prop-values enwc-wicd-details-list))
-
-(defalias 'enwc-wicd-get-wireless-network-props
'enwc-wicd-get-wireless-nw-props)
-
-(defun enwc-wicd-get-encryption-type (id)
- "Wicd get encryption type function.
-This calls the D-Bus method on Wicd to get the encryption_method
-property from wireless network with id ID."
- (enwc-wicd-dbus-wireless-call-method "GetWirelessProperty"
- id "encryption_method"))
-
-(defun enwc-wicd-get-wired-nw-prop (id det)
- "Get property DET from the wired network with id ID."
- (enwc-wicd-dbus-wired-call-method "GetWiredProperty" id det))
-
-(defun enwc-wicd-get-wired-nw-props (id)
- ;; TODO Do wicd wired profiles have names?
- (ignore id)
- `((name . "Wired Profile")))
-
-(defun enwc-wicd-get-network-props (id &optional wired)
- (if wired
- (enwc-wicd-get-wired-nw-props id)
- (enwc-wicd-get-wireless-network-props id)))
-
-;;;;;;;;;;;;;;;;;;;;;;;
-;; Connect Functions ;;
-;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-wicd-connect (id &optional wired)
- "Wicd connect function.
-This calls the D-Bus method on Wicd to connect to a
-wired or wireless network with id ID."
- (if wired
- (enwc-wicd-wired-connect id)
- (enwc-wicd-dbus-wireless-call-method "ConnectWireless" id)))
-
-(defun enwc-wicd-wireless-connect (id)
- "Wicd connect function.
-This calls the D-Bus method on Wicd to connect to a
-wireless network with id ID."
- (enwc-wicd-dbus-wireless-call-method "ConnectWireless" id))
-
-(defun enwc-wicd-wired-connect (id)
- "Connect to the wired network with profile id ID."
- (let* ((profs (enwc-wicd-get-wired-profiles))
- (prf (nth id profs)))
- (enwc-wicd-dbus-wired-call-method "ReadWiredNetworkProfile" prf)
- (enwc-wicd-dbus-wired-call-method "ConnectWired")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Disconnect functions ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-wicd-disconnect (&optional wired)
- (if wired
- (enwc-wicd-wired-disconnect)
- (enwc-wicd-wireless-disconnect)))
-
-(defun enwc-wicd-wireless-disconnect ()
- "Wicd disconnect function."
- (enwc-wicd-dbus-wireless-call-method "DisconnectWireless"))
-
-(defun enwc-wicd-wired-disconnect ()
- "Disconnect from the wired connection."
- (enwc-wicd-dbus-wired-call-method "DisconnectWired"))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Get current network id ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-wicd-get-current-nw-id (wired-p)
- "Wicd get current network id function.
-The current network id is updated upon connect,
-so this jut returns the tracked network id."
- (let ((ap (enwc-wicd-dbus-wireless-call-method "GetCurrentNetworkID")))
- (cond
- (wired-p 'wired)
- ((< ap 0) nil)
- (t ap))))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;; Check Connecting ;;
-;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-wicd-check-connecting ()
- "Return non-nil if currently connecting to a network."
- (enwc-wicd-dbus-wireless-call-method "CheckIfWirelessConnecting"))
-
-;;;;;;;;;;;;;
-;; Is Wired
-;;;;;;;;;;;;;
-
-(defun enwc-wicd-is-wired ()
- "Return non-nil if connected to a wired network."
- (not (not (enwc-wicd-dbus-wired-call-method "GetWiredIP"))))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;; Get Profile Info ;;
-;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defun enwc-wicd-get-profile-ent (id ent wired)
-;; "Get profile entry ENT from the network with id ID.
-;; WIRED is set to indicate whether this is a wired network.
-;; This function is a wrapper around the *-get-(wired|wireless)-nw-prop
-;; functions, allowing for a single function that checks for wired."
-;; (if wired
-;; (enwc-wicd-get-wired-nw-prop id ent)
-;; (enwc-wicd-dbus-wireless-call-method "GetWirelessProperty" id ent)))
-
-;; (defun enwc-wicd-get-profile-info (id &optional wired)
-;; "Get the profile for profile ID.
-;; WIRED is set to indicate whether this is a wired network."
-;; (let ((dns-list (enwc-wicd-get-dns id wired))
-;; (sec-info (enwc-wicd-get-profile-sec-info id wired)))
-;; `((addr . ,(enwc-wicd-get-ip-addr id wired))
-;; (netmask . ,(enwc-wicd-get-netmask id wired))
-;; (gateway . ,(enwc-wicd-get-gateway id wired))
-;; (dns1 . ,(nth 0 dns-list))
-;; (dns2 . ,(nth 1 dns-list))
-;; ,@sec-info)))
-
-;; (defun enwc-wicd-get-profile-sec-info (id &optional wired)
-;; "Get the security info for profile with id ID.
-;; WIRED is set to indicate whether this is a wired network."
-;; (remq nil
-;; (mapcar
-;; (lambda (ent)
-;; (let ((info (enwc-wicd-get-profile-ent wired id (symbol-name (car
ent)))))
-;; (if info
-;; (cons (car ent) info)
-;; nil)))
-;; enwc-supplicant-alist)))
-
-;; (defun enwc-wicd-get-ip-addr (id wired)
-;; "Get the IP Address from the network with id ID.
-;; Wired is set to indicate whether this is a wired network."
-;; (or (enwc-wicd-get-profile-ent id "ip" wired) ""))
-
-;; (defun enwc-wicd-get-netmask (id wired)
-;; "Get the Netmask from the network with id ID.
-;; WIRED is set to indicate whether this is a wired network."
-;; (or (enwc-wicd-get-profile-ent id "netmask" wired) ""))
-
-;; (defun enwc-wicd-get-gateway (id wired)
-;; "Get the Gateway from the network with id ID.
-;; WIRED is set to indicate whether this is a wired network."
-;; (or (enwc-wicd-get-profile-ent id "gateway" wired) ""))
-
-;; (defun enwc-wicd-get-dns (id wired)
-;; "Get the list of DNS servers from the network with id ID.
-;; WIRED is set to indicate whether this is a wired network."
-;; (list (or (enwc-wicd-get-profile-ent id "dns1" wired) "")
-;; (or (enwc-wicd-get-profile-ent id "dns2" wired) "")
-;; (or (enwc-wicd-get-profile-ent id "dns3" wired) "")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Save Network Settings ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-wicd-set-nw-prop (wired id prop val)
- "Set the network property PROP of the network with id ID
-to VAL.
-WIRED indicates whether this is a wired network."
- (if wired
- (enwc-wicd-dbus-wired-call-method "SetWiredProperty"
- id prop val)
- (enwc-wicd-dbus-wireless-call-method "SetWirelessProperty"
- id prop val)))
-
-(defun enwc-wicd-save-nw-profile (wired id)
- "Save the network profile with for the network with id ID.
-WIRED indicates whether this is a wired network."
- (if wired
- (enwc-wicd-dbus-wired-call-method "SaveWiredNetworkProfile" id)
- (enwc-wicd-dbus-wireless-call-method "SaveWirelessNetworkProfile" id)))
-
-(defun enwc-wicd--phase-to-string (phase)
- "Convert a list of phase settings PHASE into a string.
-
-The format of this string is \"ENT0=VAL0 ENT1=VAL1 ... ENTN=VALN\",
-for each entry in PHASE."
- (mapconcat
- (lambda (ent)
- (format "%s=%s" (car ent) (cdr ent)))
- phase " "))
-
-(defun enwc-wicd-save-nw-settings (id settings &optional wired)
- "Set the settings for network ID to SETTINGS and save the profile.
-The association list SETTINGS contains the settings for the network.
-WIRED indicates whether or not ID is a wired connection."
- (dolist (setting settings)
- (let (key ent)
- ;; There are four special cases in here:
- ;; 1. IP Address, which has a different key.
- ;; 2. Encryption type, which has a different key and value.
- ;; 3,4. Phases, both of which need to have their results concatenated.
- (pcase (car setting)
- ('addr (setq key "ip"
- ent (cdr setting)))
- ('sec-type (setq key "enctype"
- ent (if (cdr setting)
- (symbol-name (cdr setting))
- "None")))
- ('phase1 (setq key "phase1"
- ent (enwc-wicd--phase-to-string (cdr setting))))
- ('phase2 (setq key "phase2"
- ent (enwc-wicd--phase-to-string (cdr setting))))
- (_ (setq key (symbol-name (car setting))
- ent (or (cdr setting) ""))))
- (enwc-wicd-set-nw-prop wired id key ent)))
-
- (enwc-wicd-save-nw-profile wired id))
-
-(defun enwc-wicd-wireless-prop-changed (state info)
- "Callback for when the network status changes."
- (when state
- (if (eq state 0)
- (setq enwc-wicd-current-ap ""
- enwc-wicd-current-nw-id nil)
- (setq enwc-wicd-current-ap (car (cadr info))
- enwc-wicd-current-nw-id (and info
- (nthcdr 3 info)
- (caar (nthcdr 3 info))
- (string-to-number (caar (nthcdr 3
info))))))))
-
-
-; ;;;;;;;;;;;;;;;;; ;
-; ;; Load/Unload ;; ;
-; ;;;;;;;;;;;;;;;;; ;
-
-(defun enwc-wicd-load ()
- "Load the Wicd backend."
- ;; Thanks to Michael Albinus for pointing out this signal.
- (setq enwc-wicd-end-scan-signal
- (dbus-register-signal :system
- enwc-wicd-dbus-service
- enwc-wicd-dbus-wireless-path
- enwc-wicd-dbus-wireless-interface
- "SendEndScanSignal"
- 'enwc-process-scan))
-
- (setq enwc-wicd-status-changed-signal
- (dbus-register-signal :system
- enwc-wicd-dbus-service
- "/org/wicd/daemon"
- enwc-wicd-dbus-service
- "StatusChanged"
- 'enwc-wicd-wireless-prop-changed)))
-
-(defun enwc-wicd-unload ()
- "Unload the Wicd back-end.
-
-Unregister all of the D-Bus signals set up during load."
- (dbus-unregister-object enwc-wicd-end-scan-signal)
- (dbus-unregister-object enwc-wicd-status-changed-signal))
-
-(defun enwc-wicd-can-load-p ()
- (dbus-ping :system enwc-wicd-dbus-service))
-
-(enwc-register-backend
- (make-enwc-backend
- :key 'enwc
- :can-load-p #'enwc-wicd-can-load-p
- :load #'enwc-wicd-load
- :unload #'enwc-wicd-unload
- :network-ids #'enwc-wicd-get-networks
- :scan #'enwc-wicd-scan
- :connect #'enwc-wicd-connect
- :disconnect #'enwc-wicd-disconnect
- :current-nw-id #'enwc-wicd-get-current-nw-id
- :is-connecting-p #'enwc-wicd-check-connecting
- :nw-props #'enwc-wicd-get-network-props
- :is-wired-p #'enwc-wicd-is-wired))
-
-(provide 'enwc-wicd)
-
-;;; enwc-wicd.el ends here.
diff --git a/packages/enwc/enwc.el b/packages/enwc/enwc.el
deleted file mode 100644
index 088f340..0000000
--- a/packages/enwc/enwc.el
+++ /dev/null
@@ -1,835 +0,0 @@
-;;; enwc.el --- The Emacs Network Client
-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
-
-;; Author: Ian Dunn <dunni@gnu.org>
-;; Keywords: external, network, wicd, manager, nm
-;; Version: 2.0
-;; Package-Requires: ((emacs "25.1"))
-;; Homepage: https://savannah.nongnu.org/p/enwc
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
-;; 02110-1301, USA.
-
-;;; Commentary:
-;;
-;; ENWC is the Emacs Network Client. It is designed to provide a front-end to
-;; various network managers, such as NetworkManager and Wicd.
-;;
-;; Currently, only NetworkManager and Wicd are supported, although experimental
-;; support exists for Connman.
-;;
-;; In order to use this package, add
-;;
-;; (setq enwc-default-backend BACKEND-SYMBOL)
-;;
-;; where BACKEND-SYMBOL is either 'wicd or 'nm, to your .emacs file (or other
init
-;; file).
-;;
-;; Then you can just run `enwc' to start everything.
-;;
-;; Example:
-;;
-;; (setq enwc-default-backend 'nm)
-
-;;; TODO:
-;;
-;; - Add hooks for scan completion, and possibly upon network connection.
-
-;;; Code:
-
-(require 'enwc-backend)
-
-(require 'tabulated-list)
-(require 'cl-lib)
-(require 'cl-macs)
-(require 'format-spec)
-
-(require 'map)
-(require 'seq)
-
-(defgroup enwc nil
- "*The Emacs Network Client"
- :prefix "enwc-"
- :group 'external)
-
-(defcustom enwc-wireless-device ""
- "The wireless device/interface to use for ENWC.
-
-If this is unset when `enwc-setup' is called, the user will be
-prompted for an interface."
- :group 'enwc
- :type 'string)
-
-(defcustom enwc-wired-device ""
- "The wired device/interface to use for ENWC.
-
-If this is unset when `enwc-setup' is called, the user will be
-prompted for an interface."
- :group 'enwc
- :type 'string)
-
-(defcustom enwc-display-mode-line t
- "Non-nil means display network information in the mode line.
-The specific information can be set using `enwc-mode-line-format'."
- :group 'enwc
- :type 'boolean)
-
-(defcustom enwc-enable-auto-scan-on-startup nil
- "Whether to enable auto-scan during `enwc-setup'.
-
-If non-nil, ENWC will automatically scan for networks every
-`enwc-auto-scan-interval' seconds.
-
-To enable auto-scan after startup, use `enwc-enable-auto-scan'."
- :group 'enwc
- :type 'boolean)
-
-(defvar enwc--auto-scan nil
- "Current state of auto-scan.
-
-To enable auto-scan, use `enwc-enable-auto-scan'.
-
-To enable auto-scan at startup, set
-`enwc-enable-auto-scan-on-startup'.")
-
-(defcustom enwc-auto-scan-interval 20
- "The interval between automatic scans.
-
-To make any changes to this variable take effect outside of the
-customization interface, use `enwc-restart-auto-scan'."
- :group 'enwc
- :type 'integer)
-
-(defcustom enwc-mode-line-format " [%s%%] "
- "The format for displaying information in the mode line.
-
-The following format specifiers display information about the
-current wireless connection:
-
-%s = signal strength
-
-%e = essid
-
-%b = bssid
-
-%n = encryption type
-
-%c = channel
-
-When a wired connection is active, signal strength is 100, essid
-and bssid are \"Wired\", and encryption and channel are \"None\".
-
-The following format specifiers are also significant:
-
-%% = A Normal '%'"
- :group 'enwc
- :type 'string)
-
-(defcustom enwc-warn-if-already-setup t
- "Whether to warn the user if ENWC is already setup when calling
`enwc-setup'."
- :group 'enwc
- :type 'boolean)
-
-(defcustom enwc-ask-to-save-interfaces t
- "Whether to ask about saving changes to the network interfaces during
`enwc-setup'."
- :group 'enwc
- :type 'boolean)
-
-(defvar enwc-display-string " [0%] "
- "The mode line display string.
-
-This is updated after every scan using `enwc-update-mode-line'.")
-
-(defun enwc--print-strength (s)
- "Convert signal strength S to a string to dispay."
- (format "%s%%" s))
-
-(defmacro enwc--make-number-sorter (n)
- `(lambda (a b)
- (let ((act-a (aref (nth 1 a) ,n))
- (act-b (aref (nth 1 b) ,n)))
- (< act-a act-b))))
-
-(defalias 'enwc--str-sorter (enwc--make-number-sorter 0))
-(defalias 'enwc--chnl-sorter (enwc--make-number-sorter 4))
-
-(cl-defstruct enwc-column-spec ()
- detail display sorter width conv)
-
-(defvar enwc-wireless-column-specs
- (list
- (make-enwc-column-spec
- :detail 'strength
- :display "Str"
- :sorter #'enwc--str-sorter
- :conv #'enwc--print-strength)
- (make-enwc-column-spec
- :detail 'essid
- :display "Essid"
- :sorter t
- :conv #'identity)
- (make-enwc-column-spec
- :detail 'encrypt
- :display "Encrypt"
- :sorter t
- :conv #'identity)
- (make-enwc-column-spec
- :detail 'bssid
- :display "Bssid"
- :sorter t
- :conv #'identity)
- (make-enwc-column-spec
- :detail 'channel
- :display "Channel"
- :sorter #'enwc--chnl-sorter
- :conv #'number-to-string)))
-
-(defvar enwc-wired-column-specs
- (list
- (make-enwc-column-spec
- :detail 'name
- :display "Profile"
- :sorter t
- :conv #'identity)))
-
-(defvar enwc-column-specs enwc-wireless-column-specs
- "Specifications for each column in the display.
-
-This should always be set to the value of either
-`enwc-wireless-column-specs' or `enwc-wired-column-specs'.")
-
-(defvar enwc--last-scan-results (make-hash-table :test #'equal)
- "The most recent scan results.
-
-This will be an association list of the form:
-
-((ID . ((strength . STRENGTH) (essid . ESSID) ...)) ...)
-
-The form will be different when wired is enabled (see
-`enwc-using-wired'). This will have the form:
-
-((ID . ((name . PROFILE-NAME))) ...)
-
-Each ID is a backend-specific network ID.
-
-Each key in the children association lists corresponds to an entry in
-`enwc-column-specs'.")
-
-(defvar enwc-access-points nil
- "The most recent access point list.")
-
-(defvar enwc-using-wired nil
- "Non-nil means ENWC is using wired connections.
-
-Note that this is NOT the same as `enwc-is-wired-p'. This
-variable indicates whether ENWC itself is in wired mode.")
-
-(defvar enwc-edit-id nil
- "This is the network id of the network being edited.")
-
-(defvar enwc-scan-requested nil
- "This is non-nil when a scan has been requested.
-This is used so as to avoid multiple updates of the scan data.")
-
-(defvar enwc-scan-interactive nil
- "This is non-nil that a scan was interactively requested.
-This is only used internally.")
-
-(defvar enwc-scan-timer nil
- "The timer for automatic scanning.")
-
-(make-local-variable 'enwc-edit-id)
-
-;; The Faces
-
-(defface enwc-header
- '((((class color) (background light))
- (:foreground "Blue"))
- (((class color) (background dark))
- (:foreground "Blue"))
- (t (:background "Blue")))
- "The face for the headers."
- :group 'enwc)
-
-(defface enwc-connected
- '((((class color) (background dark))
- (:foreground "Green"))
- (((class color) (background light))
- (:foreground "Green"))
- (t (:background "Green")))
- "The face for the connected network."
- :group 'enwc)
-
-;;;;;;;;;;;;;;;;;;;;
-;; ENWC functions ;;
-;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-get-networks ()
- "Get the identifiers for the access points
-from a previous scan."
- (enwc--network-ids enwc--current-backend enwc-using-wired))
-
-(defun enwc-request-scan ()
- "Request a backend scan."
- (setq enwc-scan-requested t)
- (enwc--scan enwc--current-backend))
-
-(defun enwc-connect (id)
- "Connect to network with id ID.
-
-ID is specific to the backend."
- (enwc--connect enwc--current-backend id enwc-using-wired))
-
-(defun enwc-disconnect ()
- "Disconnect from the current network."
- (enwc--disconnect enwc--current-backend enwc-using-wired))
-
-(defun enwc-get-current-nw-id ()
- "Get the id of the current network id,
-or nil if there isn't one.
-
-The returned id is specific to the backend."
- (enwc--current-nw-id enwc--current-backend enwc-using-wired))
-
-(defun enwc-check-connecting-p ()
- "Check to see if there is a connection in progress.
-Returns `non-nil' if there is one, nil otherwise."
- (enwc--is-connecting-p enwc--current-backend))
-
-(defun enwc-get-nw-props (id)
- "Get the network properties of the wireless network with id ID.
-This will return an associative list with the keys
-corresponding to `enwc-column-specs'.
-
-ID is specific to the backend."
- (enwc--nw-props enwc--current-backend id enwc-using-wired))
-
-(defun enwc-is-wired-p ()
- "Check whether or not ENWC is connected to a wired network.
-Note that this is NOT the same as `enwc-using-wired'.
-This checks for an active wired connection."
- (enwc--is-wired-p enwc--current-backend))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;; Actual Functions ;;
-;;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-connected-to-network-p ()
- (enwc-is-valid-nw-id-p (enwc-get-current-nw-id)))
-
-(defun enwc-is-valid-nw-id-p (id)
- "Confirm that ID is a valid network id."
- (and id (not (eq id 'wired))))
-
-(defun enwc-value-from-scan (detail &optional id)
- "Retrieve a value for DETAIL from `enwc--last-scan-results'.
-If ID is specified, then it will get the entry for ID.
-Otherwise, ID is set to the current network ID.
-
-If DETAIL is not found in `enwc--last-scan-results', then return nil."
- (setq id (or id (enwc-get-current-nw-id)))
- (when enwc--last-scan-results
- (map-nested-elt enwc--last-scan-results `(,id ,detail))))
-
-(defun enwc-make-format-spec ()
- "Create a format specification for the mode line string."
- ;; Variables here are cached to avoid latencies when communicating with
D-Bus.
- (let* ((cur-id (enwc-get-current-nw-id))
- (wiredp (enwc-is-wired-p))
- (no-last (not enwc--last-scan-results))
- (invalid-id (not (enwc-is-valid-nw-id-p cur-id)))
- (connectingp (enwc-check-connecting-p)))
- (format-spec-make ?s (cond
- (wiredp "100")
- ((or invalid-id no-last) "0")
- (connectingp "*")
- (t (enwc-value-from-scan 'strength cur-id)))
- ?e (cond
- (wiredp "Wired")
- ((or invalid-id connectingp no-last) "None")
- (t (enwc-value-from-scan 'essid cur-id)))
- ?b (cond
- (wiredp "Wired")
- ((or invalid-id connectingp no-last) "none")
- (t (enwc-value-from-scan 'bssid cur-id)))
- ?n (cond
- (wiredp "None")
- ((or invalid-id connectingp no-last) "None")
- (t (enwc-value-from-scan 'encrypt cur-id)))
- ?c (cond
- (wiredp "None")
- ((or invalid-id connectingp no-last) "None")
- (t (enwc-value-from-scan 'channel cur-id)))
- ?% "%")))
-
-(defun enwc-format-mode-line-string ()
- "Format the mode line string.
-This is derived from `enwc-mode-line-format'.
-See the documentation for it for more details."
- (format-spec enwc-mode-line-format (enwc-make-format-spec)))
-
-(defun enwc-update-mode-line ()
- "Update the mode line display.
-This uses the format specified by `enwc-mode-line-format'.
-This is initiated during setup, and runs once every second."
- (when enwc-display-mode-line
- (setq enwc-display-string (enwc-format-mode-line-string))
- (force-mode-line-update)))
-
-(defun enwc-enable-display-mode-line ()
- "Enable the mode line display."
- (interactive)
- (or global-mode-string (setq global-mode-string '("")))
- (setq enwc-display-mode-line t)
- (unless (member 'enwc-display-string global-mode-string)
- (setq global-mode-string (append global-mode-string
'(enwc-display-string))))
- (message "ENWC mode line enabled"))
-
-(defun enwc-disable-display-mode-line ()
- "Disable the mode line display."
- (interactive)
- (or global-mode-string (setq global-mode-string '("")))
- (setq enwc-display-mode-line nil)
- (setq global-mode-string (remove 'enwc-display-string global-mode-string))
- (message "ENWC mode line disabled"))
-
-(defun enwc-toggle-display-mode-line ()
- "Toggles the mode line display."
- (interactive)
- (if (not enwc-display-mode-line)
- (enwc-enable-display-mode-line)
- (enwc-disable-display-mode-line)))
-
-(defun enwc-enable-auto-scan ()
- "Enable auto scanning."
- (interactive)
- (if (or (not (numberp enwc-auto-scan-interval))
- (< enwc-auto-scan-interval 0))
- (message "Unable to start ENWC auto-scan with invalid scan \
-interval - Got %s, but need positive number" enwc-auto-scan-interval)
- (unless enwc-scan-timer
- (setq enwc-scan-timer
- (run-at-time t enwc-auto-scan-interval 'enwc-scan t)))
- (setq enwc--auto-scan t)
- (message "Auto-scan enabled")))
-
-(defun enwc-disable-auto-scan ()
- "Disable auto scanning."
- (interactive)
- (when enwc-scan-timer (cancel-timer enwc-scan-timer))
- (setq enwc--auto-scan nil)
- (message "Auto scan disabled"))
-
-(defun enwc-toggle-auto-scan ()
- "Toggles automatic scanning.
-This will use the current value of `enwc-auto-scan-interval'."
- (interactive)
- (if enwc--auto-scan
- (enwc-disable-auto-scan)
- (enwc-enable-auto-scan)))
-
-(defun enwc-restart-auto-scan ()
- "Restart automatic scanning."
- (interactive)
- (enwc-disable-auto-scan)
- (enwc-enable-auto-scan))
-
-;;;;;;;;;;;;;;;;;;;
-;; Scan internal ;;
-;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-scan (&optional nodisp)
- "The frontend of the scanning routine.
-Set up and move to the ENWC buffer if necessary, and scan and display the
- networks. If NODISP is `non-nil', then do not display the results in the ENWC
-buffer."
- (interactive)
- (unless nodisp
- (setq enwc-scan-interactive t)
- (enwc-ensure-buffer))
- (with-current-buffer "*ENWC*"
- (enwc-scan-internal)))
-
-(defun enwc-scan-internal ()
- "The entry point for the internal scan routines.
-This checks whether or not wired is being used, and runs the appropriate
-function.
-
-If wireless is used, a scan is requested. All back-ends must
-call `enwc-process-scan' in some way upon completion of a
-wireless scan.
-
-A wired scan displays the available wired profiles."
- (when enwc-scan-interactive
- (message "Scanning..."))
-
- (if enwc-using-wired
- (enwc-process-scan)
- (enwc-request-scan)))
-
-(defun enwc--update-scan-results ()
- (setq enwc--last-scan-results (make-hash-table :test #'equal))
- (dolist (ap (enwc-get-networks))
- (puthash ap (enwc-get-nw-props ap) enwc--last-scan-results)))
-
-(defun enwc-redisplay-networks ()
- (interactive)
- (enwc--update-scan-results)
- (enwc-display-networks enwc--last-scan-results)
- (enwc-update-mode-line))
-
-(defun enwc-process-scan (&rest args)
- "The scanning callback.
-After a scan has been performed, this processes and displays the scan results.
-
-ARGS is only for compatibility with the calling function."
- (when enwc-scan-requested
- (setq enwc-scan-requested nil)
- (when enwc-scan-interactive
- (message "Scanning... Done"))
- (enwc-redisplay-networks)
- (setq enwc-scan-interactive nil)))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;; Display Networks ;;
-;;;;;;;;;;;;;;;;;;;;;;
-
-(cl-defun enwc-refresh-widths (&optional (networks enwc--last-scan-results))
- "Refresh the column widths for display."
- (setq enwc-column-specs
- (mapcar
- (lambda (spec)
- (pcase-let* (((cl-struct enwc-column-spec detail display conv) spec)
- (new-max (if (mapp networks)
- (seq-max
- (map-apply
- (lambda (id nw)
- (length (funcall conv (alist-get
detail nw))))
- networks))
- 0))
- (min-width (+ (length display) 2)))
- (setf (enwc-column-spec-width spec) (max new-max min-width)))
- spec)
- enwc-column-specs)))
-
-(defun enwc--get-details (network-entry)
- (mapcar
- (lambda (detail)
- (alist-get (enwc-column-spec-detail detail) network-entry))
- enwc-column-specs))
-
-(defun enwc--tabulated-list-entries ()
- (map-apply
- (lambda (id nw) (list id (vconcat (enwc--get-details nw))))
- enwc--last-scan-results))
-
-(defun enwc--tabulated-list-printer (id cols)
- "Print the row ID with column values COL."
- (let ((cur-id (enwc-get-current-nw-id)))
- (tabulated-list-print-entry
- id
- (vconcat
- (seq-map-indexed
- (lambda (col idx)
- (let* ((detail (nth idx enwc-column-specs))
- (conv (funcall (enwc-column-spec-conv detail) col)))
- (if (equal cur-id id)
- (propertize conv 'font-lock-face 'enwc-connected)
- conv)))
- cols)))))
-
-(defun enwc-display-networks (networks)
- "Displays the network in NETWORKS.
-This is an entry to the display functions, and checks whether or not ENWC is
- using wired."
- (enwc-ensure-buffer)
- ;; Update the display widths.
- (enwc-refresh-widths)
- (with-current-buffer (get-buffer "*ENWC*")
- (setq tabulated-list-format
- (vconcat
- (mapcar
- (pcase-lambda ((cl-struct enwc-column-spec display width sorter))
- (list display width sorter))
- enwc-column-specs)))
- (setq tabulated-list-entries #'enwc--tabulated-list-entries)
- (setq tabulated-list-printer #'enwc--tabulated-list-printer)
-
- (tabulated-list-init-header)
- (tabulated-list-print)))
-
-(defun enwc-find-network (essid &optional networks)
- "Checks through NETWORKS for the network with essid ESSID,
-and returns the network identifier. Uses `enwc--last-scan-results' if
-NETWORKS is nil. If the network is not found, then it returns nil.
-
- When called interactively, this only prints out what it finds.
-Otherwise, it actually returns it."
- (interactive "sNetwork ESSID: ")
- ;; TODO: Fix this for wired networks
- (when enwc-using-wired
- (error "Can't find wireless networks while on wired."))
- (unless (or networks enwc--last-scan-results)
- (setq enwc-scan-interactive nil)
- (enwc-scan-internal))
- (let ((nets (or networks enwc--last-scan-results))
- need-break cur-net)
- (while (and nets (not cur-net))
- (setq cur-net (pop nets))
- (unless (string-equal (alist-get 'essid (cdr-safe cur-net))
- essid)
- (setq cur-net nil)))
- (if cur-net
- (if (called-interactively-p 'any)
- (message "Network %d has essid %s" (number-to-string (car
cur-net)) essid)
- (car cur-net))
- (when (called-interactively-p 'any)
- (message "Network not found.")))))
-
-;;;;;;;;;;;;;;;;;;;;;
-;; Connect Network ;;
-;;;;;;;;;;;;;;;;;;;;;
-
-(defun enwc-connect-network (id)
- "Connect to network with id ID.
-This is an entry point for the internal connection functions,
-and checks whether or not ENWC is using wired."
- (enwc-connect id)
- (let ((name-sym (if enwc-using-wired 'name 'essid)))
- (when enwc--last-scan-results
- (enwc-value-from-scan name-sym id))))
-
-(defun enwc-connect-to-network (net-id)
- "Connect the the network with network id NET-ID.
-Confirms that NET-ID is a valid network id.
-This calls `enwc-connect-network' as a subroutine."
- (interactive "sNetwork ID: ")
- (let (cur-net)
- (unless (enwc-is-valid-nw-id-p net-id)
- (error "Invalid network id."))
- (setq cur-net (enwc-connect-network net-id))
- (message "Connecting to %s" cur-net)))
-
-(defun enwc-connect-to-network-essid (essid)
- "Connect to the network with essid ESSID."
- (interactive "sNetwork ESSID: ")
- (let ((net-id (enwc-find-network essid)))
- (if net-id
- (enwc-connect-to-network net-id)
- (message "Network not found."))))
-
-(defun enwc-connect-to-network-at-point ()
- "Connect to the network at the current line number.
-Moves to the enwc buffer if necessary."
- (interactive)
- (unless (eq major-mode 'enwc-mode)
- (enwc-setup-buffer))
- (enwc-connect-to-network (tabulated-list-get-id)))
-
-(defun enwc-disconnect-network ()
- "Disconnect from the network, if any."
- (interactive)
- (message "Disconnecting")
- (enwc-disconnect))
-
-
-
-(defun enwc-enable-wired ()
- (setq enwc-using-wired t)
- (setq enwc-column-specs enwc-wired-column-specs)
- (setq tabulated-list-sort-key nil))
-
-(defun enwc-enable-wireless ()
- (setq enwc-using-wired nil)
- (setq enwc-column-specs enwc-wireless-column-specs)
- (setq tabulated-list-sort-key nil))
-
-(defun enwc-toggle-wired ()
- "Toggle the display and mode between wireless and wired.
-This has the side-effect of setting the variable
-`enwc-using-wired', and calling a scan.
-
-In lisp code, calling `enwc-enable-wired' or
-`enwc-enable-wireless' will directly set the wired state, rather
-than just toggling it."
- (interactive)
- (unless (eq major-mode 'enwc-mode)
- (enwc-setup-buffer))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (if enwc-using-wired
- (enwc-enable-wireless)
- (enwc-enable-wired))
- (enwc-scan)))
-
-
-
-(defcustom enwc-interface-list-function 'enwc--ip-interface-list
- "Function to use to collect network interfaces.
-
-ENWC comes with two functions for this purpose:
-
- - enwc--ip-interface-list: Use ip to determine the network interfaces
-
- - enwc--ifconfig-interface-list: Use ifconfig to determine the network
interfaces
-
-This must be a function of no arguments that returns a list of
-strings. Each element of the returned list should be a network
-interface, i.e. lo or eth0."
- :group 'enwc
- :type 'function)
-
-(defun enwc--ip-interface-list ()
- "Use `ip' to get a list of network interfaces."
- (let ((interfaces))
- (with-temp-buffer
- (call-process "ip" nil t nil "link")
- (goto-char (point-min))
- (while (re-search-forward "^[0-9]+:\s-*\\([[:alnum:]]+\\):" nil t)
- (push (match-string 1) interfaces)))
- (nreverse interfaces)))
-
-(defun enwc--ifconfig-interface-list ()
- "Use `ifconfig' to get a list of network interfaces."
- (let ((interfaces))
- (with-temp-buffer
- (call-process "ifconfig" nil t nil "-a")
- (goto-char (point-min))
- (while (re-search-forward "^\\([[:alnum:]]+\\):" nil t)
- (push (match-string 1) interfaces)))
- (nreverse interfaces)))
-
-(defun enwc--select-interfaces ()
- "Collect a list of network interfaces and prompt the user to select two.
-
-One interface will be used for wireless, and the other for wired.
-
-There is no need to call this function manually; that should be
-left to `enwc-setup'. Instead, set `enwc-wireless-device' and
-`enwc-wired-device'."
- (let ((interfaces (funcall enwc-interface-list-function))
- changed)
- (when (string-empty-p enwc-wired-device)
- (setq enwc-wired-device (completing-read "Wired Interface: " interfaces))
- (setq changed t))
- (when (string-empty-p enwc-wireless-device)
- (setq enwc-wireless-device (completing-read "Wireless Interface: "
interfaces))
- (setq changed t))
- (when (and changed
- enwc-ask-to-save-interfaces
- (y-or-n-p "Network Interfaces changed. Save for future
sessions? "))
- (customize-save-variable 'enwc-wired-device enwc-wired-device)
- (customize-save-variable 'enwc-wireless-device enwc-wireless-device))))
-
-(defvar enwc-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "R") 'enwc-scan)
- (define-key map (kbd "C") 'enwc-connect-to-network-essid)
- (define-key map (kbd "D") 'enwc-disconnect-network)
- (define-key map (kbd "W") 'enwc-toggle-wired)
- ;; (define-key map (kbd "E") 'enwc-edit-entry-at-point)
- (define-key map (kbd "RET") 'enwc-connect-to-network-at-point)
- map)
- "The keymap for network display in ENWC.")
-
-(define-derived-mode enwc-mode tabulated-list-mode "enwc"
- "Mode for working with network connections.
-\\{enwc-mode-map}"
- (add-hook 'tabulated-list-revert-hook 'enwc-redisplay-networks nil t))
-
-(defun enwc-setup-buffer (&optional nomove)
- "Sets up the ENWC buffer.
-This first checks to see that it exists,
-and if it doesn't, then create it.
-
-If NOMOVE is non-nil, then do not move to the
-newly created buffer."
- (unless (get-buffer "*ENWC*")
- (with-current-buffer (get-buffer-create "*ENWC*")
- (enwc-mode)))
- (unless nomove
- (switch-to-buffer "*ENWC*")))
-
-(defun enwc-ensure-buffer ()
- (unless (get-buffer "*ENWC*")
- (enwc-setup-buffer t)))
-
-;; Setup is broken into four functions to ease testing. This allows developers
-;; to test each one individually without worrying about the side effects of
-;; others
-
-(defun enwc--setup-select-interfaces ()
- (when (or (string-empty-p enwc-wired-device)
- (string-empty-p enwc-wireless-device))
- (enwc--select-interfaces)))
-
-(defun enwc--setup-load-default-backend ()
- (enwc-load-default-backend enwc-force-backend-loading))
-
-(defun enwc--setup-display-mode-line ()
- (when enwc-display-mode-line
- (enwc-enable-display-mode-line)))
-
-(defun enwc--setup-auto-scan ()
- (when enwc-enable-auto-scan-on-startup
- (enwc-enable-auto-scan)))
-
-(defvar enwc--setup-done nil
- "Non-nil if enwc has already been set up.")
-
-(defun enwc-setup ()
- "Set up ENWC.
-
-If `enwc-wired-device' or `enwc-wireless-device' is empty, prompt
-the user to set them from a list of interfaces.
-
-Load the default backend, forcing it if
-`enwc-force-backend-loading' is non-nil.
-
-If `enwc-display-mode-line' is non-nil, enable the mode line.
-
-If `enwc-enable-auto-scan-on-startup' is non-nil, start the
-auto-scan timer."
- (cond
- ((and enwc--setup-done enwc-warn-if-already-setup)
- (message "ENWC is already setup."))
- (enwc--setup-done t)
- (t
- (enwc--setup-select-interfaces)
- (enwc--setup-load-default-backend)
- (enwc--setup-display-mode-line)
- (enwc--setup-auto-scan)
-
- (setq enwc--setup-done t))))
-
-;;;###autoload
-(defun enwc ()
- "The main front-end to ENWC.
-This sets up the buffer and scans for networks.
-In order to use this, one must have already run
-`enwc-setup'.
-
-\\{enwc-mode-map}"
- (interactive)
- (enwc-setup)
- (enwc-setup-buffer)
- (enwc-scan))
-
-(provide 'enwc)
-
-;;; enwc.el ends here
diff --git a/packages/gnorb/.elpaignore b/packages/gnorb/.elpaignore
deleted file mode 100644
index f614ef7..0000000
--- a/packages/gnorb/.elpaignore
+++ /dev/null
@@ -1 +0,0 @@
-gnorb.org
\ No newline at end of file
diff --git a/packages/gnorb/.gitignore b/packages/gnorb/.gitignore
deleted file mode 100644
index c8ea459..0000000
--- a/packages/gnorb/.gitignore
+++ /dev/null
@@ -1,5 +0,0 @@
-*.elc
-notes.org
-gnorb-pkg.el
-gnorb-autoloads.el
-TAGS
diff --git a/packages/gnorb/NEWS b/packages/gnorb/NEWS
deleted file mode 100644
index feca7da..0000000
--- a/packages/gnorb/NEWS
+++ /dev/null
@@ -1,47 +0,0 @@
-GNU Emacs Gnorb NEWS -- history of user-visible changes. -*- org -*-
-
-* Version 1.2 [2017-03-21 Tue]
-** Add `gnorb-install-defaults'
-New command for installing sane default bindings.
-* Version 1.1.3 [2017-03-12 Sun]
-** Provide a better interface for trigger action selection
-New function `gnorb-select-from-list' providing a nicer interface for
-choosing items from a list.
-** Change to format of gnorb-org-trigger-actions
-Due to previous item, this custom option has changed format, see
-docstring for details.
-** Compatibility with newest BBDB
-Updates to match newest version of BBDB in package repos (mostly with
-regard to displaying multi-line field values, BBDB is now
-lexically bound).
-** Many compiler fixes, and lexical binding
-Move to lexical binding.
-* Version 1.1.0 [2015-04-23 Thu]
-** New trigger actions
-Two new trigger actions allow you to capture a new sibling or child
-heading relative to the heading you're triggering.
-** Persistent Gnorb groups
-Give a prefix argument to `gnorb-org-view' to create a named,
-persistent group containing tracked headings.
-** Gnorb registry usage reports
-Call `gnorb-report-tracking-usage' to see how much of the Gnus
-registry Gnorb is occupying, and run cleaning routines.
-* Version 1.0.1 [2014-10-22 Wed]
-** Deleting associations
-It's now possible to delete associations between messages and
-headings; the user is also prompted to do this at a few points.
-** Link following
-Following links to messages is a little more clever, and will re-use
-existing windows/frames when possible.
-** Cleanups/Bugfixes
-Proper autoloads, addressing compiler warnings, better chain of
-requires, bugfixes.
-* Version 1 [2014-10-07 Tue]
-** First Elpa Version
-** Email Tracking
-The mechanism for email tracking has changed since Gnorb was made
-available on Elpa. See the manual for set-up instructions.
-** Directory Structure
-The directory structure has changed since Gnorb was made available on
-Elpa. There is no longer a lisp/ directory -- all *.el files are now
-at the top level.
diff --git a/packages/gnorb/README.org b/packages/gnorb/README.org
deleted file mode 100644
index 5ba6e76..0000000
--- a/packages/gnorb/README.org
+++ /dev/null
@@ -1,116 +0,0 @@
-* Gnorb
-
-Glue code between the Gnus, Org, and BBDB packages for Emacs.
-
-This package connects Emacs-based email, project management, and
-contact management a little more closely together. The goal is to
-reduce friction when manipulating TODOs, contacts, messages, and
-files.
-
-Probably the most interesting thing Gnorb does is tracking
-correspondences between Gnus email messages and Org headings. Rather
-than "turning your inbox into a TODO list", as some software puts it,
-Gnorb (kind of) does the opposite: turning your TODO headings into
-mini mailboxes. See the Info manual for details.
-
-*Note for previous users*: If you were using Gnorb from Github before
-it shifted to the Elpa repository, the email tracking mechanism has
-changed, please see the manual for details.
-** Known bugs/issues
-*** Gnus Registry
-Prior to late December, 2014, the Gnus registry had some issues with
-preserving "precious" entries while pruning.
-
-When the registry approaches its maximum size it will delete excess
-entries, a process referred to as "pruning". "Precious" entries are
-those that contain important information: they should not be pruned.
-
-Gnorb uses the registry to track associations between messages and Org
-headings, and marks those entries as precious. The entire process of
-tracking, in fact, relies on these entries being preserved, and Gnorb
-goes to some lengths to protect this information. Older versions of
-the registry could nevertheless delete those entries.
-
-These issues are fixed circa the end of December, 2014, around "Ma
-Gnus v0.12", whatever that means. If you think there's a possibility
-your registry is full, and associations are being deleted, you might
-consider upgrading to a recent Gnus.
-*** Multiple Associations
-Gnorb theoretically supports email messages being associated with
-multiple Org headings. In practice, however, this situation hasn't
-been thought through completely, and you may experience weirdness. If
-you do, and you have some ideas about how it should be handled, please
-contact the author and suggest them.
-** Installation
-
-Gnorb is developed inside the Elpa repository -- install with M-x
-package-install RET gnorb RET. There is a
[[https://github.com/girzel/gnorb/][Github repository]], but the
-code there is stale as of March 2017. Any issues opened there will be
-addressed, though obviously pull requests won't work. Prefer
-submitting bugs via `emacs-report-bug'.
-
-** Roadmap
-*** More fully utilize nngnorb
-Instead of just being place to put nnir searches, the nngnorb server
-should have groups in its own right. Users will still be able to make
-ephemeral search groups if they like, but they'll also have the option
-of creating regular Gnus groups that track certain Org subtrees. These
-groups will be persistent, and they will auto-update, so it's possible
-to handle more TODO stuff from the Gnus group buffer. Copying a
-message into the group will set up tracking for the message; deleting
-it from the group will remove tracking.
-*** Comprehensive views of related information
-For instance, A `gnorb-view' command that takes a tags-todo search
-phrase (or a single Org heading ID), finds all relevant messages, Org
-headings, and BBDB records, and sets up a four-pane view: Org Agenda,
-BBDB buffer, Gnus Summary buffer, and Gnus Article buffer.
-
-Or something like that -- more pondering is necessary.
-*** Consider consolidating posting styles, personas, etc
-There are many solutions out there for setting up "personas" in Gnus
-or elsewhere: wrappers for mail composition and reply that create
-certain identities by setting variables and mail headers.
-
-Do we need another one? Gnorb seems so well placed for this sort of
-thing: we've already got bbdb-posting-styles, and allowing further
-configuration based on, say, the Org tags of the subtree we're
-composing messages from... Or maybe it's just a case of NIH.
-** To do list
-*** TODO Agenda date-span message search
-Provide an Org Agenda command that does an email search for messages
-received in the visible date span, or day under point, etc. Make it
-work in the calendar, as well?
-*** TODO Collect BBDB messages by thread
-At present, when you collect message links on a BBDB contact, each
-message is a separate link. If you have lengthy conversations with
-this contact, you'll get a whole bunch of links with the same summary:
-not very useful. Provide an option to collect one /thread/ per link:
-each link represents the top-level message in the thread, and
-following the link opens a Summary buffer where the whole thread is
-visible.
-*** TODO Automatic org-tagging for BBDB contacts
-When messages from a contact are associated with an Org heading, make
-it possible for the contact to inherit that heading's tags
-automatically.
-*** TODO gnorb-bbdb-view
-Provide a `gnorb-bbdb-view' command that opens a Summary buffer
-containing all the tracked messages from the contact(s) under point.
-*** DONE Gnus message tagging
-:LOGBOOK:
-- State "DONE" from "TODO" [2017-12-09 Sat 17:23]
-:END:
-Allow tagging of Gnus messages, by giving the message's registry entry
-an 'org-tags key.
-*** DONE Email subtree export to doc and rtf
-:LOGBOOK:
-- State "DONE" from "TODO" [2017-03-11 Sat 12:35]
-:END:
-When using `gnorb-email-subtree', provide built-in options for
-exporting to doc and rtf attachments; these are such commonly-needed
-formats. Do the odt conversion automatically.
-*** DONE Capture to child/subtree trigger actions
-:LOGBOOK:
-- State "DONE" from "TODO" [2015-03-17 Tue 17:42]
-:END:
-Add trigger actions that create new sibling or child headings on the
-original Org heading.
diff --git a/packages/gnorb/dir b/packages/gnorb/dir
deleted file mode 100644
index b0d0ad6..0000000
--- a/packages/gnorb/dir
+++ /dev/null
@@ -1,18 +0,0 @@
-This is the file .../info/dir, which contains the
-topmost node of the Info hierarchy, called (dir)Top.
-The first time you invoke Info you start off looking at this node.
-
-File: dir, Node: Top This is the top of the INFO tree
-
- This (the Directory node) gives a menu of major topics.
- Typing "q" exits, "?" lists all Info commands, "d" returns here,
- "h" gives a primer for first-timers,
- "mEmacs<Return>" visits the Emacs manual, etc.
-
- In Emacs, you can click mouse button 2 on a menu item or cross reference
- to select it.
-
-* Menu:
-
-Emacs
-* Gnorb: (gnorb). Glue code for Gnus, Org, and BBDB.
diff --git a/packages/gnorb/gnorb-bbdb.el b/packages/gnorb/gnorb-bbdb.el
deleted file mode 100644
index e961152..0000000
--- a/packages/gnorb/gnorb-bbdb.el
+++ /dev/null
@@ -1,637 +0,0 @@
-;;; gnorb-bbdb.el --- The BBDB-centric functions of gnorb -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
-
-;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
-
-;; 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:
-
-;; The Gnorb package has no hard dependency on BBDB, so you'll have to
-;; install it manually. Gnorb is compatible with whichever version of
-;; BBDB is current in the Emacs package manager. I believe it comes
-;; from Melpa.
-
-;;; Code:
-
-;; Don't explicity require BBDB libraries. BBDB is the "weakest leg"
-;; of the Gnorb tripod: it has the least functionality, and many
-;; people are using Gnorb without BBDB. So don't require, only
-;; autoload.
-
-;; (require 'bbdb)
-;; (require 'bbdb-com)
-;; (require 'bbdb-mua)
-
-(autoload 'bbdb-do-records "bbdb-com")
-(autoload 'bbdb-completing-read-record "bbdb-com")
-(autoload 'bbdb-current-record "bbdb")
-
-(defvar bbdb-buffer-name)
-(defvar bbdb-separator-alist)
-(defvar bbdb-crm-local-completion-map)
-
-(require 'gnorb-utils)
-(require 'cl-lib)
-
-(defgroup gnorb-bbdb nil
- "The BBDB bits of gnorb."
- :tag "Gnorb BBDB"
- :group 'gnorb)
-
-(defcustom gnorb-bbdb-org-tag-field 'org-tags
- "The name (as a symbol) of the field to use for org tags."
- :type 'symbol)
-
-(when (boundp 'bbdb-separator-alist) ;Allow compilation if BBDB is absent!
- (unless (assoc gnorb-bbdb-org-tag-field bbdb-separator-alist)
- (push `(,gnorb-bbdb-org-tag-field ":" ":") bbdb-separator-alist)))
-
-(defcustom gnorb-bbdb-messages-field 'messages
- "The name (as a symbol) of the field where links to recent gnus
-messages from this record are stored.
-
-\\<bbdb-mode-map>Records that do not have this field defined
-will not collect links to messages: you have to call
-\"\\[gnorb-bbdb-open-link]\" on the record once -- after that,
-message links will be collected and updated automatically."
- :type 'symbol)
-
-(defcustom gnorb-bbdb-collect-N-messages 5
- "For records with a `gnorb-bbdb-messages-field' defined,
-collect links to a maximum of this many messages."
- :type 'integer)
-
-(defcustom gnorb-bbdb-define-recent 'seen
- "For records with a `gnorb-bbdb-message-tag-field' defined,
-this variable controls how gnorb defines a \"recent\" message.
-Setting it to the symbol seen will collect the messages most
-recently opened and viewed. The symbol received means gnorb will
-collect the most recent messages by Date header.
-
-In other words, if this variable is set to `received', and a
-record's messages field is already full of recently-received
-messages, opening a five-year-old message (for instance) from
-this record will not push a link to the message into the field."
- :type '(choice (const :tag "Most recently seen" 'seen)
- (const :tag "Most recently received" 'received)))
-
-(defcustom gnorb-bbdb-message-link-format-multi "%:count. %D: %:subject"
- "How a single message is formatted in the list of recent messages.
-This format string is used in multi-line record display.
-
-Available information for each message includes the subject, the
-date, and the message's count in the list, as an integer. You can
-access subject and count using the %:subject and %:count escapes.
-The message date can be formatted using any of the escapes
-mentioned in the docstring of `format-time-string', which see."
- :type 'string)
-
-(defcustom gnorb-bbdb-message-link-format-one "%:count"
- "How a single message is formatted in the list of recent messages.
-This format string is used in single-line display -- note that by
-default, no user-created xfields are displayed in the `one-line'
-layout found in `bbdb-layout-alist'. If you want this field to
-appear there, put its name in the \"order\" list of the `one-line'
-layout.
-
-Available information for each message includes the subject, the
-date, and the message's count in the list, as an integer. You can
-access subject and count using the %:subject and %:count escapes.
-The message date can be formatted using any of the escapes
-mentioned in the docstring of `format-time-string', which see."
- :type 'string)
-
-(defface gnorb-bbdb-link '((t :inherit org-link))
- "Custom face for displaying message links in the *BBDB* buffer.
- Defaults to org-link.")
-
-(cl-defstruct gnorb-bbdb-link
- subject date group id)
-
-(defcustom gnorb-bbdb-posting-styles nil
- "An alist of styles to use when composing messages to the BBDB
-record(s) under point. This is entirely analogous to
-`gnus-posting-styles', it simply works by examining record fields
-rather than group names.
-
-When composing a message to multiple contacts (using the \"*\"
-prefix), the records will be scanned in order, with the record
-initially under point (if any) set aside for last. That means
-that, in the case of conflicting styles, the record under point
-will override the others.
-
-In order not to be too intrusive, this option has no effect on
-the usual `bbdb-mail' command. Instead, the wrapper command
-`gnorb-bbdb-mail' is provided, which consults this option and
-then hands off to `bbdb-compose-mail'. If you'd always like to
-use `gnorb-bbdb-mail', you can simply bind it to \"m\" in the
-`bbdb-mode-map'.
-
-The value of the option should be a list of sexps, each one
-matching a single field. The first element should match a field
-name: one of the built-in fields like lastname, or an xfield.
-Field names should be given as symbols.
-
-The second element is a regexp used to match against the value of
-the field (non-string field values will be cast to strings, if
-possible). It can also be a cons of two strings, the first of
-which matches the field label, the second the field value.
-
-Alternately, the first element can be the name of a custom
-function that is called with the record as its only argument, and
-returns either t or nil. In this case, the second element of the
-list is disregarded.
-
-All following elements should be field setters for the message to
-be composed, just as in `gnus-posting-styles'."
- :type 'list)
-
-(when (fboundp 'bbdb-record-xfield-string)
- (defalias (intern (format "bbdb-read-xfield-%s"
- gnorb-bbdb-org-tag-field))
- (lambda (&optional init)
- (gnorb-bbdb-read-org-tags init)))
-
- (defalias (intern (format "bbdb-display-%s-multi-line"
- gnorb-bbdb-org-tag-field))
- (lambda (record indent)
- (gnorb-bbdb-display-org-tags record indent))))
-
-(defun gnorb-bbdb-read-org-tags (&optional init)
- "Read Org mode tags, with `completing-read-multiple'."
- (if (string< "24.3" (substring emacs-version 0 4))
- (let ((crm-separator
- (concat "[ \t\n]*"
- (cadr (assq gnorb-bbdb-org-tag-field
- bbdb-separator-alist))
- "[ \t\n]*"))
- (crm-local-completion-map bbdb-crm-local-completion-map)
- (table (cl-mapcar #'car
- (org-global-tags-completion-table
- (org-agenda-files))))
- (init (if (consp init)
- (apply #'bbdb-concat (nth 2 (assq gnorb-bbdb-org-tag-field
- bbdb-separator-alist))
- init)
- init)))
- (completing-read-multiple
- "Tags: " table
- nil nil init))
- (bbdb-split gnorb-bbdb-org-tag-field
- (bbdb-read-string "Tags: " init))))
-
-(defun gnorb-bbdb-display-org-tags (record indent)
- "Display the Org tags associated with the record.
-
-Org tags are stored in the `gnorb-bbdb-org-tags-field'."
- (let ((full-field (assq gnorb-bbdb-org-tag-field
- (bbdb-record-xfields record)))
- (val (bbdb-record-xfield
- record
- gnorb-bbdb-org-tag-field)))
- (when val
- (bbdb-display-text (format (format " %%%ds: " (- indent 3))
- gnorb-bbdb-org-tag-field)
- `(xfields ,full-field field-label)
- 'bbdb-field-name)
- (if (consp val)
- (bbdb-display-list val gnorb-bbdb-org-tag-field "\n")
- (insert
- (bbdb-indent-string (concat val "\n") indent))))))
-
-(defvar message-mode-hook)
-
-;;;###autoload
-(defun gnorb-bbdb-mail (records &optional subject n verbose)
- "\\<bbdb-mode-map>Acts just like `bbdb-mail', except runs
-RECORDS through `gnorb-bbdb-posting-styles', allowing
-customization of message styles for certain records. From the
-`bbdb-mail' docstring:
-
-Compose a mail message to RECORDS (optional: using SUBJECT).
-Interactively, use BBDB prefix \\[bbdb-do-all-records], see
-`bbdb-do-all-records'. By default, the first mail addresses of
-RECORDS are used. If prefix N is a number, use Nth mail address
-of RECORDS (starting from 1). If prefix N is C-u (t
-noninteractively) use all mail addresses of RECORDS. If VERBOSE
-is non-nil (as in interactive calls) be verbose."
- ;; see the function `gnus-configure-posting-styles' for tips on how
- ;; to actually do this.
- (interactive (list (bbdb-do-records) nil
- (or (consp current-prefix-arg)
- current-prefix-arg)
- t))
- (setq records (bbdb-record-list records))
- (if (not records)
- (user-error "No records displayed")
- (let ((head (bbdb-current-record))
- (to (bbdb-mail-address records n nil verbose))
- (message-mode-hook (copy-sequence message-mode-hook)))
- (setq records (remove head records))
- (when gnorb-bbdb-posting-styles
- (add-hook 'message-mode-hook
- `(lambda ()
- (gnorb-bbdb-configure-posting-styles (quote ,records))
- (gnorb-bbdb-configure-posting-styles (list ,head)))))
- (bbdb-compose-mail to subject))))
-
-(defun gnorb-bbdb-configure-posting-styles (recs)
- ;; My most magnificent work of copy pasta!
- (dolist (r recs)
- (let (field val label rec-val filep
- element v value results name address)
- (dolist (style gnorb-bbdb-posting-styles)
- (setq field (pop style)
- val (pop style))
- (when (consp val) ;; (label value)
- (setq label (pop val)
- val (pop val)))
- (unless (fboundp field)
- ;; what's the record's existing value for this field?
- (setq rec-val (bbdb-record-field r field)))
- (when (catch 'match
- (cond
- ((eq field 'address)
- (dolist (a rec-val)
- (unless (and label
- (not (string-match label (car a))))
- (when
- (string-match-p
- val
- (bbdb-format-address-default a))
- (throw 'match t)))))
- ((eq field 'phone)
- (dolist (p rec-val)
- (unless (and label
- (not (string-match label (car p))))
- (when
- (string-match-p val (bbdb-phone-string p))
- (throw 'match t)))))
- ((consp rec-val)
- (dolist (f rec-val)
- (when (string-match-p val f)
- (throw 'match t))))
- ((fboundp field)
- (when (string-match-p (funcall field r))
- (throw 'match t)))
- ((stringp rec-val)
- (when (string-match-p val rec-val)
- (throw 'match t)))))
- ;; there are matches, run through the field setters in last
- ;; element of the sexp
- (dolist (attribute style)
- (setq element (pop attribute)
- filep nil)
- (setq value
- (cond
- ((eq (car attribute) :file)
- (setq filep t)
- (cadr attribute))
- ((eq (car attribute) :value)
- (cadr attribute))
- (t
- (car attribute))))
- ;; We get the value.
- (setq v
- (cond
- ((stringp value)
- value)
- ((or (symbolp value)
- (functionp value))
- (cond ((functionp value)
- (funcall value))
- ((boundp value)
- (symbol-value value))))
- ((listp value)
- (eval value))))
- ;; Post-processing for the signature posting-style:
- (and (eq element 'signature) filep
- message-signature-directory
- ;; don't actually use the signature directory
- ;; if message-signature-file contains a path.
- (not (file-name-directory v))
- (setq v (nnheader-concat message-signature-directory v)))
- ;; Get the contents of file elems.
- (when (and filep v)
- (setq v (with-temp-buffer
- (insert-file-contents v)
- (buffer-substring
- (point-min)
- (progn
- (goto-char (point-max))
- (if (zerop (skip-chars-backward "\n"))
- (point)
- (1+ (point))))))))
- (setq results (delq (assoc element results) results))
- (push (cons element v) results))))
- (setq name (assq 'name results)
- address (assq 'address results))
- (setq results (delq name (delq address results)))
- (setq results (sort results (lambda (x y)
- (string-lessp (car x) (car y)))))
- (dolist (result results)
- (add-hook 'message-setup-hook
- (cond
- ((eq 'eval (car result))
- 'ignore)
- ((eq 'body (car result))
- `(lambda ()
- (save-excursion
- (message-goto-body)
- (insert ,(cdr result)))))
- ((eq 'signature (car result))
- (set (make-local-variable 'message-signature) nil)
- (set (make-local-variable 'message-signature-file) nil)
- (if (not (cdr result))
- 'ignore
- `(lambda ()
- (save-excursion
- (let ((message-signature ,(cdr result)))
- (when message-signature
- (message-insert-signature)))))))
- (t
- (let ((header
- (if (symbolp (car result))
- (capitalize (symbol-name (car result)))
- (car result))))
- `(lambda ()
- (save-excursion
- (message-remove-header ,header)
- (let ((value ,(cdr result)))
- (when value
- (message-goto-eoh)
- (insert ,header ": " value)
- (unless (bolp)
- (insert "\n")))))))))
- t 'local))
- (when (or name address)
- (add-hook 'message-setup-hook
- `(lambda ()
- (set (make-local-variable 'user-mail-address)
- ,(or (cdr address) user-mail-address))
- (let ((user-full-name ,(or (cdr name) (user-full-name)))
- (user-mail-address
- ,(or (cdr address) user-mail-address)))
- (save-excursion
- (message-remove-header "From")
- (message-goto-eoh)
- (insert "From: " (message-make-from) "\n"))))
- t 'local)))))
-
-;;;###autoload
-(defun gnorb-bbdb-tag-agenda (records)
- "Open an Org agenda tags view from the BBDB buffer, using the
-value of the record's org-tags field. This shows only TODOs by
-default; a prefix argument shows all tagged headings; a \"*\"
-prefix operates on all currently visible records. If you want
-both, use \"C-u\" before the \"*\"."
- (interactive (list (bbdb-do-records)))
- (require 'org-agenda)
- (unless (and (eq major-mode 'bbdb-mode)
- (equal (buffer-name) bbdb-buffer-name))
- (error "Only works in the BBDB buffer"))
- (setq records (bbdb-record-list records))
- (let ((tag-string
- (mapconcat
- 'identity
- (delete-dups
- (cl-mapcan
- (lambda (r)
- (bbdb-record-xfield-split r gnorb-bbdb-org-tag-field))
- records))
- "|")))
- (if tag-string
- ;; C-u = all headings, not just todos
- (if (equal current-prefix-arg '(4))
- (org-tags-view nil tag-string)
- (org-tags-view t tag-string))
- (error "No org-tags field present"))))
-
-;;;###autoload
-(defun gnorb-bbdb-mail-search (records)
- "Initiate a mail search from the BBDB buffer.
-
-Use the prefix arg to edit the search string first, and the \"*\"
-prefix to search mails from all visible contacts. When using both
-a prefix arg and \"*\", the prefix arg must come first."
- (interactive (list (bbdb-do-records)))
- (unless (and (eq major-mode 'bbdb-mode)
- (equal (buffer-name) bbdb-buffer-name))
- (error "Only works in the BBDB buffer"))
- (setq records (bbdb-record-list records))
- (require 'gnorb-gnus)
- (let* ((backend (or (assoc gnorb-gnus-mail-search-backend
- gnorb-gnus-mail-search-backends)
- (error "No search backend specified")))
- (search-string
- (funcall (cl-second backend)
- (cl-mapcan 'bbdb-record-mail records))))
- (when (equal current-prefix-arg '(4))
- (setq search-string
- (read-from-minibuffer
- (format "%s search string: " (first backend)) search-string)))
- (funcall (cl-third backend) search-string)
- (delete-other-windows)))
-
-;;;###autoload
-(defun gnorb-bbdb-cite-contact (rec)
- (interactive (list (bbdb-completing-read-record "Record: ")))
- (let ((mail-string (bbdb-dwim-mail rec)))
- (if (called-interactively-p 'any)
- (insert mail-string)
- mail-string)))
-
-;;; Field containing links to recent messages
-(when (boundp 'bbdb-xfield-label-list)
- (add-to-list 'bbdb-xfield-label-list gnorb-bbdb-messages-field nil 'eq))
-
-(defun gnorb-bbdb-display-messages (record format &optional indent)
- "Show links to the messages collected in the
-`gnorb-bbdb-messages-field' field of a BBDB record. Each link
-will be formatted using the format string in
-`gnorb-bbdb-message-link-format-multi' or
-`gnorb-bbdb-message-link-format-one', depending on the current
-layout type."
- (let ((full-field (assq gnorb-bbdb-messages-field
- (bbdb-record-xfields record)))
- (val (bbdb-record-xfield record gnorb-bbdb-messages-field))
- (map (make-sparse-keymap))
- (count 1)) ; one-indexed to fit with prefix arg to
`gnorb-bbdb-open-link'
- (define-key map [mouse-1] 'gnorb-bbdb-mouse-open-link)
- (define-key map (kbd "<RET>") 'gnorb-bbdb-RET-open-link)
- (when val
- (when (eq format 'multi)
- (bbdb-display-text (format (format " %%%ds: " (- indent 3))
- gnorb-bbdb-messages-field)
- `(xfields ,full-field field-label)
- 'bbdb-field-name))
- (insert (cond ((and (stringp val)
- (eq format 'multi))
- (bbdb-indent-string (concat val "\n") indent))
- ((listp val)
- ;; Why aren't I using `bbdb-display-list' with a
- ;; preformatted list of messages?
- (concat
- (bbdb-indent-string
- (mapconcat
- (lambda (m)
- (prog1
- (propertize
- (concat
- (format-time-string
- (replace-regexp-in-string
- "%:subject" (gnorb-bbdb-link-subject m)
- (replace-regexp-in-string
- "%:count" (number-to-string count)
- (if (eq format 'multi)
- gnorb-bbdb-message-link-format-multi
- gnorb-bbdb-message-link-format-one)))
- (gnorb-bbdb-link-date m)))
- 'face 'gnorb-bbdb-link
- 'mouse-face 'highlight
- 'gnorb-bbdb-link-count count
- 'keymap map)
- (incf count)))
- val (if (eq format 'multi)
- "\n" ", "))
- indent)
- (if (eq format 'multi) "\n" "")))
- (t
- ""))))))
-
-(defalias (intern (format "bbdb-display-%s-multi-line"
- gnorb-bbdb-messages-field))
- (lambda (record indent)
- (gnorb-bbdb-display-messages record 'multi indent)))
-
-(defalias (intern (format "bbdb-display-%s-one-line"
- gnorb-bbdb-messages-field))
- (lambda (record)
- (gnorb-bbdb-display-messages record 'one)))
-
-;; Don't allow direct editing of this field
-
-(defalias (intern (format "bbdb-read-xfield-%s"
- gnorb-bbdb-messages-field))
- (lambda (&optional _init)
- (user-error "This field shouldn't be edited manually")))
-
-;; Open links from the *BBDB* buffer.
-
-;;;###autoload
-(defun gnorb-bbdb-open-link (record arg)
- "\\<bbdb-mode-map>Call this on a BBDB record to open one of the
-links in the message field. By default, the first link will be
-opened. Use a prefix arg to open different links. For instance,
-M-3 \\[gnorb-bbdb-open-link] will open the third link in the
-list. If the %:count escape is present in the message formatting
-string (see `gnorb-bbdb-message-link-format-multi' and
-`gnorb-bbdb-message-link-format-one'), that's the number to use.
-
-This function also needs to be called on a contact once before
-that contact will start collecting links to messages."
- (interactive (list
- (or (bbdb-current-record)
- (user-error "No record under point"))
- current-prefix-arg))
- (unless (fboundp 'bbdb-record-xfield-string)
- (user-error "This function only works with the git version of BBDB"))
- (let (msg-list target-msg)
- (if (not (memq gnorb-bbdb-messages-field
- (mapcar 'car (bbdb-record-xfields record))))
- (when (y-or-n-p
- (format "Start collecting message links for %s?"
- (bbdb-record-name record)))
- (bbdb-record-set-xfield record gnorb-bbdb-messages-field "no links
yet")
- (message "Opening messages from %s will add links to the %s field"
- (bbdb-record-name record)
- gnorb-bbdb-messages-field)
- (bbdb-change-record record))
- (setq msg-list
- (bbdb-record-xfield record gnorb-bbdb-messages-field))
- (setq target-msg
- (or (and arg
- (nth (1- arg) msg-list))
- (car msg-list)))
- (when target-msg
- (org-gnus-follow-link (gnorb-bbdb-link-group target-msg)
- (gnorb-bbdb-link-id target-msg))))))
-
-(defun gnorb-bbdb-mouse-open-link (event)
- (interactive "e")
- (mouse-set-point event)
- (let ((rec (bbdb-current-record))
- (num (get-text-property (point) 'gnorb-bbdb-link-count)))
- (if (not num)
- (user-error "No link under point")
- (gnorb-bbdb-open-link rec num))))
-
-(defun gnorb-bbdb-RET-open-link ()
- (interactive)
- (let ((rec (bbdb-current-record))
- (num (get-text-property (point) 'gnorb-bbdb-link-count)))
- (if (not num)
- (user-error "No link under point")
- (gnorb-bbdb-open-link rec num))))
-
-(defun gnorb-bbdb-store-message-link (record)
- "Used in the `bbdb-notice-record-hook' to possibly save a link
-to a message into the record's `gnorb-bbdb-messages-field'."
-
- (when (not (fboundp 'bbdb-record-xfield-string))
- (user-error "This function only works with the git version of BBDB"))
- (unless (or (not (and (memq gnorb-bbdb-messages-field
- (mapcar 'car (bbdb-record-xfields record)))
- (memq major-mode '(gnus-summary-mode
gnus-article-mode))))
- (with-current-buffer gnus-article-buffer
- (not ; only store messages if the record is the sender
- (member (nth 1 (car (bbdb-get-address-components 'sender)))
- (bbdb-record-mail record)))))
- (with-current-buffer gnus-summary-buffer
- (let* ((val (bbdb-record-xfield record gnorb-bbdb-messages-field))
- (art-no (gnus-summary-article-number))
- (heads (gnus-summary-article-header art-no))
- (date (apply 'encode-time
- (parse-time-string (mail-header-date heads))))
- (subject (mail-header-subject heads))
- (id (mail-header-id heads))
- (group (gnorb-get-real-group-name
- gnus-newsgroup-name
- art-no))
- link)
- (if (not (and date subject id group))
- (message "Could not save a link to this message")
- (setq link (make-gnorb-bbdb-link :subject subject :date date
- :group group :id id))
- (when (stringp val)
- (setq val nil))
- (setq val (cons link (delete link val)))
- (when (eq gnorb-bbdb-define-recent 'received)
- (setq val (sort val
- (lambda (a b)
- (time-less-p
- (gnorb-bbdb-link-date b)
- (gnorb-bbdb-link-date a))))))
- (setq val (cl-subseq val 0 (min (length val)
gnorb-bbdb-collect-N-messages)))
- (bbdb-record-set-xfield record
- gnorb-bbdb-messages-field
- (delq nil val))
- (bbdb-change-record record))))))
-
-(add-hook 'bbdb-notice-record-hook 'gnorb-bbdb-store-message-link)
-
-(provide 'gnorb-bbdb)
-;;; gnorb-bbdb.el ends here
diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el
deleted file mode 100644
index f34c816..0000000
--- a/packages/gnorb/gnorb-gnus.el
+++ /dev/null
@@ -1,1271 +0,0 @@
-;;; gnorb-gnus.el --- The gnus-centric fuctions of gnorb -*- lexical-binding:
t -*-
-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
-
-;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
-
-;; 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:
-
-(require 'gnus)
-(require 'gnus-sum)
-(require 'gnus-art)
-(require 'message)
-(require 'org)
-(require 'org-attach)
-(require 'org-capture)
-(require 'gnorb-utils)
-(require 'gnorb-registry)
-(require 'mm-decode)
-
-(declare-function org-gnus-article-link "org-gnus"
- (group newsgroups message-id x-no-archive))
-(declare-function org-gnus-follow-link "org-gnus"
- (group article))
-(declare-function org-make-tags-matcher "org" (match))
-(declare-function gnorb-org-restore-after-send "gnorb-org")
-(declare-function gnorb-org-attachment-list "gnorb-org")
-
-(autoload 'gnorb-gnus-nnir-search "nngnorb")
-(autoload 'gnorb-gnus-nnir-registry-search "nngnorb")
-
-(defgroup gnorb-gnus nil
- "The Gnus bits of Gnorb."
- :tag "Gnorb Gnus"
- :group 'gnorb)
-
-(defcustom gnorb-gnus-mail-search-backends
- '((notmuch (lambda (terms)
- (mapconcat
- (lambda (m)
- (replace-regexp-in-string "\\." "\\\\." m))
- terms " OR "))
- notmuch-search)
- (mairix (lambda (terms)
- (mapconcat 'identity
- terms ","))
- mairix-search)
- (namazu (lambda (terms)
- (mapconcat 'identity
- terms " or "))
- namazu-search))
- "Various backends for mail search.
-
-An alist of backends, where each element consists of three parts:
-the symbol name of the backend, a lambda form which receives a
-list of email addresses and returns a properly-formatted search
-string, and the symbol name of the function used to initiate the
-search."
- :type 'list)
-
-(defcustom gnorb-gnus-mail-search-backend nil
- "Mail search backend currently in use. One of the three symbols
-notmuch, namazu, or mairix."
- :type 'symbol)
-
-(defcustom gnorb-gnus-capture-always-attach nil
- "Always prompt about attaching attachments when capturing from
- a Gnus message, even if the template being used hasn't
- specified the :gnus-attachments key.
-
-Basically behave as if all attachments have \":gnus-attachments t\"."
- :type 'boolean)
-
-(defcustom gnorb-gnus-new-todo-capture-key nil
- "Key for the capture template to use when creating a new TODO
- from an outgoing message."
- :type 'string)
-
-(defcustom gnorb-gnus-copy-message-text nil
- "When capturing or triggering a TODO from a Gnus message,
-should the text of the message be saved?
-
-If t, the body text of the message is pushed onto the kill ring.
-If a char value, the text is saved into the corresponding
-register."
- :type '(choice boolean
- character))
-
-(defcustom gnorb-gnus-hint-relevant-article t
- "When opening a gnus message, should gnorb let you know if the
- message is relevant to an existing TODO?"
- :type 'boolean)
-
-(defcustom gnorb-gnus-tick-all-tracked-messages nil
- "When non-nil, add the tick mark to all tracked messages.
-This happens only once, at the time the association is created.
-Ticks can be safely removed later."
- :type 'boolean)
-
-(defcustom gnorb-gnus-auto-tag-messages nil
- "When non-nil, tag messages with associated heading tags.
-When creating associations between Org headings and messages,
-automatically copy the heading's tags on to the message, using
-the registry."
- :type 'boolean)
-
-(defcustom gnorb-gnus-summary-mark-format-letter "g"
- "Format letter to be used as part of your
- `gnus-summary-line-format', to indicate in the *Summary* buffer
- which articles might be relevant to TODOs. Since this is a user
- format code, it should be prefixed with %u, eg %ug. It will
- result in the insertion of the value of
- `gnorb-gnus-summary-mark', for relevant messages, or
- else a space."
- :type 'string)
-
-(defcustom gnorb-gnus-summary-tags-format-letter "G"
- "Format letter to be replaced with message tags.
-Add this format specification to your `gnus-summary-line-format'
-to show the tags which are currently applied to the message.
-Must be prefixed with \"u\", eg. \"%uG\"."
- :type 'string)
-
-(defcustom gnorb-gnus-summary-mark "¡"
- "Default mark to insert in the summary format line of articles
- that are likely relevant to existing TODO headings."
- :type 'string)
-
-(defcustom gnorb-gnus-summary-tracked-mark "&"
- "Default mark to insert in the summary format line of articles
- that are already tracked by TODO headings."
- :type 'string)
-
-(defcustom gnorb-gnus-trigger-refile-targets
- '((org-agenda-files :maxlevel . 4))
- "A value to use as an equivalent of `org-refile-targets' (which
- see) when offering trigger targets for
- `gnorb-gnus-incoming-do-todo'."
- :type 'list)
-
-(defcustom gnorb-gnus-refile-use-outline-path 'org
- "Gnorb equivalent of `org-refile-use-outline-path' (which see).
-Used when selecting Org headings for triggering or attaching
-attachments."
- :type '(choice
- (const :tag "Not" nil)
- (const :tag "Yes" t)
- (const :tag "Start with file name" file)
- (const :tag "Start with full file path" full-file-path)
- (const :tag "Start with buffer name" buffer-name)
- (const :tag "Use org-refile-use-outline-path" org)))
-
-(defcustom gnorb-gnus-sent-groups nil
- "A list of strings indicating sent mail groups.
-In some cases, Gnorb can't detect where your sent messages are
-stored (ie if you're using IMAP sent mail folders instead of
-local archiving. If you want Gnorb to be able to find sent
-messages, this option can help it do that. It should be set to a
-list of strings, which are assumed to be fully qualified
-server+group combinations, ie \"nnimap+Server:[Gmail]/Sent
-Mail\", or something similar. This only has to be done once for
-each message."
- :type '(repeat (string :tag "Group name")))
-
-(defvar gnorb-gnus-capture-attachments nil
- "Holding place for attachment names during the capture
- process.")
-
-(defvar-local gnorb-gnus-attachment-file-list nil
- "A place to store Org attachments relevant to the subtree being
- viewed.")
-
-;;; What follows is a very careful copy-pasta of bits and pieces from
-;;; mm-decode.el and gnus-art.el. Voodoo was involved.
-
-;;;###autoload
-(defun gnorb-gnus-article-org-attach (n)
- "Save MIME part N, which is the numerical prefix, of the
- article under point as an attachment to the specified org
- heading."
- (interactive "P")
- (gnus-article-part-wrapper n 'gnorb-gnus-attach-part))
-
-;;;###autoload
-(defun gnorb-gnus-mime-org-attach ()
- "Save the MIME part under point as an attachment to the
- specified org heading."
- (interactive)
- (gnus-article-check-buffer)
- (let ((data (get-text-property (point) 'gnus-data)))
- (when data
- (gnorb-gnus-attach-part data))))
-
-(defun gnorb-gnus-attach-part (handle)
- "Attach HANDLE to an existing org heading."
- (let* ((filename (gnorb-gnus-save-part handle))
- (org-refile-targets gnorb-gnus-trigger-refile-targets)
- (org-refile-use-outline-path
- (if (eq gnorb-gnus-refile-use-outline-path 'org)
- org-refile-use-outline-path
- gnorb-gnus-refile-use-outline-path))
- (headers (gnus-data-header
- (gnus-data-find
- (gnus-summary-article-number))))
- (tracked-headings (gnorb-find-tracked-headings headers))
- (target-heading
- (gnorb-choose-trigger-heading tracked-headings)))
- (require 'org-attach)
- (save-window-excursion
- (org-id-goto target-heading)
- (org-attach-attach filename nil 'mv))))
-
-(defun gnorb-gnus-save-part (handle)
- (let ((filename (or (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (mail-content-type-get
- (mm-handle-type handle) 'name))))
- (setq filename
- (gnus-map-function mm-file-name-rewrite-functions
- (file-name-nondirectory filename)))
- (setq filename (expand-file-name filename gnorb-tmp-dir))
- (mm-save-part-to-file handle filename)
- filename))
-
-(defun gnorb-gnus-collect-all-attachments (&optional capture-p store)
- "Collect all the attachments from the message under point, and
-save them into `gnorb-tmp-dir'."
- (save-window-excursion
- (when capture-p
- (set-buffer (org-capture-get :original-buffer)))
- (unless (memq major-mode '(gnus-summary-mode gnus-article-mode))
- (error "Only works in Gnus summary or article buffers"))
- (let ((article (gnus-summary-article-number))
- mime-handles)
- (when (or (null gnus-current-article)
- (null gnus-article-current)
- (/= article (cdr gnus-article-current))
- (not (equal (car gnus-article-current) gnus-newsgroup-name)))
- (gnus-summary-display-article article))
- (gnus-eval-in-buffer-window gnus-article-buffer
- (setq mime-handles (cl-remove-if-not
- (lambda (h)
- (let ((disp (mm-handle-disposition (cdr h))))
- (and (member (car disp)
- '("inline" "attachment"))
- (mail-content-type-get disp 'filename))))
- gnus-article-mime-handle-alist)))
- (when mime-handles
- (dolist (h mime-handles)
- (let ((filename
- (gnorb-gnus-save-part (cdr h))))
- (when (or capture-p store)
- (push filename gnorb-gnus-capture-attachments))))))))
-
-;;; Storing, removing, and acting on Org headers in messages.
-
-(defvar gnorb-gnus-message-info nil
- "Place to store the To, Subject, Date, and Message-ID headers
- of the currently-sending or last-sent message.")
-
-(defun gnorb-gnus-check-outgoing-headers ()
- "Save the value of the `gnorb-mail-header' for the current
-message; multiple header values returned as a string. Also save
-information about the outgoing message into
-`gnorb-gnus-message-info'."
- (save-restriction
- (message-narrow-to-headers)
- (setq gnorb-gnus-message-info nil)
- (let* ((org-ids (mail-fetch-field gnorb-mail-header nil nil t))
- (msg-id (mail-fetch-field "Message-ID"))
- (refs (mail-fetch-field "References"))
- (in-reply-to (mail-fetch-field "In-Reply-To"))
- (to (if (message-news-p)
- (mail-fetch-field "Newsgroups")
- (mail-fetch-field "To")))
- (from (mail-fetch-field "From"))
- (subject (mail-fetch-field "Subject"))
- (date (mail-fetch-field "Date"))
- ;; If we can get a link, that's awesome.
- (gcc (mail-fetch-field "Gcc"))
- (link (or (and gcc
- (org-store-link nil))
- nil))
- (group (ignore-errors (car (split-string link "#")))))
- ;; If we can't make a real link, then save some information so
- ;; we can fake it.
- (when in-reply-to
- (setq refs (concat refs " " in-reply-to)))
- (when refs
- (setq refs (gnus-extract-references refs)))
- (setq gnorb-gnus-message-info
- `(:subject ,subject :msg-id ,msg-id
- :to ,to :from ,from
- :link ,link :date ,date :refs ,refs
- :group ,group))
- (if org-ids
- (progn
- (require 'gnorb-org)
- (setq gnorb-message-org-ids org-ids)
- ;; `gnorb-org-setup-message' may have put this here, but
- ;; if we're working from a draft, or triggering this from
- ;; a reply, it might not be there yet.
- (add-to-list 'message-send-actions
- 'gnorb-org-restore-after-send t))
- (setq gnorb-message-org-ids nil)))))
-
-(add-hook 'message-sent-hook #'gnorb-gnus-check-outgoing-headers t)
-
-;;;###autoload
-(defun gnorb-gnus-outgoing-do-todo (&optional arg)
- "Use this command to use the message currently being composed
-as an email todo action.
-
-If it's a new message, or a reply to a message that isn't
-referenced by any TODOs, a new TODO will be created.
-
-If it references an existing TODO, you'll be prompted to trigger
-a state-change or a note on that TODO after the message is sent.
-
-You can call it with a prefix arg to force choosing an Org
-subtree to associate with.
-
-If you've already called this command, but realize you made a
-mistake, you can call this command with a double prefix to reset
-the association.
-
-If a new todo is made, it needs a capture template: set
-`gnorb-gnus-new-todo-capture-key' to the string key for the
-appropriate capture template. If you're using a gnus-based
-archive method (ie you have `gnus-message-archive-group' set to
-something, and your outgoing messages have a \"Fcc\" header),
-then a real link will be made to the outgoing message, and all
-the gnus-type escapes will be available (see the Info
-manual (org) Template expansion section). If you don't, then the
-%:subject, %:to, %:toname, %:toaddress, and %:date escapes for
-the outgoing message will still be available -- nothing else will
-work."
- (interactive "P")
- (let ((org-refile-targets gnorb-gnus-trigger-refile-targets)
- (org-refile-use-outline-path
- (if (eq gnorb-gnus-refile-use-outline-path 'org)
- org-refile-use-outline-path
- gnorb-gnus-refile-use-outline-path))
- (compose-marker (make-marker))
- header-ids ref-ids rel-headings
- gnorb-window-conf in-reply-to)
- (when (equal arg '(4))
- (setq rel-headings
- (org-refile-get-location "Trigger action on" nil t))
- (setq rel-headings
- (list (list (save-window-excursion
- (find-file (nth 1 rel-headings))
- (goto-char (nth 3 rel-headings))
- (org-id-get-create))))))
- (if (not (derived-mode-p 'message-mode 'mail-mode))
- ;; The message is already sent, so we're relying on whatever was
- ;; stored into `gnorb-gnus-message-info'.
- (if (equal arg '(16))
- (user-error "A double prefix is only useful with an
- unsent message.")
- (if arg
- (progn
- (push (caar rel-headings) gnorb-message-org-ids)
- (gnorb-org-restore-after-send))
- (setq ref-ids (plist-get gnorb-gnus-message-info :refs))
- (if ref-ids
- ;; the message might be relevant to some TODO
- ;; heading(s). But if there had been org-id
- ;; headers, they would already have been
- ;; handled when the message was sent.
- (progn
- (setq rel-headings (gnorb-find-visit-candidates ref-ids))
- (if (not rel-headings)
- (gnorb-gnus-outgoing-make-todo-1)
- (dolist (h rel-headings)
- (push h gnorb-message-org-ids))
- (gnorb-org-restore-after-send)))
- ;; not relevant, just make a new TODO
- (gnorb-gnus-outgoing-make-todo-1))))
- ;; We are still in the message composition buffer, so let's see
- ;; what we've got.
-
- (if (equal arg '(16))
- ;; Double prefix arg means delete the association we already
- ;; made.
- (save-excursion
- (save-restriction
- (widen)
- (setq message-send-actions
- (remove 'gnorb-gnus-outgoing-make-todo-1
- message-send-actions))
- (message-narrow-to-headers-or-head)
- (message-remove-header
- gnorb-mail-header)
- (message "Message associations have been reset")))
- ;; Save-excursion won't work, because point will move if we
- ;; insert headings.
- (move-marker compose-marker (point))
- (save-restriction
- (widen)
- (message-narrow-to-headers-or-head)
- (setq header-ids (mail-fetch-field gnorb-mail-header nil nil t))
- ;; With a prefix arg we do not check references, because the
- ;; whole point is to add new references. We still want to know
- ;; what org id headers are present, though, so we don't add
- ;; duplicates.
- (setq ref-ids (unless arg (mail-fetch-field "References" t)))
- (setq in-reply-to (unless arg (mail-fetch-field "In-Reply-to" t)))
- (when in-reply-to
- (setq ref-ids (concat ref-ids " " in-reply-to)))
- (when ref-ids
- ;; if the References header points to any message ids that are
- ;; tracked by TODO headings...
- (setq rel-headings (gnorb-find-visit-candidates ref-ids)))
- (when rel-headings
- (goto-char (point-min))
- (dolist (h (delete-dups rel-headings))
- ;; then get the org-ids of those headings, and insert
- ;; them into this message as headers. If the id was
- ;; already present in a header, don't add it again.
- (unless (member h header-ids)
- (goto-char (point-at-bol))
- (open-line 1)
- (message-insert-header
- (intern gnorb-mail-header)
- h)
- ;; tell the rest of the function that this is a relevant
- ;; message
- (push h header-ids)))))
- (goto-char compose-marker)
- (unless header-ids
- (add-to-list 'message-send-actions
- 'gnorb-gnus-outgoing-make-todo-1 t))
- (message
- (if header-ids
- "Message will trigger TODO state-changes after sending"
- "A TODO will be made from this message after it's sent"))))))
-
-(defvar org-capture-link-is-already-stored)
-
-(defun gnorb-gnus-outgoing-make-todo-1 ()
- (unless gnorb-gnus-new-todo-capture-key
- (error "No capture template key set, customize
gnorb-gnus-new-todo-capture-key"))
- (let* ((link (plist-get gnorb-gnus-message-info :link))
- (group (plist-get gnorb-gnus-message-info :group))
- (date (plist-get gnorb-gnus-message-info :date))
- (date-ts (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t)
- (date-to-time date)))))
- (date-ts-ia (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date)))))
- (msg-id (plist-get gnorb-gnus-message-info :msg-id))
- (sender (plist-get gnorb-gnus-message-info :from))
- (subject (plist-get gnorb-gnus-message-info :subject))
- ;; Convince Org we already have a link stored, even if we
- ;; don't.
- (org-capture-link-is-already-stored t))
- (if link
- ;; Even if you make a link to not-yet-sent messages, even if
- ;; you've saved the draft and it has a Date header, that
- ;; header isn't saved into the link plist. So fake that, too.
- (org-link-add-props
- :date date
- :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia
- :annotation link)
- (org-link-store-props
- :subject (plist-get gnorb-gnus-message-info :subject)
- :to (plist-get gnorb-gnus-message-info :to)
- :date date
- :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia
- :message-id msg-id
- :annotation link))
- (org-capture nil gnorb-gnus-new-todo-capture-key)
- (when msg-id
- (gnorb-registry-make-entry msg-id sender subject (org-id-get-create)
group))))
-
-;;; If an incoming message should trigger state-change for a Org todo,
-;;; call this function on it.
-
-;;;###autoload
-(defun gnorb-gnus-incoming-do-todo (arg &optional id)
- "Use the message under point to trigger an action on an Org heading.
-This function stores a link to the message, prompts for a related
-Org heading, visits the heading, and triggers an action on
-it (see `gnorb-org-trigger-actions').
-
-If you've set up message tracking (with
-`gnorb-tracking-initialize'), Gnorb can guess which Org heading
-you probably want to trigger, which can save some time. It does
-this by looking in the References header, and seeing if any of
-the messages referenced there are already being tracked by any
-headings.
-
-If you mark several messages before calling this function, or
-call it with a numerical prefix arg, those messages will be
-\"bulk associated\" with the chosen Org heading: associations
-will be made, but you won't be prompted to trigger an action, and
-you'll stay in the Gnus summary buffer."
- (interactive "P")
- (when (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
- (user-error "Only works in gnus summary or article mode"))
- ;; We should only store a link if it's not already at the head of
- ;; `org-stored-links'. There's some duplicate storage, at
- ;; present. Take a look at calling it non-interactively.
- (setq gnorb-window-conf (current-window-configuration))
- (move-marker gnorb-return-marker (point))
- (setq gnorb-gnus-message-info nil)
- (let* ((buf (current-buffer))
- (articles (gnus-summary-work-articles arg))
- (art-no (gnus-summary-article-number))
- (headers (gnus-data-header
- (gnus-data-find art-no)))
- (msg-id (mail-header-id headers))
- (from (mail-header-from headers))
- (subject (mail-header-subject headers))
- (date (mail-header-date headers))
- (to (cdr (assoc 'To (mail-header-extra headers))))
- (group (gnorb-get-real-group-name
- gnus-newsgroup-name
- art-no))
- (text (gnus-with-article-buffer
- (article-goto-body)
- (buffer-substring-no-properties
- (point) (point-max))))
- (link (call-interactively 'org-store-link))
- (org-refile-targets gnorb-gnus-trigger-refile-targets)
- (org-refile-use-outline-path
- (if (eq gnorb-gnus-refile-use-outline-path 'org)
- org-refile-use-outline-path
- gnorb-gnus-refile-use-outline-path))
- (ref-msg-ids (concat (mail-header-references headers) " "
- msg-id))
- (related-headings
- (when (and (null id) ref-msg-ids)
- ;; Specifically ask for zombies, so the user has chance to
- ;; flush them out.
- (gnorb-find-tracked-headings headers t)))
- targ tags)
- (setq gnorb-gnus-message-info
- `(:subject ,subject :msg-id ,msg-id
- :to ,to :from ,from
- :link ,link :date ,date :refs ,ref-msg-ids
- :group ,group))
- (gnorb-gnus-collect-all-attachments nil t)
- (unwind-protect
- (if id
- (progn
- (delete-other-windows)
- (gnorb-trigger-todo-action nil id))
- ;; Flush out zombies (dead associations).
- (setq related-headings
- (cl-remove-if
- (lambda (h)
- (when (null (org-id-find-id-file h))
- (when (y-or-n-p
- (format
- "ID %s no longer exists, disassociate message?"
- h))
- (gnorb-delete-association msg-id h))))
- related-headings))
- ;; See if one of the related headings is chosen.
- (unless (catch 'target
- (dolist (h related-headings nil)
- (when (yes-or-no-p
- (format "Trigger action on %s"
- (gnorb-pretty-outline h)))
- (throw 'target (setq targ h)))))
- ;; If not, use the refile interface to choose one.
- (setq targ (org-refile-get-location
- "Trigger heading" nil))
- (setq targ
- (save-window-excursion
- (find-file (nth 1 targ))
- (goto-char (nth 3 targ))
- (setq tags (org-get-tags))
- (org-id-get-create))))
- ;; Either bulk associate multiple messages...
- (if (> (length articles) 1)
- (progn
- (dolist (a articles)
- (gnorb-registry-make-entry
- (mail-header-id
- (gnus-data-header
- (gnus-data-find a)))
- from subject targ group)
- (gnus-summary-remove-process-mark a))
- (message "Associated %d messages with %s"
- (length articles) (gnorb-pretty-outline targ)))
- ;; ...or just trigger the one.
- (delete-other-windows)
- (gnorb-trigger-todo-action nil targ)
- (when gnorb-gnus-copy-message-text
- (if (characterp gnorb-gnus-copy-message-text)
- (with-temp-buffer
- (insert text)
- (copy-to-register
- gnorb-gnus-copy-message-text
- (point-min) (point-max))
- (message "Message text copied to register %c"
- gnorb-gnus-copy-message-text))
- (kill-new text)
- (message "Message text copied to kill ring"))))
- (with-current-buffer buf
- (dolist (a articles)
- (when gnorb-gnus-tick-all-tracked-messages
- (gnus-summary-mark-article a gnus-ticked-mark))
- (when gnorb-gnus-auto-tag-messages
- (gnorb-gnus-tag-message
- (mail-header-id (gnus-data-header (gnus-data-find a)))
- tags))
- (gnus-summary-update-article a))))
- ;; No matter what, clear these two variables.
- (setq gnorb-gnus-message-info nil)
- (setq gnorb-gnus-capture-attachments nil))))
-
-;;;###autoload
-(defun gnorb-gnus-quick-reply ()
- "Compose a reply to the message under point, and associate both
-the original message and the reply with the selected heading.
-Take no other action.
-
-Use this when you want to compose a reply to a message on the
-spot, and track both messages, without having to go through the
-hassle of triggering an action on a heading, and then starting a
-reply."
- (interactive)
- (when (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
- (user-error "Only works in gnus summary or article mode"))
- (let* ((art-no (gnus-summary-article-number))
- (headers (gnus-data-header
- (gnus-data-find art-no)))
- (msg-id (mail-header-id headers))
- (from (mail-header-from headers))
- (subject (mail-header-subject headers))
- (group (gnorb-get-real-group-name
- gnus-newsgroup-name
- art-no))
- (ref-msg-ids (concat (mail-header-references headers) " "
- msg-id))
- (related-headings
- (when ref-msg-ids
- (gnorb-find-tracked-headings headers t)))
- (targ (car-safe related-headings)))
- (if targ
- (let ((ret (make-marker)))
- (setq gnorb-window-conf (current-window-configuration))
- (move-marker gnorb-return-marker (point))
- (when gnorb-gnus-tick-all-tracked-messages
- (gnus-summary-mark-article art-no gnus-ticked-mark))
- ;; Assume the first heading is the one we want.
- (gnorb-registry-make-entry
- msg-id from subject targ group)
- ;; Maybe tag the message.
- (when gnorb-gnus-auto-tag-messages
- (let ((tags (save-window-excursion
- (org-id-goto targ)
- (org-get-tags))))
- (gnorb-gnus-tag-message msg-id tags)))
- (gnus-summary-update-article art-no)
- (gnus-summary-wide-reply-with-original 1)
- (move-marker ret (point))
- (save-restriction
- (widen)
- (message-narrow-to-headers-or-head)
- (goto-char (point-min))
- (open-line 1)
- (message-insert-header
- (intern gnorb-mail-header) targ))
- (goto-char ret)
- (message
- (format "Original message and reply will be associated with %s"
- (gnorb-pretty-outline targ))))
- (message "No associated headings found"))))
-
-(with-eval-after-load 'gnus-registry
- (add-to-list 'gnus-registry-extra-entries-precious 'org-tags)
- (add-to-list 'gnus-registry-track-extra 'org-tags))
-
-(defvar gnorb-registry-search-history nil)
-
-;;;###autoload
-(defun gnorb-gnus-search-registry (search-string)
- "Search for and display messages using the registry.
-Prompt for a registry-specific SEARCH-STRING, then create an
-ephemeral group containing the resulting messages. All tracked
-registry data keys are acceptable, see (slot-value
-gnus-registry-db 'tracked). Unknown keys will be ignored. Keys
-and search strings should be given as \"key:value\", with extra
-quotes around multi-word search values. Eg:
-
-sender:google.com subject:\"your search results\""
- (interactive
- (list (read-string "Registry search terms: " nil
- gnorb-registry-search-history)))
- (let ((case-fold-search t)
- parsed found this-pass term)
- (with-temp-buffer
- (insert search-string)
- (goto-char (point-min))
- (while (re-search-forward
- "\\([[:alpha:]]+\\):\\(\\(?:[^\"[:blank:]]+\\|\"[^\"]+\"\\)\\)"
- (point-at-eol) t)
- (push (cons (intern (match-string 1))
- (replace-regexp-in-string "\\`\"\\|\"\\'" ""
- (match-string 2)))
- parsed)))
- (dolist (sym (slot-value gnus-registry-db 'tracked))
- (when (setq term (cdr-safe (assoc sym parsed)))
- (maphash
- (lambda (k v)
- (when (string-match-p term k)
- (setq this-pass (append v this-pass))))
- (gethash sym (slot-value gnus-registry-db 'tracker)))
- (setq found (if found
- (seq-intersection found this-pass)
- this-pass)
- this-pass nil)))
- (if found
- (let ((artlist
- (delq
- nil
- (mapcar
- (lambda (msg)
- (pcase-let ((`(,group . ,artno)
- (gnorb-msg-id-request-head
- msg (car-safe
- (gnus-registry-get-id-key msg 'group)))))
- (when (and group artno (integerp artno) (> artno 0))
- (vector group artno 100))))
- (delq nil (delete-dups found))))))
- (switch-to-buffer gnus-group-buffer)
- (if (featurep 'nnselect)
- (gnus-group-read-ephemeral-group
- "registry messages" '(nnselect "nnselect-gnorb") nil
- `(switch-to-buffer ,gnus-group-buffer)
- nil nil `((nnselect-artlist . ,artlist)))
- (gnorb-gnus-nnir-registry-search artlist)))
- (message "No results found"))))
-
-;;;###autoload
-(defun gnorb-gnus-tag-message (arg &optional tags)
- "Tag message or messages with TAGS.
-ARG is used to specify which messages to work on (according to
-Gnus' process prefix convention). TAGS should be a list of Org
-tags. The tags are stored under the `org-tags' key in the
-registry. If called from a lisp program, TAGS are added to any
-existing tags.
-
-If multiple messages are to be tagged, only the first message's
-existing tags are offered as a default."
- (interactive "P")
- (let* ((articles (or (gnus-summary-work-articles arg)
- (user-error "This command must be used within Gnus")))
- (first (mail-header-id
- (gnus-data-header
- (gnus-data-find (car articles)))))
- (crm-separator ":")
- (current (gnus-registry-get-id-key first 'org-tags))
- (default (when current
- (mapconcat #'identity current ":"))))
- (setq tags
- (if tags
- (delete-dups (append current tags))
- (completing-read-multiple
- "Tags: "
- (org-global-tags-completion-table) nil t default)))
- (dolist (a articles)
- (let ((msg-id (mail-header-id
- (gnus-data-header
- (gnus-data-find a)))))
- (gnus-registry-set-id-key msg-id 'org-tags tags)
- (gnus-summary-update-article a)))
- (gnus-message 5 "%d message%s tagged: %s"
- (length articles)
- (if (= 1 (length articles)) "" "s")
- (mapconcat #'identity tags ":"))))
-
-;;;###autoload
-(defun gnorb-gnus-insert-tagged-messages (tags)
- "Insert articles in this group with tags matching TAGS.
-TAGS is a string possibly containing multiple tags to include or
-exclude. See Info node `(org)Matching tags and properties'."
- (interactive "MTags: ")
- (let ((matcher (cdr (org-make-tags-matcher tags)))
- (tagged-messages (registry-search gnus-registry-db
- :regex `((org-tags ".+"))
- :member `((group
,gnus-newsgroup-name))))
- (old (sort (mapcar 'car gnus-newsgroup-data) '<))
- selected-messages)
- ;; Funcall the matcher with t, (list of tags), and 1.
- (dolist (m tagged-messages)
- (when (funcall matcher t (gnus-registry-get-id-key m 'org-tags) 1)
- (push m selected-messages)))
- (if selected-messages
- ;; Turn message ids into article numbers.
- (progn
- (setq selected-messages
- (mapcar (lambda (id) (cdr (gnus-request-head id
gnus-newsgroup-name)))
- selected-messages))
- (gnus-summary-insert-articles selected-messages)
- (gnus-summary-limit (gnus-sorted-nunion old selected-messages))
- (gnus-summary-position-point))
- (message "No matching messages in this group"))))
-
-;;;###autoload
-(defun gnorb-gnus-insert-tracked-messages (show-all)
- "Insert tracked messages into the Summary buffer.
-Only inserts tracked messages belonging to this group. If
-SHOW-ALL (interactively, the prefix arg) is non-nil, insert all
-messages; otherwise only insert messages that are tracked by a
-heading in a non-DONE state."
- (interactive "P")
- (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
- (tracked-messages
- (registry-search gnus-registry-db
- :regex `((gnorb-ids ".+"))
- :member `((group ,gnus-newsgroup-name)))))
- (unless show-all
- (setq tracked-messages
- (cl-remove-if
- (lambda (msg-id)
- (let ((id (car-safe (gnus-registry-get-id-key
- msg-id 'gnorb-ids))))
- (or (null id)
- (save-window-excursion
- (org-id-goto id)
- (org-entry-is-done-p)))))
- tracked-messages)))
- (if tracked-messages
- (progn
- (setq tracked-messages
- (delq nil
- (mapcar (lambda (id)
- (cdr (gnus-request-head id
gnus-newsgroup-name)))
- tracked-messages)))
- (gnus-summary-insert-articles tracked-messages)
- (gnus-summary-limit (gnus-sorted-nunion tracked-messages old))
- (gnus-summary-position-point))
- (message "No tracked messages in this group"))))
-
-;;;###autoload
-(defun gnorb-gnus-search-messages (str persist &optional head-text ret)
- "Initiate a search for gnus message links in an org subtree.
-The arg STR can be one of two things: an Org heading id value
-\(IDs should be prefixed with \"id+\"), in which case links will
-be collected from that heading, or a string corresponding to an
-Org tags search, in which case links will be collected from all
-matching headings.
-
-In either case, once a collection of links have been made, they
-will all be displayed in an ephemeral Gnus group. In Emacs 27
-and below this requires the presence of an active \"nngnorb\"
-server to work. In Emacs 28 and later, no setup is required.
-
-If PERSIST is non-nil, make a permanent group, and offer
-HEAD-TEXT, if present, as its name. Otherwise create an
-ephemeral one, with RET as the value of its quit-config."
- (interactive)
- (unless (gnus-alive-p)
- (gnus))
- (if (featurep 'nnselect)
- (gnorb-gnus-nnselect-search str persist head-text ret)
- (gnorb-gnus-nnir-search str persist head-text ret)))
-
-(defun gnorb-gnus-nnselect-search (str persist &optional head-text ret)
- "Display gnus messages using the nnselect backend."
- (let ((specs `((nnselect-specs
- (nnselect-function . gnorb-run-search)
- (nnselect-args . ,str)))))
- (if persist
- (let ((name (gnus-read-group
- (format "Name for group (default %s): " head-text)
- head-text)))
- (with-current-buffer gnus-group-buffer
- (gnus-group-make-group
- name (list 'nnselect "nnselect-gnorb")
- nil specs)))
- (gnus-group-read-ephemeral-group
- (concat "nnselect-" (message-unique-id))
- (list 'nnselect "nnselect-gnorb")
- nil ret nil nil specs))))
-
-(defun gnorb-run-search (q)
- (save-window-excursion
- (let ((buf (get-buffer-create "gnorb search"))
- msg-ids org-ids links vectors)
- (with-current-buffer buf
- (erase-buffer)
- (setq gnorb-gnus-attachment-file-list nil))
- (cond ((string-match "id\\+\\([[:alnum:]-]+\\)$" q)
- (with-demoted-errors "Error: %S"
- (org-id-goto (match-string 1 q))
- (save-restriction
- (org-narrow-to-subtree)
- (append-to-buffer
- buf
- (point-min)
- (point-max))
- (setq org-ids
- (append
- (gnorb-collect-ids)
- org-ids))
- (when org-ids
- (with-current-buffer buf
- ;; The file list var is buffer local, so set it
- ;; (local to Gnorb's search buffer) to a full
- ;; list of all files in the subtree.
- (dolist (id org-ids)
- (setq gnorb-gnus-attachment-file-list
- (append (gnorb-org-attachment-list id)
- gnorb-gnus-attachment-file-list))))))))
- ((listp q)
- ;; be a little careful: this could be a list of links, or
- ;; it could be the full plist
- (setq links (if (plist-member q :gnus)
- (plist-get q :gnus)
- q)))
- (t (org-map-entries
- (lambda ()
- (push (org-id-get) org-ids)
- (append-to-buffer
- buf
- (point)
- (save-excursion
- (outline-next-heading)
- (point))))
- q
- 'agenda)))
- (with-current-buffer buf
- (goto-char (point-min))
- (setq links (append
- (alist-get 'gnus (gnorb-scan-links (point-max) 'gnus))
- links))
-
- (goto-char (point-min)))
- ;; First add all links to messages (elements of messages should
- ;; look like (group-name message-id)).
- (dolist (l links)
- (push (org-link-unescape
- (nth 1 (split-string l "#")))
- msg-ids))
-
- (unless (gnus-alive-p)
- (gnus))
-
- ;; Then use the registry to turn list of org-ids into list of
- ;; msg-ids.
- (dolist (i (delq nil (delete-dups org-ids)))
- (when-let ((rel-msg-id (gnorb-registry-org-id-search i)))
- (setq msg-ids (append (delq nil rel-msg-id) msg-ids))))
-
- ;; Then find the group and article number for each msg-id, and
- ;; push that onto our return value "vectors".
- (when msg-ids
- (dolist (id (delete-dups msg-ids) (when vectors
- (nreverse vectors)))
- (pcase-let ((`(,group . ,artno) (gnorb-msg-id-request-head id)))
- (when (and artno (integerp artno) (> artno 0))
- (push (vector group artno 100) vectors))))))))
-
-(defvar gnorb-summary-minor-mode-map (make-sparse-keymap)
- "Keymap for use in Gnorb's *Summary* minor mode.")
-
-(define-minor-mode gnorb-summary-minor-mode
- "A minor mode for use in nnir *Summary* buffers created by Gnorb.
-These *Summary* buffers are usually created by calling
-`gnorb-org-view', or by otherwise initiating a search of
-Gnorb-tracked messages.
-
-While active, this mode provides some Gnorb-specific commands,
-and also advises Gnus' reply-related commands in order to
-continue to provide tracking of sent messages."
- nil " Gnorb" gnorb-summary-minor-mode-map
- (setq gnorb-gnus-attachment-file-list
- ;; Copy the list of attached files from the nnir-tmp-buffer to
- ;; this summary buffer.
- (buffer-local-value
- 'gnorb-gnus-attachment-file-list
- (get-buffer-create nnir-tmp-buffer))))
-
-(define-key gnorb-summary-minor-mode-map
- [remap gnus-summary-exit]
- 'gnorb-summary-exit)
-
-(define-key gnorb-summary-minor-mode-map (kbd "C-c d")
- 'gnorb-summary-disassociate-message)
-
-;; All this is pretty horrible, but it's the only way to get sane
-;; behavior, there are no appropriate hooks, and I want to avoid
-;; advising functions.
-
-(define-key gnorb-summary-minor-mode-map
- [remap gnus-summary-very-wide-reply-with-original]
- 'gnorb-summary-very-wide-reply-with-original)
-
-(define-key gnorb-summary-minor-mode-map
- [remap gnus-summary-wide-reply-with-original]
- 'gnorb-summary-wide-reply-with-original)
-
-(define-key gnorb-summary-minor-mode-map
- [remap gnus-summary-reply]
- 'gnorb-summary-reply)
-
-(define-key gnorb-summary-minor-mode-map
- [remap gnus-summary-very-wide-reply]
- 'gnorb-summary-very-wide-reply)
-
-(define-key gnorb-summary-minor-mode-map
- [remap gnus-summary-reply-with-original]
- 'gnorb-summary-reply-with-original)
-
-(define-key gnorb-summary-minor-mode-map
- [remap gnus-summary-wide-reply]
- 'gnorb-summary-wide-reply)
-
-(define-key gnorb-summary-minor-mode-map
- [remap gnus-summary-mail-forward]
- 'gnorb-summary-mail-forward)
-
-(defun gnorb-summary-wide-reply (&optional yank)
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
- (gnorb-summary-reply yank t))
-
-(defun gnorb-summary-reply-with-original (n &optional wide)
- (interactive "P")
- (gnorb-summary-reply (gnus-summary-work-articles n) wide))
-
-(defun gnorb-summary-very-wide-reply (&optional yank)
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
- (gnorb-summary-reply yank t (gnus-summary-work-articles yank)))
-
-(defun gnorb-summary-reply (&optional yank wide very-wide)
- (interactive)
- (gnus-summary-reply yank wide very-wide)
- (gnorb-summary-reply-hook))
-
-(defun gnorb-summary-wide-reply-with-original (n)
- (interactive "P")
- (gnorb-summary-reply-with-original n t))
-
-(defun gnorb-summary-very-wide-reply-with-original (n)
- (interactive "P")
- (gnorb-summary-reply
- (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
-
-(defun gnorb-summary-mail-forward (n)
- (interactive "P")
- (gnus-summary-mail-forward n t)
- (gnorb-summary-reply-hook))
-
-(defun gnorb-summary-reply-hook (&rest _args)
- "Function that runs after any command that creates a reply."
- ;; Not actually a "hook"
- (let* ((msg-id (if message-reply-headers
- (aref message-reply-headers 4)
- ;; When forwarding messages,
- ;; `message-reply-headers' is nil.
- (save-excursion
- (let ((case-fold-search t))
- (when (re-search-forward "message-id: +\\(.*\\)$"
(point-max) t)
- (match-string 1))))))
- (org-id (car-safe (gnus-registry-get-id-key msg-id 'gnorb-ids)))
- (compose-marker (make-marker))
- (attachments (buffer-local-value
- 'gnorb-gnus-attachment-file-list
- (get-buffer "gnorb search"))))
- (when org-id
- (move-marker compose-marker (point))
- (save-restriction
- (widen)
- (message-narrow-to-headers-or-head)
- (goto-char (point-at-bol))
- (open-line 1)
- (message-insert-header
- (intern gnorb-mail-header)
- org-id)
- ;; As with elsewhere, this should be redundant with
- ;; `gnorb-gnus-check-outgoing-headers.' Even if not, it
- ;; should be switched to use `message-send-actions'
- ;; (add-to-list 'message-exit-actions
- ;; 'gnorb-org-restore-after-send t)
- )
- (goto-char compose-marker))
- (when attachments
- (map-y-or-n-p
- (lambda (a) (format "Attach %s to outgoing message? "
- (file-name-nondirectory a)))
- (lambda (a)
- (mml-attach-file a (mm-default-file-encoding a)
- nil "attachment"))
- attachments
- '("file" "files" "attach")))))
-
-;; TODO: Can this be done using Gnus' quit-config?
-(defun gnorb-summary-exit ()
- "Like `gnus-summary-exit', but restores the gnorb window conf."
- (interactive)
- (call-interactively 'gnus-summary-exit)
- (gnorb-restore-layout))
-
-(defun gnorb-summary-disassociate-message ()
- "Disassociate a message from its Org TODO.
-This is used in a Gnorb-created *Summary* buffer to remove the
-connection between the message and whichever Org TODO resulted in
-the message being included in this search."
- (interactive)
- (unless (get-buffer-window gnus-article-buffer t)
- (gnus-summary-display-article
- (gnus-summary-article-number)))
- (let* ((msg-id (gnus-fetch-original-field "message-id"))
- (org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))
- chosen multiple-alist)
- (if org-ids
- (progn
- (if (= (length org-ids) 1)
- ;; Only one associated Org TODO.
- (progn (gnus-registry-set-id-key msg-id 'gnorb-ids nil)
- (setq chosen (car org-ids)))
- ;; Multiple associated TODOs, prompt to choose one.
- (setq multiple-alist
- (mapcar
- (lambda (h)
- (cons (gnorb-pretty-outline h) h))
- org-ids))
- (setq chosen
- (cdr
- (assoc
- (org-completing-read
- "Choose a TODO to disassociate from: "
- multiple-alist)
- multiple-alist)))
- (gnus-registry-set-id-key msg-id 'gnorb-ids
- (remove chosen org-ids)))
- (message "Message disassociated from %s"
- (gnorb-pretty-outline chosen)))
- (message "Message has no associations"))))
-
-(defun gnorb-gnus-summary-mode-hook ()
- "Check if we've entered a Gnorb-generated group, and activate
- `gnorb-summary-minor-mode', if so."
- (let ((method (gnus-find-method-for-group gnus-newsgroup-name))
- (case-fold-search t))
- (when (string-match-p "gnorb" (cadr method))
- (gnorb-summary-minor-mode))))
-
-;;; Automatic noticing of relevant messages
-
-;; likely hooks for the summary buffer include:
-;; `gnus-parse-headers-hook'
-
-;; BBDB puts its notice stuff in the `gnus-article-prepare-hook',
-;; which seems as good a spot as any.
-
-(defun gnorb-gnus-hint-relevant-message ()
- "When opening an article buffer, check the message to see if it
-is relevant to any existing TODO headings. If so, flash a message
-to that effect. This function is added to the
-`gnus-article-prepare-hook'. It will only do anything if the
-option `gnorb-gnus-hint-relevant-article' is non-nil."
- (when (and gnorb-gnus-hint-relevant-article
- (eieio-object-p gnus-registry-db)
- (not (memq (car (gnus-find-method-for-group
- gnus-newsgroup-name))
- '(nnvirtual nnir))))
- (let* ((headers
- (gnus-data-header
- (gnus-data-find
- (gnus-summary-article-number))))
- (assoc-heading
- (gnorb-registry-get-id-key
- (gnus-fetch-original-field "message-id") 'gnorb-ids))
- (tracked-headings (gnorb-find-tracked-headings headers)))
- (cond (assoc-heading
- (message "Message is associated with %s"
- (gnorb-pretty-outline (car assoc-heading) t)))
- (tracked-headings
- (message
- (substitute-command-keys
- "Possible relevant todo %s, trigger with
\\[gnorb-gnus-incoming-do-todo]")
- (gnorb-pretty-outline (car tracked-headings) t)))
- (t nil)))))
-
-(defun gnorb-gnus-insert-format-letter-maybe (header)
- (if (eieio-object-p gnus-registry-db)
- (if (not (or (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-virtual-group-p gnus-newsgroup-name)))
- (cond ((gnorb-registry-get-id-key
- (mail-header-message-id header) 'gnorb-ids)
- gnorb-gnus-summary-tracked-mark)
- ((gnorb-find-tracked-headings header)
- gnorb-gnus-summary-mark)
- (t " "))
- " ")
- ""))
-
-(defalias (intern (concat "gnus-user-format-function-"
- gnorb-gnus-summary-mark-format-letter))
- (lambda (header)
- (gnorb-gnus-insert-format-letter-maybe header)))
-
-(defun gnorb-gnus-insert-format-tags (header)
- (if (eieio-object-p gnus-registry-db)
- (let ((tags (gnorb-registry-get-id-key
- (mail-header-message-id header) 'org-tags)))
- (if tags
- (concat
- ":" (mapconcat #'identity tags ":") ":")
- ""))
- ""))
-
-(defalias (intern (concat "gnus-user-format-function-"
- gnorb-gnus-summary-tags-format-letter))
- (lambda (header)
- (gnorb-gnus-insert-format-tags header)))
-
-;;;###autoload
-(defun gnorb-gnus-view ()
- "Display the first relevant TODO heading for the message under point"
- (interactive)
- (let* ((headers (gnus-data-header
- (gnus-data-find
- (gnus-summary-article-number))))
- (tracked-headings
- (gnorb-find-tracked-headings headers)))
- (when tracked-headings
- (setq gnorb-window-conf (current-window-configuration))
- (move-marker gnorb-return-marker (point))
- (delete-other-windows)
- (org-id-goto (car tracked-headings)))))
-
-(defun gnorb-gnus-startup ()
- (add-hook 'gnus-select-article-hook #'gnorb-gnus-hint-relevant-message)
- (add-hook 'gnus-summary-prepared-hook #'gnorb-gnus-summary-mode-hook))
-
-(add-hook 'gnus-started-hook #'gnorb-gnus-startup)
-
-(defun gnorb-gnus-shutdown ()
- (remove-hook 'gnus-select-article-hook #'gnorb-gnus-hint-relevant-message)
- (remove-hook 'gnus-summary-prepared-hook #'gnorb-gnus-summary-mode-hook))
-
-(gnus-add-shutdown #'gnorb-gnus-shutdown 'gnus)
-
-(provide 'gnorb-gnus)
-;;; gnorb-gnus.el ends here
diff --git a/packages/gnorb/gnorb-helm.el b/packages/gnorb/gnorb-helm.el
deleted file mode 100644
index f58f604..0000000
--- a/packages/gnorb/gnorb-helm.el
+++ /dev/null
@@ -1,109 +0,0 @@
-;;; gnorb-helm.el --- Interface between Helm and Gnorb -*- lexical-binding:
t; -*-
-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
-
-;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Convenience functions relying on the helm package.
-
-;;; Code:
-
-(require 'gnorb-gnus)
-(require 'nngnorb)
-(require 'gnorb-utils)
-
-(declare-function 'helm-make-source "ext:helm-source")
-(declare-function 'helm "ext:helm")
-(declare-function 'helm-marked-candidates "ext:helm")
-
-(defun gnorb-helm-gnus-registry-candidates ()
- "Return a list of candidates from the Gnus registry."
- (let ((check
- (when (or gnus-ignored-from-addresses
- message-alternative-emails)
- (cond ((functionp gnus-ignored-from-addresses)
- (lambda (adr) (funcall gnus-ignored-from-addresses adr)))
- ((stringp gnus-ignored-from-addresses)
- (lambda (adr)
- (string-match-p
- gnus-ignored-from-addresses adr)))
- ((functionp message-alternative-emails)
- (lambda (adr) (funcall message-alternative-emails adr)))
- ((stringp message-alternative-emails)
- (lambda (adr)
- (string-match-p
- message-alternative-emails adr))))))
- ret from recipient subject group)
- (maphash
- (lambda (msg-id data)
- (when (setq group (car-safe (cdr (assoc 'group data)))
- from (car-safe (cdr (assoc 'sender data)))
- subject (car-safe (cdr (assoc 'subject data)))
- recipient (cdr (assoc 'recipient data)))
- (push (cons (format
- "%s: %s" ; display
- (if (and check
- (funcall check from))
- (concat
- "To: " (mapconcat #'identity recipient " "))
- from)
- subject)
- (cons msg-id group)) ; real
- ret)))
- (slot-value gnus-registry-db 'data))
- ret))
-
-;;;###autoload
-(defun gnorb-helm-search-registry ()
- "Use helm and the Gnus registry to search messages."
- (interactive)
- (require 'helm)
- (unless (gnus-alive-p)
- (error "Gnus is not running"))
- (unless gnus-registry-enabled
- (error "The Gnus registry is not enabled"))
- (let* ((msgs (helm :sources
- (helm-make-source "Gnus Registry" 'helm-source-sync
- :candidates #'gnorb-helm-gnus-registry-candidates
- :action (lambda (&rest _ignored)
(helm-marked-candidates)))
- :buffer "*helm Gnus Registry*"))
- (server (gnorb-gnus-find-gnorb-server))
- (artlist
- (mapcar
- (lambda (msg)
- (pcase-let ((`(,group . ,artno) (gnorb-msg-id-request-head
- (car msg) (cdr msg))))
- (when (and artno (integerp artno) (> artno 0))
- (vector group artno 100))))
- msgs))
- (name (make-temp-name "registry messages"))
- (spec (list
- (cons 'nnir-specs (list (cons 'nnir-query-spec
- `((query . "dummy")
- (articles . ,artlist)))
- (cons 'nnir-group-spec
- `((,server ,(list name))))))
- (cons 'nnir-artlist nil))))
- (when msgs
- (switch-to-buffer gnus-group-buffer)
- (gnus-group-read-ephemeral-group
- name `(nnir ,server) nil `(switch-to-buffer ,gnus-group-buffer)
- nil nil spec))))
-
-(provide 'gnorb-helm)
-;;; gnorb-helm.el ends here
diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el
deleted file mode 100644
index 77594d8..0000000
--- a/packages/gnorb/gnorb-org.el
+++ /dev/null
@@ -1,837 +0,0 @@
-;;; gnorb-org.el --- The Org-centric functions of gnorb -*- lexical-binding: t
-*-
-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
-
-;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
-
-;; 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:
-
-(require 'gnorb-utils)
-(eval-when-compile (require 'cl-lib))
-
-(defvar gnorb-bbdb-posting-styles)
-(defvar gnorb-bbdb-org-tag-field)
-(defvar bbdb-buffer-name)
-(defvar message-alternative-emails)
-(defvar bbdb-records)
-
-(autoload 'gnorb-bbdb-configure-posting-styles "gnorb-bbdb")
-(autoload 'gnorb-registry-org-id-search "gnorb-registry")
-(autoload 'bbdb-completing-read-record "bbdb-com")
-(autoload 'bbdb-record-name "bbdb")
-(autoload 'bbdb-message-search "bbdb-com")
-(autoload 'bbdb-mail-address "bbdb-com")
-(autoload 'bbdb-record-xfield "bbdb")
-(autoload 'bbdb-records "bbdb")
-(autoload 'bbdb-search "bbdb-com")
-(autoload 'bbdb-display-records "bbdb")
-
-(defgroup gnorb-org nil
- "The Org bits of Gnorb."
- :tag "Gnorb Org"
- :group 'gnorb)
-
-(defcustom gnorb-org-after-message-setup-hook nil
- "Hook run in a message buffer after setting up the message from
- `gnorb-org-handle-mail' or `gnorb-org-email-subtree'."
- :type 'hook)
-
-(defcustom gnorb-org-trigger-actions
- '((?t "todo state" todo)
- (?n "take note" note)
- (?d "don't associate" no-associate)
- (?o "only associate" associate)
- (?c "capture to child" cap-child)
- (?s "capture to sibling" cap-sib))
- "List of potential actions that can be taken on headings.
-
-When triggering an Org heading after receiving or sending a
-message, this option lists the possible actions to take. Built-in
-actions include:
-
-todo state: Associate the message, and change TODO state.
-take note: Associate the message, and take a note.
-don't associate: Do nothing at all, don't connect the message and TODO.
-only associate: Associate the message with this heading, do nothing else.
-capture to child: Associate this message with a new child heading.
-capture to sibling: Associate this message with a new sibling heading.
-
-You can reorder this list or remove items as suits your workflow.
-The two \"capture\" options will use the value of
-`gnorb-gnus-new-todo-capture-key' to find the appropriate
-template.
-
-You can also add custom actions to the list. Actions should be a
-list of three elements: a character key, a string tag and a
-symbol indicating a custom function. The custom function will be
-called on the heading in question, and passed a plist containing
-information about the message from which we're triggering."
-
- :type 'list
- :package-version '(gnorb . "1.1.3"))
-
-(defcustom gnorb-org-log-add-link t
- "When non-nil, add a message link in a heading's LOGBOOK.
-When triggering an Org heading from a message, and adding a log
-note, the message id will be added to the text of the log note.
-When later viewing the messages, call `gnorb-org-view' with point
-on a particular logbook item to automatically go to the linked
-message."
- :type 'boolean)
-
-(defcustom gnorb-org-msg-id-key "GNORB_MSG_ID"
- "The name of the org property used to store the Message-IDs
- from relevant messages. This is no longer used, and will be
- removed soon."
- :type 'string)
-
-(defcustom gnorb-org-mail-scan-scope 2
- "Number of paragraphs to scan for mail-related links.
-
-Or set to 'all to scan the whole subtree.
-
-When handling a TODO heading with `gnorb-org-handle-mail', Gnorb
-will typically reply to the most recent message associated with
-this heading. If there are no such messages, or message tracking
-is disabled entirely, or `gnorb-org-handle-mail' has been called
-with a prefix arg, the heading and body text of the subtree under
-point will instead be scanned for gnus:, mailto:, and bbdb:
-links. This option controls how many paragraphs of body text to
-scan. Set to 0 to only look in the heading."
- :type '(choice (const :tag "Whole subtree" all)
- (integer :tag "Number of paragraphs")))
-
-(make-obsolete-variable
- 'gnorb-org-mail-scan-strategies
- "This variable has been superseded by `gnorb-org-trigger-actions'"
- "September 12, 2014" 'set)
-
-(make-obsolete-variable
- 'gnorb-org-mail-scan-state-changes
- "This variable has been superseded by `gnorb-org-trigger-actions'"
- "September 12, 2014" 'set)
-
-(make-obsolete-variable
- 'gnorb-org-mail-scan-function
- "This variable has been superseded by `gnorb-org-trigger-actions'"
- "September 12, 2014" 'set)
-
-(defcustom gnorb-org-find-candidates-match nil
- "When scanning all org files for heading related to an incoming
-message, this option will limit which headings will be offered as
-target candidates. Specifically it will be used as the second
-argument to `org-map-entries', and syntax is the same as that
-used in an agenda tags view."
- :type 'symbol)
-
-;;;###autoload
-(defun gnorb-org-contact-link (rec)
- "Prompt for a BBDB record and insert a link to that record at
-point.
-
-There's really no reason to use this instead of regular old
-`org-insert-link' with BBDB completion. But there might be in the
-future!"
- ;; this needs to handle an active region.
- (interactive (list (bbdb-completing-read-record "Record: ")))
- (let* ((name (bbdb-record-name rec))
- (link (concat "bbdb:" (org-link-escape name))))
- (org-store-link-props :type "bbdb" :name name
- :link link :description name)
- (if (called-interactively-p 'any)
- (insert (format "[[%s][%s]]" link name))
- link)))
-
-(defun gnorb-org-restore-after-send ()
- "After an email is sent, go through all the org ids that might
-have been in the outgoing message's headers and call
-`gnorb-trigger-todo-action' on each one, then put us back where
-we came from."
- (delete-other-windows)
- (dolist (id gnorb-message-org-ids)
- (org-id-goto id)
- (gnorb-trigger-todo-action nil id))
- ;; this is a little unnecessary, but it may save grief
- (setq gnorb-gnus-message-info nil)
- (setq gnorb-message-org-ids nil)
- (gnorb-restore-layout))
-
-(defun gnorb-org-extract-links (&optional _arg region)
- "See if there are viable links in the subtree under point."
- ;; We're not currently using the arg. What could we do with it?
- (let (strings)
- ;; If the region was active, only use the region
- (if region
- (push (buffer-substring (car region) (cdr region))
- strings)
- ;; Otherwise collect the heading text, and all the paragraph
- ;; text.
- (save-restriction
- (org-narrow-to-subtree)
- (let ((head (org-element-at-point))
- (tree (org-element-parse-buffer)))
- (push (org-element-property
- :raw-value
- head)
- strings)
- (org-element-map tree '(paragraph drawer)
- (lambda (p)
- (push (org-element-interpret-data p)
- strings))
- nil nil 'drawer))))
- (when strings
- ;; Limit number of paragraphs based on
- ;; `gnorb-org-mail-scan-scope'
- (setq strings
- (cond ((eq gnorb-org-mail-scan-scope 'all)
- strings)
- ((numberp gnorb-org-mail-scan-scope)
- (cl-subseq
- (reverse strings)
- 0 (min
- (length strings)
- (1+ gnorb-org-mail-scan-scope))))
- ;; We could provide more options here. 'tree vs
- ;; 'subtree, for instance.
- (t
- strings)))
- (with-temp-buffer
- (dolist (s strings)
- (insert s)
- (insert "\n"))
- (goto-char (point-min))
- (gnorb-scan-links (point-max) 'gnus 'mailto 'bbdb 'ebdb)))))
-
-(defun gnorb-org-extract-mail-stuff (&optional arg region)
- "Decide how to hande the Org heading under point as an email task.
-
-See the docstring of `gnorb-org-handle-mail' for details."
- (if (or (not gnorb-tracking-enabled)
- region)
- (gnorb-org-extract-links arg region)
- ;; Get all the messages associated with the IDS in this subtree.
- (let ((assoc-msg-ids
- (delete-dups
- (cl-mapcan
- (lambda (id)
- (gnorb-registry-org-id-search id))
- (gnorb-collect-ids)))))
- (gnorb-org-extract-mail-tracking assoc-msg-ids arg region))))
-
-(defun gnorb-user-address-match-p (addr)
- "Return t if ADDR seems to match the user's email address."
- (cond
- ((stringp message-alternative-emails)
- (string-match-p message-alternative-emails
- addr))
- ((functionp message-alternative-emails)
- (funcall message-alternative-emails addr))
- (user-mail-address
- (string-match-p user-mail-address addr))))
-
-;; FIXME: Why did I break this off from
-;; `gnorb-org-extract-mail-stuff'? It's only called from there, and
-;; it's confusing to have them separate.
-(defun gnorb-org-extract-mail-tracking (assoc-msg-ids &optional arg region)
- "Return tracked mail links for the current Org subtree.
-ASSOC-MSG-IDS is a list of message-ids that have already been
-determined to be tracked by the subtree. Return the most recent
-of these, as a candidate for composing a reply. If there are no
-tracked messages, or if ARG (a prefix arg from earlier) is
-non-nil, ignore these tracked ids and instead scan the
-subtree (or REGION) for links, and use those instead."
- (let* ((all-links (gnorb-org-extract-links nil region))
- ;; The latest (by the creation-time registry key) of all the
- ;; tracked messages that were not sent by our user.
- (latest-msg-id
- (when assoc-msg-ids
- (car
- (sort
- (cl-remove-if-not
- (lambda (m)
- (let ((from (car (gnus-registry-get-id-key m 'sender))))
- (not (and from (gnorb-user-address-match-p from)))))
- assoc-msg-ids)
- (lambda (r l)
- (time-less-p
- (car (gnus-registry-get-id-key l 'creation-time))
- (car (gnus-registry-get-id-key r 'creation-time))))))))
- (msg-id-link
- (when latest-msg-id
- (gnorb-msg-id-to-link latest-msg-id))))
- (cond
- ;; If there are no tracked messages, or the user has specifically
- ;; requested we ignore them with the prefix arg, just return the
- ;; found links in the subtree.
- ((or arg
- (null msg-id-link))
- all-links)
- ;; Otherwise ignore the other links in the subtree, and return
- ;; the latest message.
- (msg-id-link
- `((gnus ,msg-id-link))))))
-
-(defvar message-beginning-of-line)
-
-(defun gnorb-org-setup-message
- (&optional messages mails from cc bcc attachments text ids noprompt)
- "Common message setup routine for other gnorb-org commands.
-MESSAGES is a list of gnus links pointing to messages -- we
-currently only use the first of the list. MAILS is a list of
-email address strings suitable for inserting in the To header.
-ATTACHMENTS is a list of filenames to attach. TEXT is a string or
-buffer, which is inserted in the message body. IDS is one or more
-Org heading ids, associating the outgoing message with those
-headings."
- (require 'gnorb-gnus)
- (if (not messages)
- ;; Either compose new message...
- (compose-mail)
- ;; ...or follow link and start reply.
- (condition-case err
- (gnorb-reply-to-gnus-link (car messages))
- (error (gnorb-restore-layout)
- (signal (car err) (cdr err)))))
- ;; Add MAILS to message To header.
- (when mails
- (message-goto-to)
- (when messages
- (insert ", "))
- (insert (mapconcat 'identity mails ", ")))
- ;; Commenting this out because
- ;; `gnorb-gnus-check-outgoing-headers' is set unconditionally in the
- ;; `message-send-hook, so this should be redundant. Also, we've
- ;; switched to using message-send-actions.
-
- ;; (add-to-list
- ;; 'message-exit-actions 'gnorb-org-restore-after-send t) Set
- ;; headers from MAIL_* properties (from, cc, and bcc).
- (cl-flet ((sh (h)
- (when (cdr h)
- (funcall (intern (format "message-goto-%s" (car h))))
- (let ((message-beginning-of-line t)
- (show-trailing-whitespace t))
- (message-beginning-of-header t)
- (insert (cdr h))))))
- (dolist (h `((from . ,from) (cc . ,cc) (bcc . ,bcc)))
- (sh h)))
- ;; attach ATTACHMENTS
- (if noprompt
- (dolist (a attachments)
- (mml-attach-file a (mm-default-file-encoding a)
- nil "attachment"))
- (map-y-or-n-p
- (lambda (a) (format "Attach %s to outgoing message? "
- (file-name-nondirectory a)))
- (lambda (a)
- (mml-attach-file a (mm-default-file-encoding a)
- nil "attachment"))
- attachments
- '("file" "files" "attach")))
- ;; insert text, if any
- (when text
- (message-goto-body)
- (if (bufferp text)
- (insert-buffer-substring text)
- (insert text)))
- ;; insert org ids, if any
- (when ids
- (unless (listp ids)
- (setq ids (list ids)))
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (dolist (i ids)
- (goto-char (point-at-bol))
- (open-line 1)
- ;; this function hardly does anything
- (message-insert-header
- (intern gnorb-mail-header) i)))))
- ;; put point somewhere reasonable
- (if (or mails messages)
- (if (not messages)
- (message-goto-subject)
- (message-goto-body))
- (message-goto-to))
- (run-hooks 'gnorb-org-after-message-setup-hook))
-
-(defun gnorb-org-attachment-list (&optional id)
- "Get a list of files (absolute filenames) attached to the
-current heading, or the heading indicated by optional argument ID."
- (when (featurep 'org-attach)
- (let* ((attach-dir (save-excursion
- (when id
- (org-id-goto id))
- (org-attach-dir t)))
- (files
- (mapcar
- (lambda (f)
- (expand-file-name f attach-dir))
- (org-attach-file-list attach-dir))))
- files)))
-
-(defvar message-mode-hook)
-
-;;;###autoload
-(defun gnorb-org-handle-mail (arg &optional text file)
- "Handle current headline as a mail TODO.
-How this function behaves depends on whether you're using Gnorb
-for email tracking, also on the prefix ARG, and on the active
-region.
-
-If tracking is enabled and there is no prefix arg, Gnorb will
-begin a reply to the newest associated message that wasn't sent
-by the user -- ie, the Sender header doesn't match
-`user-mail-address' or `message-alternative-emails'.
-
-If tracking is enabled and there is a prefix arg, ignore the
-tracked messages and instead scan the subtree for mail-related
-links. This means links prefixed with gnus:, mailto:, or bbdb:.
-See `gnorb-org-mail-scan-scope' to limit the scope of this scan.
-Do something appropriate with the resulting links.
-
-With a double prefix arg, ignore all tracked messages and all
-links, and compose a blank new message.
-
-If tracking is enabled and you want to reply to a
-specific (earlier) message in the tracking history, use
-`gnorb-org-view' to open an nnir *Summary* buffer containing all
-the messages, and reply to the one you want. Your reply will be
-automatically tracked, as well.
-
-If tracking is not enabled and you want to use a specific link in
-the subtree as a basis for the email action, then put the region
-around that link before you call this message.
-
-TEXT is text to insert into the body of the message being
-composed. FILE is a file to attach to the message."
- (interactive "P")
- (setq gnorb-window-conf (current-window-configuration))
- (move-marker gnorb-return-marker (point))
- (when (eq major-mode 'org-agenda-mode)
- ;; If this is all the different types, we could skip the check.
- (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
- (org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (switch-to-buffer buffer)
- (widen)
- (goto-char pos)))
- (let ((region
- (when (use-region-p)
- (car (region-bounds)))))
- (deactivate-mark)
- (save-excursion
- (unless (org-back-to-heading t)
- (error "Not in an org item"))
- (cl-flet ((mp (p) (org-entry-get (point) p t)))
- ;; Double prefix means ignore everything and compose a blank
- ;; mail.
- (let* ((links (unless (equal arg '(16))
- (gnorb-org-extract-mail-stuff arg region)))
- (attachments (gnorb-org-attachment-list))
- (from (mp "MAIL_FROM"))
- (cc (mp "MAIL_CC"))
- (bcc (mp "MAIL_BCC"))
- (org-id (org-id-get-create))
- (b-recs (alist-get 'bbdb links))
- (e-recs (alist-get 'ebdb links))
- (message-mode-hook (copy-sequence message-mode-hook))
- mails)
- (when file
- (setq attachments (cons file attachments)))
- (when (fboundp 'ebdb-org-retrieve)
- (dolist (e e-recs)
- (dolist (r (ebdb-org-retrieve e))
- (let ((m (ebdb-dwim-mail r)))
- (when m
- (push m mails))))))
- (dolist (b b-recs)
- (let ((m (bbdb-mail-address
- (car (bbdb-message-search
- (org-link-unescape b))))))
- (when m
- (push m mails))))
- (when (and b-recs
- gnorb-bbdb-posting-styles)
- (add-hook 'message-mode-hook
- (lambda ()
- (gnorb-bbdb-configure-posting-styles (cdr b-recs))
- (gnorb-bbdb-configure-posting-styles (list (car
b-recs))))))
- (gnorb-org-setup-message
- (alist-get 'gnus links)
- (append mails (alist-get 'mailto links))
- from cc bcc
- attachments text org-id))))))
-
-;;; Email subtree
-
-(defcustom gnorb-org-email-subtree-text-parameters nil
- "A plist of export parameters corresponding to the EXT-PLIST
- argument to the export functions, for use when exporting to
- text."
- :group 'gnorb-org
- :type 'boolean)
-
-(defcustom gnorb-org-email-subtree-file-parameters nil
- "A plist of export parameters corresponding to the EXT-PLIST
- argument to the export functions, for use when exporting to a
- file."
- :group 'gnorb-org
- :type 'boolean)
-
-(defcustom gnorb-org-email-subtree-text-options '(nil t nil t)
- "A list of ts and nils corresponding to Org's export options,
-to be used when exporting to text. The options, in order, are
-async, subtreep, visible-only, and body-only."
- :group 'gnorb-org
- :type 'list)
-
-(defcustom gnorb-org-email-subtree-file-options '(nil t nil nil)
- "A list of ts and nils corresponding to Org's export options,
-to be used when exporting to a file. The options, in order, are
-async, subtreep, visible-only, and body-only."
- :group 'gnorb-org
- :type 'list)
-
-(defcustom gnorb-org-export-extensions
- '((latex ".tex")
- (ascii ".txt")
- (html ".html")
- (org ".org")
- (icalendar ".ics")
- (man ".man")
- (md ".md")
- (odt ".odt") ; not really, though
- (texinfo ".texi")
- (beamer ".tex"))
- "Correspondence between export backends and their
-respective (usual) file extensions. Ugly way to do it, but what
-the hey..."
- :group 'gnorb-org
- :type '(repeat
- (list symbol string)))
-
-(defvar org-export-show-temporary-export-buffer)
-
-;;;###autoload
-(defun gnorb-org-email-subtree (&optional arg)
- "Call on a subtree to export it either to a text string or a file,
-then compose a mail message either with the exported text
-inserted into the message body, or the exported file attached to
-the message.
-
-Export options default to the following: When exporting to a
-buffer: async = nil, subtreep = t, visible-only = nil, body-only
-= t. Options are the same for files, except body-only is set to
-nil. Customize `gnorb-org-email-subtree-text-options' and
-`gnorb-org-email-subtree-file-options', respectively.
-
-Customize `gnorb-org-email-subtree-parameters' to your preferred
-default set of parameters."
- ;; I sure would have liked to use the built-in dispatch ui, but it's
- ;; got too much hard-coded stuff.
- (interactive "P")
- (org-back-to-heading t)
- (let* ((bkend-var
- (if (boundp 'org-export--registered-backends)
- org-export--registered-backends
- org-export-registered-backends))
- (backend-string
- (org-completing-read
- "Export backend: "
- (mapcar (lambda (b)
- (symbol-name (org-export-backend-name b)))
- bkend-var)
- nil t))
- (backend-symbol (intern backend-string))
- (f-or-t (org-completing-read "Export as file or text? "
- '("file" "text") nil t))
- (org-export-show-temporary-export-buffer nil)
- (opts (if (equal f-or-t "text")
- gnorb-org-email-subtree-text-options
- gnorb-org-email-subtree-file-options))
- (result
- (if (equal f-or-t "text")
- (apply 'org-export-to-buffer
- `(,backend-symbol
- "*Gnorb Export*"
- ,@opts
- ,gnorb-org-email-subtree-text-parameters))
- (if (eq backend-symbol 'odt)
- ;; Need to special-case odt output, as it does too
- ;; many clever things. The only downside to this is
- ;; it's impossible to put the exported file in the
- ;; /tmp/ directory -- it will go wherever it would
- ;; have gone with manual export.
- (apply #'org-odt-export-to-odt
- (append (cl-subseq gnorb-org-email-subtree-file-options
0 3)
- (list gnorb-org-email-subtree-file-parameters)))
- (apply 'org-export-to-file
- `(,backend-symbol
- ,(org-export-output-file-name
- (cl-second (assoc backend-symbol
gnorb-org-export-extensions))
- t gnorb-tmp-dir)
- ,@opts
- ,gnorb-org-email-subtree-file-parameters)))))
- text file)
- (if (bufferp result)
- (setq text result)
- (setq file result))
- (gnorb-org-handle-mail arg text file)))
-
-(defcustom gnorb-org-capture-collect-link-p t
- "Should the capture process store a link to the gnus message or
- BBDB record under point, even if it's not part of the template?
- You'll probably end up needing it, anyway."
- :group 'gnorb-org
- :type 'boolean)
-
-(defun gnorb-org-capture-function ()
- "Do various things after starting the capture process.
-Currently includes:
-
-1. Offering to move all the attachments from the message we
-captured from onto the Org heading being captured.
-
-2. Possibly saving a link to wherever we came from (see
-`gnorb-org-capture-collect-link-p').
-
-3. Possibly saving the text of the message we captured from (see
-`gnorb-gnus-copy-message-text').
-
-4. Possibly ticking the message we captured from (see
-`gnorb-gnus-tick-all-tracked-messages')."
- (when gnorb-org-capture-collect-link-p
- (let ((buf (org-capture-get :original-buffer)))
- (when buf
- (with-current-buffer buf
- (when (memq major-mode '(gnus-summary-mode
- gnus-article-mode
- bbdb-mode
- ebdb-mode))
- (call-interactively 'org-store-link))))))
- (when (with-current-buffer
- (org-capture-get :original-buffer)
- (memq major-mode '(gnus-summary-mode gnus-article-mode)))
- ;; This part needs to happen in the capture buffer.
- (when (or gnorb-gnus-capture-always-attach
- (org-capture-get :gnus-attachments))
- (require 'org-attach)
- (setq gnorb-gnus-capture-attachments nil)
- (gnorb-gnus-collect-all-attachments t)
- (map-y-or-n-p
- (lambda (a)
- (format "Attach %s to capture heading? "
- (file-name-nondirectory a)))
- (lambda (a) (org-attach-attach a nil 'mv))
- gnorb-gnus-capture-attachments
- '("file" "files" "attach"))
- (setq gnorb-gnus-capture-attachments nil))
-
- ;; This part happens in the original summary/article buffer.
- (save-window-excursion
- (set-buffer (org-capture-get :original-buffer))
- (let ((art-no (gnus-summary-article-number)))
-
- (when gnorb-gnus-copy-message-text
- (gnus-with-article-buffer
- (article-goto-body)
- (if (numberp gnorb-gnus-copy-message-text)
- (progn
- (copy-to-register
- gnorb-gnus-copy-message-text
- (point) (point-max))
- (message "Message text copied to register %c"
- gnorb-gnus-copy-message-text))
- (kill-new (buffer-substring (point) (point-max)))
- (message "Message text copied to kill ring"))))
-
- (when gnorb-gnus-tick-all-tracked-messages
- (gnus-summary-mark-article art-no gnus-ticked-mark))
-
- (gnus-summary-update-article art-no)))))
-
-(add-hook 'org-capture-mode-hook 'gnorb-org-capture-function)
-
-(defvar org-note-abort)
-
-(defun gnorb-org-capture-abort-cleanup ()
- (with-no-warnings ;; For `org-note-abort'
- (when (and org-note-abort
- (or (bound-and-true-p gnorb-gnus-capture-always-attach)
- (org-capture-get :gnus-attachments)))
- (condition-case nil
- (progn (org-attach-delete-all)
- (setq abort-note 'clean)
- ;; remove any gnorb-mail-header values here
- )
- (error
- (setq abort-note 'dirty))))))
-
-(add-hook 'org-capture-prepare-finalize-hook
- 'gnorb-org-capture-abort-cleanup)
-
-;;; Agenda/BBDB popup stuff
-
-(defcustom gnorb-org-agenda-popup-bbdb nil
- "Should Agenda tags search pop up a BBDB buffer with matching
- records?
-
-Records are considered matching if they have an `org-tags' field
-matching the current Agenda search. The name of that field can be
-customized with `gnorb-bbdb-org-tag-field'."
- :group 'gnorb-org
- :type 'boolean)
-
-(defcustom gnorb-org-bbdb-popup-layout 'pop-up-multi-line
- "Default BBDB buffer layout for automatic Org Agenda display."
- :group 'gnorb-org
- :type '(choice (const one-line)
- (const multi-line)
- (const full-multi-line)
- (symbol)))
-
-(defun gnorb-org-munge-agenda-query-string (str)
- "Remove all non-tag search terms from query string STR.
-Returns a lambda form used for matching a search string (ie, the
-`cdr' of `org-make-tags-matcher')."
- ;; I was hoping to use `org-make-tags-matcher' directly, then snag
- ;; the tagmatcher from the resulting value, but there doesn't seem
- ;; to be a reliable way of only getting the tag-related returns. But
- ;; I'd still like to use that function. So an ugly hack to first
- ;; remove non-tag contents from the query string, and then make a
- ;; new call to `org-make-tags-matcher'.
- (let ((org--matcher-tags-todo-only nil)
- (re
"^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")
- (or-terms (org-split-string str "|"))
- term rest out-or acc)
- (while (setq term (pop or-terms))
- (setq acc nil)
- (while (string-match re term)
- (setq rest (substring term (match-end 0)))
- (let ((sub-term (match-string 0 term)))
- ;; This isn't a tag, we don't want it.
- (unless (string-match-p "\\([<>=]\\)" sub-term)
- (push sub-term acc))
- (setq term rest)))
- (push (mapconcat 'identity (nreverse acc) "") out-or))
- (setq str (mapconcat 'identity (nreverse out-or) "|"))
- (cdr (org-make-tags-matcher str))))
-
-;;;###autoload
-(defun gnorb-org-popup-bbdb (&optional str)
- "In an `org-tags-view' Agenda buffer, pop up a BBDB buffer
-showing records whose `org-tags' field matches the current tags
-search."
- (interactive)
- (require 'gnorb-bbdb)
- (let (recs)
- (cond ((and
- (and (eq major-mode 'org-agenda-mode)
- (eq org-agenda-type 'tags))
- (or (called-interactively-p 'any)
- gnorb-org-agenda-popup-bbdb))
- (let ((tag-clause (gnorb-org-munge-agenda-query-string
- (or str org-agenda-query-string))))
- (unless (equal str "")
- (setq recs
- (cl-remove-if-not
- (lambda (r)
- (let ((rec-tags (bbdb-record-xfield
- r gnorb-bbdb-org-tag-field)))
- (and rec-tags
- (let ((tags-list (if (stringp rec-tags)
- (org-split-string rec-tags
":")
- rec-tags))
- (case-fold-search t)
- (org-trust-scanner-tags t))
- ;; This is bad, we're lexically bound, now.
- (funcall tag-clause t tags-list 1)))))
- (bbdb-records))))))
- ((eq major-mode 'org-mode)
- (save-excursion
- (org-back-to-heading)
- (let ((bound (org-element-property
- :end (org-element-at-point)))
- desc rec)
- (while (re-search-forward org-link-any-re bound t)
- (when (string-match-p "bbdb" (car (split-string
- (match-string 2) ":")))
- (setq desc (match-string 3)
- rec (bbdb-search (bbdb-records) desc desc desc)
- recs (append recs rec))))))))
- (if recs
- (bbdb-display-records
- recs gnorb-org-bbdb-popup-layout)
- (when (get-buffer-window bbdb-buffer-name)
- (quit-window nil
- (get-buffer-window bbdb-buffer-name)))
- (when (called-interactively-p 'any)
- (message "No relevant BBDB records")))))
-
-(if (featurep 'gnorb-bbdb)
- (add-hook 'org-agenda-finalize-hook 'gnorb-org-popup-bbdb))
-
-;;; Groups from the gnorb gnus server backend
-
-;;;###autoload
-(defun gnorb-org-view (arg)
- "Search the subtree at point for links to gnus messages, and
-then show them in an ephemeral group, in Gnus.
-
-With a prefix arg, create a search group that will persist across
-Gnus sessions, and can be refreshed.
-
-This won't work unless you've added a \"nngnorb\" server to
-your gnus select methods."
- ;; this should also work on the active region, if there is one.
- (interactive "P")
- (require 'gnorb-gnus)
- (setq gnorb-window-conf (current-window-configuration))
- (move-marker gnorb-return-marker (point))
- (when (eq major-mode 'org-agenda-mode)
- (org-agenda-check-type t 'agenda 'timeline 'todo 'tags)
- (org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (switch-to-buffer buffer)
- (goto-char pos)
- (org-reveal)))
- (let (id)
- (save-excursion
- (org-back-to-heading)
- (setq id (concat "id+" (org-id-get-create)))
- (gnorb-gnus-search-messages
- id arg
- (replace-regexp-in-string
- org-bracket-link-regexp "\\3"
- (nth 4 (org-heading-components)))
- `(when (and (window-configuration-p gnorb-window-conf)
- gnorb-return-marker)
- (set-window-configuration gnorb-window-conf)
- (goto-char gnorb-return-marker))))))
-
-(provide 'gnorb-org)
-;;; gnorb-org.el ends here
diff --git a/packages/gnorb/gnorb-registry.el b/packages/gnorb/gnorb-registry.el
deleted file mode 100644
index 3adc0cb..0000000
--- a/packages/gnorb/gnorb-registry.el
+++ /dev/null
@@ -1,343 +0,0 @@
-;;; gnorb-registry.el --- Registry implementation for Gnorb -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
-
-;; Author: Eric Abrahamsen <eric@ericabrahamsen.net.>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Early on, Gnorb's message/todo tracking was done by relying on the
-;; user to insert links to received messages into an Org heading, and
-;; by automatically storing the Message-Ids of sent messages in a
-;; property (`gnorb-org-msg-id-key', defaulting to GNORB_MSG_ID) on
-;; the same heading. The heading could find all relevant messages by
-;; combining the links (incoming) and the IDs of the Gnorb-specific
-;; property (outgoing).
-;;
-;; In the end, this proved to be fragile and messy. Enter the
-;; registry. The Gnus registry is a specialization of a general
-;; "registry" library -- it's possible to roll your own. If you want
-;; to track connections between messages and Org headings, it's an
-;; obvious choice: Each relevant message is stored in the registry,
-;; keyed on its Message-ID, and the org-ids of all relevant headings
-;; are stored in a custom property, in our case gnorb-ids. This allows
-;; us to keep all Gnorb-specific data in one place, without polluting
-;; Org files or Gnus messages, persistent on disk, and with the added
-;; bonus of providing a place to keep arbitrary additional metadata.
-;;
-;; The drawback is that the connections are no longer readily visible
-;; to the user (they need to query the registry to see them), and it
-;; becomes perhaps a bit more difficult (but only a bit) to keep
-;; registry data in sync with the current state of the user's Gnus and
-;; Org files. But a clear win, in the end.
-
-;;; Code:
-
-(require 'gnus-registry)
-(require 'gnorb-utils)
-(require 'cl-lib)
-(eval-when-compile (require 'subr-x))
-
-(defgroup gnorb-registry nil
- "Gnorb's use of the Gnus registry."
- :tag "Gnorb Registry"
- :group 'gnorb)
-
-(defun gnorb-registry-make-entry (msg-id sender subject org-id group)
- "Create a Gnus registry entry for a message, either received or
-sent. Save the relevant Org ids in the 'gnorb-ids key."
- ;; This set-id-key stuff is actually horribly
- ;; inefficient.
- (when gnorb-tracking-enabled
- (gnus-registry-get-or-make-entry msg-id)
- (when sender
- (gnus-registry-set-id-key msg-id 'sender (list sender)))
- (when subject
- (gnus-registry-set-id-key msg-id 'subject (list subject)))
- (when org-id
- (let ((ids (gnus-registry-get-id-key msg-id 'gnorb-ids)))
- (unless (member org-id ids)
- (gnus-registry-set-id-key msg-id 'gnorb-ids (if (stringp org-id)
- (cons org-id ids)
- (append org-id ids))))))
- (when group
- (gnus-registry-set-id-key msg-id 'group (list group)))
- (gnus-registry-get-or-make-entry msg-id)))
-
-(defun gnorb-registry-get-id-key (id key)
- "Get value of symbol KEY for ID's entry in the registry.
-Works just like `gnus-registry-get-id-key', but doesn't create an
-entry if it doesn't exist already."
- (cdr-safe
- (assq key (nth 1 (assoc id (registry-lookup
- gnus-registry-db (list id)))))))
-
-(defun gnorb-registry-capture ()
- "When capturing from a Gnus message, add our new Org heading id
-to the message's registry entry, under the `gnorb-ids' key."
- ;; We're called by org-capture.
- (declare-function org-capture-get "org-capture" (prop &optional local))
- (defvar org-capture-plist)
- (let ((orig-buff (org-capture-get :original-buffer)))
- (when (and (buffer-live-p orig-buff)
- (with-current-buffer
- orig-buff
- (memq major-mode '(gnus-summary-mode gnus-article-mode)))
- (not org-note-abort))
- (let* ((msg-id
- (gnorb-bracket-message-id
- (plist-get org-store-link-plist :message-id)))
- (org-id (org-id-get-create)))
- (plist-put org-capture-plist :gnorb-id org-id)
- (gnorb-registry-make-entry msg-id nil nil org-id nil)))))
-
-(defun gnorb-find-visit-candidates (ids &optional include-zombies)
- "For all message-ids in IDS (which should be a list of
-Message-ID strings, with angle brackets, or a single string of
-Message-IDs), produce a list of Org ids for headings that are
-relevant to that message.
-
-If optional argument INCLUDE_ZOMBIES is non-nil, return ID values
-even for headings that appear to no longer exist."
- (let (ret-val sub-val)
- (when (stringp ids)
- (setq ids (gnus-extract-references ids)))
- (when gnorb-tracking-enabled
- (setq ids (delete-dups ids))
- (progn
- (dolist (id ids)
- (when
- (setq sub-val
- (gnorb-registry-get-id-key id 'gnorb-ids))
- (setq ret-val (append sub-val ret-val))))))
- ;; This lets us be reasonably confident that the
- ;; headings still exist.
- (unless include-zombies
- (cl-remove-if-not
- (lambda (org-id)
- (org-id-find-id-file org-id))
- ret-val))
- (delete-dups ret-val)))
-
-(defun gnorb-delete-association (msg-id org-id)
- "Disassociate a message and a headline.
-
-This removes an Org heading's ORG-ID from the `gnorb-ids' key of
-the MSG-ID."
- (let ((org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids)))
- (when (member org-id org-ids)
- (gnus-registry-set-id-key msg-id 'gnorb-ids
- (remove org-id org-ids)))))
-
-(defun gnorb-delete-all-associations (org-id)
- "Delete all message associations for an Org heading.
-
-The heading is identified by ORG-ID. This is suitable for use
-after an Org heading is deleted, for instance."
- (let ((assoc-msgs (gnorb-registry-org-id-search org-id))
- (gnorb-id-tracker
- (registry-lookup-secondary gnus-registry-db 'gnorb-ids)))
- (mapc
- (lambda (msg-id)
- (let ((org-ids
- (gnus-registry-get-id-key msg-id 'gnorb-ids)))
- (gnus-registry-set-id-key
- msg-id 'gnorb-ids (remove org-id org-ids))))
- assoc-msgs)
- (remhash org-id gnorb-id-tracker)))
-
-(defun gnorb-flush-dead-associations (&optional clean-archived)
- "Clean the registry of associations with nonexistent headings.
-
-Gnus will not prune registry entries that appear to be associated
-with an Org heading. If your registry is limited to a very small
-size, you may end up with a full registry. Use this function to
-remove dead associations, and free up more entries for possible
-pruning.
-
-By default, associations are considered \"live\" if the Org
-heading exists in an Org file or in an Org archive file. When
-optional CLEAN_ARCHIVED is non-nil, delete associations from
-archived headings as well."
- (interactive "P")
- (let ((gnorb-id-tracker
- (registry-lookup-secondary gnus-registry-db 'gnorb-ids))
- (deleted-count 0))
- (require 'org-id)
- (maphash
- (lambda (k _)
- (let ((file (org-id-find-id-file k)))
- (when (or (not file)
- (and clean-archived
- (string-match-p "org_archive$" file)))
- (gnorb-delete-all-associations k)
- (cl-incf deleted-count))))
- gnorb-id-tracker)
- (message "Deleted %d invalid associations"
- deleted-count)))
-
-(defun gnorb-registry-org-id-search (id)
- "Find all messages that have the org ID in their `gnorb-ids'
-key."
- (registry-search gnus-registry-db :member `((gnorb-ids ,id))))
-
-(defun gnorb-registry-org-tag-search (tag)
- "Find all messages that have the org TAG in `org-tags'."
- (registry-search gnus-registry-db :member `((org-tags ,tag))))
-
-(defun gnorb-registry-tracked-messages ()
- "Return all message-ids that have non-empty `gnorb-ids' keys."
- (registry-search gnus-registry-db :regex `((gnorb-ids ".+"))))
-
-(defun gnorb-registry-tagged-messages ()
- "Return all messages with non-empty `org-tags' keys."
- (registry-search gnus-registry-db :regex `((org-tags ".+"))))
-
-(defun gnorb-registry-tracked-headings ()
- "Return all Org heading ids that are associated with messages."
- (hash-table-keys
- (registry-lookup-secondary gnus-registry-db 'gnorb-ids t)))
-
-(defun gnorb-registry-tracked-tags ()
- "Return all tags that have been used on tracked messages."
- (hash-table-keys
- (registry-lookup-secondary gnus-registry-db 'org-tags t)))
-
-(defun gnorb-report-tracking-usage ()
- "Pop up a temporary window reporting on Gnorb usage of the Gnus
-registry to track message/heading associations. Reports the
-number of tracked messages, the number of tracked headings, any
-tagged messages, and how much of the registry is occupied."
- (interactive)
- (pop-to-buffer
- (get-buffer-create "*Gnorb Usage*")
- '(nil . ((window-height . 10))))
- (gnorb-refresh-usage-status)
- (special-mode)
- (setq revert-buffer-function #'gnorb-refresh-usage-status)
- (local-set-key (kbd "d") (lambda ()
- (interactive)
- (progn
- (gnorb-flush-dead-associations)
- (gnorb-refresh-usage-status))))
- (local-set-key (kbd "D") (lambda ()
- (interactive)
- (progn
- (gnorb-flush-dead-associations t)
- (gnorb-refresh-usage-status)))))
-
-(defun gnorb-refresh-usage-status (&optional _ignore-auto _noconfirm)
- "Clear and re-format the *Gnorb Usage* buffer."
- (let* ((messages (gnorb-registry-tracked-messages))
- (message-num (length messages))
- (headings (gnorb-registry-tracked-headings))
- (heading-num (length headings))
- (tagged (gnorb-registry-tagged-messages))
- (tags (gnorb-registry-tracked-tags))
- (total-occupied (length (delete-dups (append messages tagged))))
- (reg-size (registry-size gnus-registry-db))
- (reg-max-size
- (slot-value gnus-registry-db
- (if (slot-exists-p gnus-registry-db 'max-size)
- 'max-size 'max-hard))))
- (with-current-buffer "*Gnorb Usage*"
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert
- (format
- "Tracking %d Gnus messages associated with %d Org headings."
- message-num heading-num))
- (when tagged
- (insert (format "\n%d tagged messages, with %d tag%s:\n"
- (length tagged)
- (length tags)
- (if (= 1 (length tags)) "" "s")))
- (dolist (tag tags)
- (insert (format "%s\n" tag))))
- (insert "\n\n")
- (insert
- (format
- "Occupying %.2f%% (%d/%d) of the registry (max %d)."
- (* 100 (/ (float total-occupied) reg-size))
- total-occupied reg-size reg-max-size))
- (insert "\n\n")
- (insert "Press 'd' to delete associations for non-existent Org
headings.\n")
- (insert "Press 'D' to delete associations for both non-existent and
archived Org headings.")))))
-
-(defun gnorb-registry-transition-from-props (arg)
- "Helper function for transitioning the old tracking system to the new.
-
-The old system relied on storing sent message ids on relevant Org
-headings, in the `gnorb-org-msg-id-key' property. The new system
-uses the gnus registry to track relations between messages and
-Org headings. This function will go through your agenda files,
-find headings that have the `gnorb-org-msg-id-key' property set,
-and create new registry entries that reflect that connection.
-
-Call with a prefix arg to additionally delete the
-`gnorb-org-msg-id-key' altogether from your Org headings. As this
-function will not create duplicate registry entries, it's safe to
-run it once with no prefix arg, to keep the properties in place,
-and then once you're sure everything's working okay, run it again
-with a prefix arg, to clean the Gnorb-specific properties from
-your Org files."
- (interactive "P")
- (require 'gnorb-org)
- (defvar gnorb-org-find-candidates-match)
- (defvar gnorb-org-msg-id-key)
- (let ((count 0))
- (message "Collecting all relevant Org headings, this could take a
while...")
- (org-map-entries
- (lambda ()
- (let ((id (org-id-get))
- (props (org-entry-get-multivalued-property
- (point) gnorb-org-msg-id-key)))
- (when props
- ;; If the property is set, we should probably assume that any
- ;; Gnus links in the subtree are relevant, and should also be
- ;; collected and associated.
- (let ((links (gnorb-scan-links
- (org-element-property :end (org-element-at-point))
- 'gnus)))
- (dolist (l (alist-get 'gnus links))
- (gnorb-registry-make-entry
- (cl-second (split-string l "#")) nil nil
- id (cl-first (split-string l "#")))))
- (dolist (p props)
- (gnorb-registry-make-entry p nil nil id nil)
- ;; This function will try to find the group for the message
- ;; and set that value on the registry entry if it can find
- ;; it.
- (unless (gnus-registry-get-id-key p 'group)
- (gnorb-msg-id-request-head p))
- (cl-incf count)))))
- gnorb-org-find-candidates-match
- 'agenda 'archive 'comment)
- (message "Collecting all relevant Org headings, this could take a while...
done")
- ;; Delete the properties if the user has asked us to do so.
- (if (equal arg '(4))
- (progn
- (dolist (f (org-agenda-files))
- (with-current-buffer (get-file-buffer f)
- (org-delete-property-globally gnorb-org-msg-id-key)))
- (message "%d entries created; all Gnorb-specific properties deleted."
- count))
- (message "%d entries created." count))))
-
-(provide 'gnorb-registry)
-;;; gnorb-registry.el ends here
diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el
deleted file mode 100644
index e34646a..0000000
--- a/packages/gnorb/gnorb-utils.el
+++ /dev/null
@@ -1,682 +0,0 @@
-;;; gnorb-utils.el --- Common utilities for all gnorb stuff -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
-
-;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
-
-;; 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-lib)
- (require 'nnheader))
-(require 'pcase)
-(require 'seq)
-(require 'org)
-(require 'org-agenda)
-(require 'org-element)
-
-(require 'mailcap)
-(mailcap-parse-mimetypes)
-
-(defvar bbdb-mode-map)
-
-(defgroup gnorb nil
- "Glue code between Gnus, Org, and BBDB."
- :tag "Gnorb"
- :group 'mail)
-
-(make-obsolete-variable
- 'gnorb-trigger-todo-default
- "This variable has been superseded by
-`gnorb-org-trigger-actions'"
- "September 8, 2014" 'set)
-
-(defvar gnorb-tmp-dir (make-temp-file "emacs-gnorb-" t)
- "Temporary directory where attachments etc are saved.")
-
-(defvar gnorb-message-org-ids nil
- "List of Org heading IDs from the outgoing Gnus message, used
- to mark mail TODOs as done once the message is sent."
- ;; The send hook either populates this, or sets it to nil, depending
- ;; on whether the message in question has an Org id header. Then
- ;; `gnorb-org-restore-after-send' checks for it and acts
- ;; appropriately, then sets it to nil.
- )
-
-(defvar gnorb-window-conf nil
- "Save window configurations here, for restoration after mails
-are sent, or Org headings triggered.")
-
-(defvar gnorb-return-marker (make-marker)
- "Return point here after various actions, to be used together
-with `gnorb-window-conf'.")
-
-(defvar gnorb-trigger-capture-location nil
- "Marker pointing at the location where we want to place capture
- templates, for the capture-to-child and capture-to-sibling
- trigger actions.")
-
-(defcustom gnorb-mail-header "X-Org-ID"
- "Name of the mail header used to store the ID of a related Org
- heading. Only used locally: always stripped when the mail is
- sent."
- :group 'gnorb
- :type 'string)
-
-(defun gnorb-version ()
- "Return the version of currently-installed Gnorb.
-Only works for Gnorb installed via the package manager."
- (interactive)
- (if (memq 'gnorb package-activated-list)
- (let ((pkg (nth 1 (assq 'gnorb package-alist))))
- (message (package-desc-full-name pkg)))
- (message "Gnorb not installed via package manager."))
- (pkg-info-package-version "gnorb"))
-
-
-;;; this is just ghastly, but the value of this var is single regexp
-;;; group containing various header names, and we want our value
-;;; inside that group.
-(eval-after-load 'message
- `(let ((ign-headers-list
- (split-string message-ignored-mail-headers
- "|"))
- (our-val (concat gnorb-mail-header "\\")))
- (unless (member our-val ign-headers-list)
- (setq ign-headers-list
- `(,@(butlast ign-headers-list 1) ,our-val
- ,@(last ign-headers-list 1)))
- (setq message-ignored-mail-headers
- (mapconcat
- 'identity ign-headers-list "|")))))
-
-;;;###autoload
-(defun gnorb-restore-layout ()
- "Restore window layout and value of point after a Gnorb command.
-
-Some Gnorb commands change the window layout (ie `gnorb-org-view'
-or incoming email triggering). This command restores the layout
-to what it was. Bind it to a global key, or to local keys in Org
-and Gnus and BBDB maps."
- (interactive)
- (when (window-configuration-p gnorb-window-conf)
- (select-frame-set-input-focus
- (window-configuration-frame gnorb-window-conf))
- (set-window-configuration gnorb-window-conf)
- (when (buffer-live-p (marker-buffer gnorb-return-marker))
- (goto-char gnorb-return-marker))))
-
-(defun gnorb-bracket-message-id (id)
- "Ensure message-id ID is bound by angle brackets."
- ;; Always use a message-id with angle brackets around it.
- ;; `gnus-summary-goto-article' can handle either, but
- ;; `gnus-request-head' will fail without brackets IF you're
- ;; requesting from an nntp group. Mysterious.
- (unless (string-match "\\`<" id)
- (setq id (concat "<" id)))
- (unless (string-match ">\\'" id)
- (setq id (concat id ">")))
- id)
-
-(defun gnorb-unbracket-message-id (id)
- "Ensure message-id ID is NOT bound by angle brackets."
- ;; This shit is annoying, but Org wants an id with no brackets, and
- ;; Gnus is safest with an id that has brackets. So here we are.
- (replace-regexp-in-string "\\(\\`<\\|>\\'\\)" "" id))
-
-(defun gnorb-reply-to-gnus-link (link)
- "Start a reply to the linked message."
- (let* ((link (org-link-unescape link))
- (group (car (org-split-string link "#")))
- (id (gnorb-bracket-message-id
- (second (org-split-string link "#"))))
- (backend
- (car (gnus-find-method-for-group group))))
- (gnorb-follow-gnus-link group id)
- (call-interactively
- (if (eq backend 'nntp)
- 'gnus-summary-followup-with-original
- 'gnus-summary-wide-reply-with-original))))
-
-(defun gnorb-follow-gnus-link (group id)
- "Be a little clever about following gnus links.
-The goal here is reuse frames and windows as much as possible, so
-we're not opening multiple windows on the *Group* buffer, for
-instance, and messing up people's layouts. There also seems to be
-an issue when opening a link to a message whose *Summary* buffer
-is already visible: somehow, after following the link, point ends
-up on the message _after_ the one we want, and things go haywire.
-
-So we try to be a little clever. The logical progression here is
-this:
-
-1. If the link's target group is already open in a *Summary*
-buffer, just switch to that buffer (if it's visible in any frame
-then raise it and switch focus, otherwise pull it into the
-current window) and go to the message with
-`gnus-summary-goto-article'.
-
-2. If the Gnus *Group* buffer is visible in any window or frame,
-raise that frame/window and give it focus before following the
-link.
-
-3. Otherwise just follow the link as usual, in the current
-window."
- (unless (gnus-alive-p)
- (gnus))
- (let* ((sum-buffer (gnus-summary-buffer-name group))
- (target-buffer
- (cond
- ((gnus-buffer-live-p sum-buffer)
- sum-buffer)
- ((gnus-buffer-live-p gnus-group-buffer)
- gnus-group-buffer)
- (t nil)))
- (target-window (when target-buffer
- (get-buffer-window target-buffer t))))
- (if target-window
- ;; Our target buffer is displayed somewhere: just go there.
- (progn
- (select-frame-set-input-focus
- (window-frame target-window))
- (switch-to-buffer target-buffer))
- ;; Our target buffer exists, but isn't displayed: pull it up.
- (if target-buffer
- (switch-to-buffer target-buffer)))
- (message "Following link...")
- (if (gnus-buffer-live-p sum-buffer)
- (gnus-summary-goto-article id nil t)
- (gnorb-open-gnus-link group id))))
-
-(defun gnorb-open-gnus-link (group id)
- "Gnorb version of `org-gnus-follow-link'."
- ;; We've probably already bracketed the id, but just in case this is
- ;; called from elsewhere...
- (let* ((id (gnorb-bracket-message-id id))
- (arts (gnus-group-unread group))
- (artno (cdr (gnus-request-head id group)))
- success)
- (gnus-activate-group group)
- (setq success (gnus-group-read-group arts t group))
- (if success
- (gnus-summary-goto-article artno nil t)
- (signal 'error (format "Group %s could not be opened." group)))))
-
-;; I'd like to suggest this as a general addition to Emacs. *Very*
-;; tired of abusing `completing-read' for this purpose.
-(defconst gnorb-select-valid-chars
- (append (number-sequence 97 122)
- (number-sequence 65 90))
- "A list of characters that are suitable for using as selection
- keys.")
-
-(defvar gnorb-select-choice-buffer "*Selections*"
- "The name of the buffer used to pop up selections.")
-
-(defun gnorb-select-from-list (prompt collection &optional key-func)
- "Prompt the user to select something from COLLECTION.
-
-Selection can happen in a few different ways, depending on the
-nature of COLLECTION. Its elements can be:
-
-1. A plain string. Simply default to `completing-read'.
-
-2. (string object). The function uses `completing-read' on the
- strings, returning the selected object.
-
-3. (number object). As above, but the user enters a number.
-
-4. (character string object). As #3, but \"string\" is displayed
- as a string label for object.
-
-5. (number string object). As above, with numbers.
-
-COLLECTION can be passed in ready-made. Alternately, KEY-FUNC
-can be provided. The collection will be constructed by mapping
-this function over the list of objects, and then appending each
-object to the corresponding result. In other words, KEY-FUNC
-should return one of the types above, minus the final \"object\"
-element.
-
-Alternately, KEY-FUNC can be the symbol 'char, in which case the
-elements of COLLECTION will automatically be keyed to ascending
-characters (52 or fewer), or 'number, which does the same with
-numbers (no upper bound)."
- (interactive)
- (let ((len (length collection)))
- (cl-labels ((pop-up-selections
- (collection &optional charp)
- (pop-to-buffer gnorb-select-choice-buffer
- '(display-buffer-in-side-window ((side .
bottom))) t)
- (dolist (c collection)
- (insert (format "%s: %s\n"
- (if charp
- (char-to-string (car c))
- (car c))
- (nth 1 c))))))
- (setq collection
- (pcase key-func
- ((pred null)
- collection)
- ('char
- (if (> len 52)
- (error "Use the char option with fewer than 52 items")
- ;; These distinctions between char/string
- ;; and number/char are totally manufactured.
- (seq-mapn #'list gnorb-select-valid-chars collection)))
- ('number
- (seq-mapn #'list (number-sequence 1 len) collection))
- ((and func (pred functionp))
- (seq-map (lambda (el)
- (let ((res (funcall func el)))
- (if (atom res)
- (list res el)
- (append res
- (list el)))))
- collection))
- (_ (error "Invalid key-func: %s" key-func))))
- ;; We only test the car of collection to see what type it is. If
- ;; elements are mismatched, it's not our problem.
- (unwind-protect
- (pcase (car collection)
- ((pred stringp)
- (completing-read prompt collection nil t))
- ((pred symbolp)
- (intern-soft (completing-read prompt collection nil t)))
- (`(,(pred stringp) ,_)
- (nth 1 (assoc (completing-read prompt collection nil t)
- collection)))
- ;; Looks like pcase might be the wrong tool for this job.
- ((or `(,(and c (pred numberp) (guard (memq c
gnorb-select-valid-chars))) ,_)
- `(,(and c (pred numberp) (guard (memq c
gnorb-select-valid-chars))) ,_ ,_))
- (pop-up-selections collection t)
- (car (last (assq (read-char
- (propertize prompt 'face 'minibuffer-prompt))
- collection))))
- ((or `(,(pred numberp) ,_)
- `(,(pred numberp) ,_ ,_))
- (pop-up-selections collection)
- (car (last (assq (read-number prompt)
- collection)))))
- (when-let ((win (get-buffer-window gnorb-select-choice-buffer)))
- (quit-window win))))))
-
-(defun gnorb-trigger-todo-action (_arg &optional id)
- "Do the actual restore action. Two main things here. First: if
-we were in the agenda when this was called, then keep us in the
-agenda. Then let the user choose an action from the value of
-`gnorb-org-trigger-actions'."
- (require 'gnorb-org)
- (let* ((agenda-p (eq major-mode 'org-agenda-mode))
- (root-marker
- (cond (agenda-p
- (copy-marker
- (org-get-at-bol 'org-hd-marker)))
- ((derived-mode-p 'org-mode)
- (save-excursion
- (org-back-to-heading)
- (point-marker)))
- (id
- (save-excursion
- (org-id-goto id)
- (org-back-to-heading)
- (point-marker)))))
- (id (or id
- (org-with-point-at root-marker
- (org-id-get-create))))
- (action (gnorb-select-from-list
- (format
- "Trigger action on %s: "
- (gnorb-pretty-outline id))
- gnorb-org-trigger-actions))
- (link (when gnorb-org-log-add-link
- (format "[[gnus:%s][message]] "
- (gnorb-msg-id-to-link
- (plist-get gnorb-gnus-message-info :msg-id)
- (plist-get gnorb-gnus-message-info :group))))))
- (unless agenda-p
- (org-reveal))
- (cl-labels
- ((make-entry
- (id)
- (gnorb-registry-make-entry
- (plist-get gnorb-gnus-message-info :msg-id)
- (plist-get gnorb-gnus-message-info :from)
- (plist-get gnorb-gnus-message-info :subject)
- id
- (plist-get gnorb-gnus-message-info :group))))
- ;; Handle our action.
- (if (fboundp action)
- (org-with-point-at root-marker
- (make-entry (org-id-get-create))
- (funcall action gnorb-gnus-message-info))
- (cl-case action
- (note
- (org-with-point-at root-marker
- (make-entry (org-id-get-create))
- (org-add-log-setup 'note nil nil nil (or link nil))))
- (todo
- (if agenda-p
- (progn
- (org-with-point-at root-marker
- (make-entry (org-id-get-create)))
- (call-interactively 'org-agenda-todo))
- (org-with-point-at root-marker
- (make-entry (org-id-get-create))
- (call-interactively 'org-todo)
- (when link
- (setq org-log-note-extra link)))))
- (no-associate
- nil)
- (associate
- (org-with-point-at root-marker
- (make-entry (org-id-get-create))))
- ;; We're going to capture a new heading
- ((cap-child cap-sib)
- (org-with-point-at root-marker
- (setq gnorb-trigger-capture-location (point-marker)))
- (let ((entry
- ;; Pick a template.
- (copy-sequence (org-capture-select-template))))
- ;; Do surgery on that template so that it finds its
- ;; location using our function.
- (setf (nth 3 entry)
- `(function
- ,(if (eq action 'cap-child)
- #'gnorb-trigger-capture-child
- #'gnorb-trigger-capture-sibling)))
- ;; This will likely fail horribly for capture templates
- ;; that aren't entries or list items.
- (let ((org-capture-entry entry))
- ;; When org-capture-entry is let-bound, the capture
- ;; process will use that template instead of
- ;; prompting the user. Also, `gnorb-registry-capture'
- ;; will take care of making the registry entry for us.
- (call-interactively 'org-capture)))))))
- ;; Lastly, query about attaching email attachments. No matter what
- ;; happens, clear `gnorb-gnus-capture-attachments'.
- (unwind-protect
- (org-with-point-at
- (if (memq action '(cap-child cap-sib))
- (point)
- root-marker)
- (map-y-or-n-p
- (lambda (a)
- (format "Attach %s to heading? "
- (file-name-nondirectory a)))
- (lambda (a)
- (with-demoted-errors
- (org-attach-attach a nil 'mv)))
- gnorb-gnus-capture-attachments
- '("file" "files" "attach")))
- (setq gnorb-gnus-capture-attachments nil))))
-
-(defun gnorb-trigger-capture-child ()
- ;; The capture process creates a child by default
- (org-goto-marker-or-bmk gnorb-trigger-capture-location)
- (org-back-to-heading))
-
-(defun gnorb-trigger-capture-sibling ()
- ;; This only works if we're not trying to create a sibling for a
- ;; top-level heading, there appears to be no way to do that. But in
- ;; that case this trigger action isn't really necessary, just
- ;; handle it with a regular capture.
- (org-goto-marker-or-bmk gnorb-trigger-capture-location)
- (org-up-heading-safe))
-
-(defun gnorb-pretty-outline (id &optional kw)
- "Return pretty outline path of the Org heading indicated by ID.
-
-If the KW argument is true, add the TODO keyword into the path."
- (let ((pt (org-id-find id t)))
- (if pt
- (org-with-point-at pt
- (let ((el (org-element-at-point)))
- (concat
- (if kw
- (format "(%s): "
- (org-element-property :todo-keyword el))
- "")
- (org-format-outline-path
- (append
- (list
- (file-name-nondirectory
- (buffer-file-name
- (org-base-buffer (current-buffer)))))
- (org-get-outline-path)
- (list
- (replace-regexp-in-string
- org-bracket-link-regexp
- "\\3" (org-element-property :raw-value el))))))))
- "[none]")))
-
-(defun gnorb-scan-links (bound &rest types)
- "Scan from point to BOUND looking for links of type in TYPES.
-TYPES is a list of symbols; we search for all links corresponding
-to those symbols."
- ;; It may be excessive to examine *all* links, rather than just
- ;; creating a specialized regexp for the links we want, but it's
- ;; nice to be lazy and use `org-link-any-re', that seems safer.
-
- ;; This function should also *not* be responsible for unescaping
- ;; links -- we don't know what they're going to be used for, and
- ;; unescaped is safer.
- (unless (= (point) bound)
- (let ((alist (mapcar #'list (copy-sequence types))))
- (while (re-search-forward org-link-any-re bound t)
- (let ((link (or
- ;; Bracket link.
- (match-string-no-properties 2)
- ;; "Bare" link.
- (match-string-no-properties 0)))
- sym)
- (when (string-match "\\([^:]+\\):\\(.+\\)" link)
- (setq sym (intern-soft (match-string 1 link))
- link (match-string 2 link))
- (when (and sym (memq sym types))
- (push link (alist-get sym alist))))))
- alist)))
-
-(defun gnorb-msg-id-to-link (msg-id &optional server-group)
- "Create a full Org link to the message MSG-ID.
-If SERVER-GROUP isn't given, try to figure it out."
- (let ((server-group (or server-group
- (car (gnorb-msg-id-request-head msg-id)))))
- (when server-group
- (org-link-escape
- (concat server-group "#"
- (gnorb-unbracket-message-id msg-id))))))
-
-(defun gnorb-msg-id-request-head (msg-id &optional group)
- "Given a message id, try to find its group and article number.
-If GROUP is given, assume that group and just try to find the
-article number.
-
-So far we're checking the registry, then the groups in
-`gnorb-gnus-sent-groups'. Use search engines? Other clever
-methods?"
- (let (candidates server-group check)
- (setq msg-id (gnorb-bracket-message-id msg-id))
- (catch 'found
- (when gnorb-tracking-enabled
- (setq candidates (if group
- (list group)
- (append (gnus-registry-get-id-key msg-id 'group)
- gnorb-gnus-sent-groups)))
- (while (setq server-group (pop candidates))
- (when (and (stringp server-group)
- ;; I don't remember the reason for this check,
- ;; which is totally fragile and fails on groups
- ;; belonging to `gnus-select-method': another
- ;; reason why this select method stuff is a mess.
-
- ;;(string-match-p "+" server-group)
- (not
- (string-match-p
- "\\(nnir\\|nnvirtual\\|UNKNOWN\\)"
- server-group))
- (gnus-activate-group server-group)
- (setq check
- (ignore-errors
- (gnus-request-head msg-id server-group))))
-
- (gnus-registry-set-id-key msg-id 'group (list server-group))
- (throw 'found (cons server-group (cdr check))))))
- nil)))
-
-(defun gnorb-collect-ids (&optional id)
- "Collect all Org IDs for a subtree.
-Starting with the heading under point (or the heading indicated
-by the ID argument), collect its ID property, and the IDs of all
-child headings."
- (save-excursion
- (save-restriction
- (when id
- (org-id-goto id))
- (org-narrow-to-subtree)
- (org-element-map (org-element-parse-buffer)
- 'headline
- (lambda (hl)
- (org-element-property :ID hl))))))
-
-;; Common functions for extracting references and relevant headings
-;; from the message under point. For use in gnorb-gnus.el functions.
-
-(defun gnorb-get-real-group-name (group art-no)
- "Find the original group name of a message in a virtual or nnir
-group."
- (cl-case (car (gnus-find-method-for-group group))
- (nnvirtual
- (setq group (car (nnvirtual-map-article art-no))))
- (nnir
- (setq group (nnir-article-group art-no)))
- (nnselect
- (setq group (nnselect-article-group art-no))))
- group)
-
-(defun gnorb-find-tracked-headings (headers &optional include-zombies)
- "Check HEADERS for message references and return relevant heading IDs.
-HEADERS is a message's data header, as produced by
-\(gnus-interactive \"H\"), or, equivalently:
-
-\(gnus-data-header (gnus-data-find (gnus-summary-article-number)))"
- (let ((references (mail-header-references headers))
- (msg-id (mail-header-message-id headers)))
- (when gnorb-tracking-enabled
- (gnorb-find-visit-candidates
- (concat msg-id " " references) include-zombies))))
-
-(defun gnorb-choose-trigger-heading (&optional id)
- "Given an Org heading ID, ask the user if they want to trigger it.
-If not, prompt for another target heading. Either way, return the
-target heading id."
- (let ((id (if (stringp id)
- id
- (car-safe id)))
- refile-result)
- (if (and id
- (y-or-n-p (message
- "Attach part to %s"
- (gnorb-pretty-outline id))))
- id
- (setq refile-result
- (org-refile-get-location "Attach part to" nil t))
- (save-window-excursion
- (find-file (nth 1 refile-result))
- (goto-char (nth 3 refile-result))
- (org-id-get-create)))))
-
-;; Loading the registry
-
-(defvar gnorb-tracking-enabled nil
- "Internal flag indicating whether Gnorb is successfully plugged
- into the registry or not.")
-
-;;;###autoload
-(defun gnorb-tracking-initialize ()
- "Start using the Gnus registry to track correspondences between
-Gnus messages and Org headings. This requires that the Gnus
-registry be in use, and should be called after the call to
-`gnus-registry-initialize'."
- (require 'gnorb-registry)
- (with-eval-after-load 'gnus-registry
- (add-to-list 'gnus-registry-extra-entries-precious 'gnorb-ids)
- (add-to-list 'gnus-registry-track-extra 'gnorb-ids))
- (add-hook
- 'gnus-started-hook
- (lambda ()
- ;; The require may be necessary in order to get
- ;; `gnus-user-format-function-g' defined before it's used. That
- ;; function is likely the first hit on gnorb-gnus, and there's no
- ;; way to autoload it, as it is dynamically defined.
- (require 'gnorb-gnus)
- (unless (gnus-registry-install-p)
- (user-error "Gnorb tracking requires that the Gnus registry be
installed."))
- (add-hook 'org-capture-prepare-finalize-hook #'gnorb-registry-capture)
- (setq gnorb-tracking-enabled t))))
-
-;;;###autoload
-(defun gnorb-install-defaults ()
- "Set up sane Gnorb customizations and keybindings."
- (interactive)
- (global-set-key (kbd "C-c A") 'gnorb-restore-layout)
- (eval-after-load "gnorb-bbdb"
- '(progn
- (define-key bbdb-mode-map (kbd "C-c S") #'gnorb-bbdb-mail-search)
- (define-key bbdb-mode-map (kbd "C-c l") #'gnorb-bbdb-open-link)
- (define-key bbdb-mode-map [remap bbdb-mail] #'gnorb-bbdb-mail)
- (eval-after-load "gnorb-org"
- '(org-defkey org-mode-map (kbd "C-c C") #'gnorb-org-contact-link))))
- (eval-after-load "gnorb-org"
- '(progn
- (org-defkey org-mode-map (kbd "C-c t") #'gnorb-org-handle-mail)
- (org-defkey org-mode-map (kbd "C-c v") #'gnorb-org-view)
- (org-defkey org-mode-map (kbd "C-c E") #'gnorb-org-email-subtree)
- (setq gnorb-org-agenda-popup-bbdb t)
- (eval-after-load "org-agenda"
- '(progn (org-defkey org-agenda-mode-map (kbd "C-c t")
#'gnorb-org-handle-mail)
- (org-defkey org-agenda-mode-map (kbd "C-c v")
#'gnorb-org-view)))))
- (eval-after-load "gnorb-gnus"
- '(progn
- (define-key gnus-summary-mime-map "a" #'gnorb-gnus-article-org-attach)
- (define-key gnus-summary-mode-map (kbd "C-c t")
#'gnorb-gnus-incoming-do-todo)
- (define-key gnus-summary-mode-map (kbd "C-c v") #'gnorb-gnus-view)
- (define-key gnus-summary-mode-map (kbd "C-c C-t")
#'gnorb-gnus-tag-message)
- (define-key gnus-summary-limit-map (kbd "g")
#'gnorb-gnus-insert-tagged-messages)
- (define-key gnus-summary-limit-map (kbd "G")
#'gnorb-gnus-insert-tracked-messages)
- (setq gnorb-gnus-capture-always-attach t)
- (push '("attach to org heading" . gnorb-gnus-mime-org-attach)
- gnus-mime-action-alist)
- ;; The only way to add mime button command keys is by redefining
- ;; gnus-mime-button-map, possibly not ideal. Ideal would be a
- ;; setter function in gnus itself.
- (push '(gnorb-gnus-mime-org-attach "a" "Attach to Org heading")
- gnus-mime-button-commands)
- (setq gnus-mime-button-map
- (let ((map (make-sparse-keymap)))
- (dolist (c gnus-mime-button-commands)
- (define-key map (cadr c) (car c)))
- map))))
- (eval-after-load "message"
- '(progn
- (define-key message-mode-map (kbd "C-c t")
#'gnorb-gnus-outgoing-do-todo))))
-
-(provide 'gnorb-utils)
-;;; gnorb-utils.el ends here
diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el
deleted file mode 100644
index 90a046f..0000000
--- a/packages/gnorb/gnorb.el
+++ /dev/null
@@ -1,41 +0,0 @@
-;;; gnorb.el --- Glue code between Gnus, Org, and BBDB -*- lexical-binding: t
-*-
-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
-
-;; Version: 1.6.9
-;; Package-Requires: ((cl-lib "0.5"))
-
-;; Maintainer: Eric Abrahamsen <eric@ericabrahamsen.net>
-
-;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
-;; Keywords: mail org gnus bbdb todo task
-
-;; 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:
-
-;; Load this file to load everything.
-
-;;; Code:
-
-(with-eval-after-load 'gnus
- (require 'gnorb-gnus)
- (require 'gnorb-registry))
-(with-eval-after-load 'bbdb
- (require 'gnorb-bbdb))
-(with-eval-after-load 'org
- (require 'gnorb-org))
-
-(provide 'gnorb)
-;;; gnorb.el ends here
diff --git a/packages/gnorb/gnorb.info b/packages/gnorb/gnorb.info
deleted file mode 100644
index 8677397..0000000
--- a/packages/gnorb/gnorb.info
+++ /dev/null
@@ -1,858 +0,0 @@
-This is gnorb.info, produced by makeinfo version 6.7 from gnorb.texi.
-
-INFO-DIR-SECTION Emacs
-START-INFO-DIR-ENTRY
-* Gnorb: (gnorb). Glue code for Gnus, Org, and BBDB.
-END-INFO-DIR-ENTRY
-
-
-File: gnorb.info, Node: Top, Next: Introduction, Up: (dir)
-
-Gnorb Manual
-************
-
-* Menu:
-
-* Introduction::
-* Installation::
-* Setup::
-* Email Tracking::
-* Restoring Window Layout::
-* Recent Mails From BBDB Contacts::
-* Tagging Messages and Contacts::
-* BBDB posting styles::
-* Misc BBDB::
-* Misc Org::
-* Misc Gnus::
-* Default Keybindings::
-
-— The Detailed Node Listing —
-
-Email Tracking
-
-* Likely Workflow::
-* Tracking Setup::
-* Beginning and Continuing the Tracking Process::
-* Trigger Actions::
-* Viewing Things::
-* Hinting in Gnus::
-* Message Attachments::
-* Registry Usage::
-
-Misc BBDB
-
-* Searching for messages from BBDB contacts::
-* Citing BBDB contacts::
-* User Options::
-
-Misc Org
-
-* Inserting BBDB links::
-* User Options: User Options (1).
-
-Misc Gnus
-
-* Searching With the Registry::
-* User Options: User Options (2).
-
-
-
-File: gnorb.info, Node: Introduction, Next: Installation, Prev: Top, Up:
Top
-
-1 Introduction
-**************
-
-Gnorb provides glue code between the Gnus, Org, and BBDB packages. It’s
-aimed at supporting email-based project management, and generally making
-it easier to keep track of email communication.
-
- Much of the code consists of single-use convenience functions, but
-tracking email conversations with Org requires is more complicated, and
-requires a bit of setup.
-
- Gnorb can be used in a modular fashion, by selectively loading the
-files “gnorb-org”, “gnorb-gnus” or “gnorb-bbdb” instead of plain old
-“gnorb”. The package as a whole is rather Org-centric, though, and it
-won’t do much of interest without “gnorb-org”.
-
- If you’ve installed from the package manager, of course, you don’t
-need ‘require’ statements at all. In that case, simply using the
-(autoloaded) functions that are of interest to you will be sufficient.
-
- This means that Gnorb doesn’t have hard requirements to any of the
-three base libraries. For the libraries you are using, however, you’ll
-get best results from using the most recent stable version (yes, that
-means BBDB 3). Some of the features in Gnorb only work with development
-versions of these libraries (those cases are noted below).
-
-
-File: gnorb.info, Node: Installation, Next: Setup, Prev: Introduction, Up:
Top
-
-2 Installation
-**************
-
-Gnorb is installable via the Elpa package manager – look for it in
-‘list-packages’.
-
- An earlier version of the code is available at
-<https://github.com/girzel/gnorb>, but this is now out of date. Issues
-opened there will still be addressed, however.
-
-
-File: gnorb.info, Node: Setup, Next: Email Tracking, Prev: Installation,
Up: Top
-
-3 Setup
-*******
-
-Loading “gnorb” will make the basic functions available. Using Gnorb
-for email tracking takes a bit more setup, however – see below.
-
- Gnorb doesn’t bind any keys by default, but you can call
-‘gnorb-install-defaults’ to do a basic installation. The rest of this
-manual assumes those *note default keybindings: Default Keybindings.
-
-
-File: gnorb.info, Node: Email Tracking, Next: Restoring Window Layout,
Prev: Setup, Up: Top
-
-4 Email Tracking
-****************
-
-The most interesting thing Gnorb does is using Org headings to track
-email conversations.
-
- A “tracked conversation” is essentially a message thread, with
-benefits. An Org heading (and subheadings) collect messages relevant to
-the heading. You can view all the messages at once, reply to the
-most-recently-received message, collect all message attachments on the
-heading (using org-attach), and be reminded that newly-received messages
-might be relevant to the conversation. The state of the Org heading
-tracks the state of your participation in the conversation: the TODO
-keyword might switch between REPLY and WAIT, for instance, or you might
-take notes on how everything’s progressing.
-
- In general, the goal is to keep track of whole conversations, reduce
-friction when moving between Gnus and Org, and keep you in the Org
-agenda rather than in Gnus.
-
-* Menu:
-
-* Likely Workflow::
-* Tracking Setup::
-* Beginning and Continuing the Tracking Process::
-* Trigger Actions::
-* Viewing Things::
-* Hinting in Gnus::
-* Message Attachments::
-* Registry Usage::
-
-
-File: gnorb.info, Node: Likely Workflow, Next: Tracking Setup, Up: Email
Tracking
-
-4.1 Likely Workflow
-===================
-
-First of all, here’s a hypothetical workflow to show you how tracking
-works.
-
- Say you receive an email from Jimmy, who wants to rent a room in your
-house. “I’ll respond to this later,” you think.
-
- You capture an Org TODO from the email, writing a headline “Jimmy
-renting a room”, and give it a REPLY keyword. Gnorb quietly records the
-correspondence between the email and the TODO, using the Gnus registry.
-
- The next day, looking at your Agenda, you see the TODO and decide to
-respond to the email. You hit “C-c t” on the heading, and Gnorb finds
-Jimmy’s email and starts a reply to it.
-
- You tell Jimmy the room’s available in March, and send the message.
-Gnorb takes you back to the heading, and asks you to trigger an action
-on it. You choose “todo state”, and change the heading keyword to WAIT.
-
- Two days later, Jimmy replies to your message, saying that March is
-perfect. When you open his response, Gnorb politely reminds you that
-the message is relevant to an existing TODO. You hit “C-c t” on the
-message, and are again taken to the TODO and asked to trigger an action.
-Again you choose “todo state”, and change the heading keyword back to
-REPLY.
-
- You get another email, from Samantha, warning you not to rent the
-room to Jimmy. She even attaches a picture of a room in her house, as
-it looked after Jimmy had stayed there for six months. It’s bad. You
-hit “C-c t” on her message, and pick the “Jimmy renting a room” heading.
-This time, you choose “take note” as the trigger action, and make a
-brief note about how bad that room looked. Gnorb asks if you’d like to
-attach the picture to the Org heading. You decide you will.
-
- Now it’s time to write to Jimmy and say something noncommittal.
-Hitting “C-c t” on the heading would respond to Samantha’s email, the
-most recent of the associated messages, which isn’t what you want.
-Instead you hit “C-c v” on the heading, which opens up a Gnus *Summary*
-buffer containing all four messages: Jimmy’s first, your response, his
-response to that, and Samantha’s message. You pick Jimmy’s second
-email, and reply to it normally. Gnorb asks if you’d like to send the
-picture of the room as an attachment. You would not. When you send the
-reply Gnorb tracks that as well, and does the “trigger an action” trick
-again.
-
- In this way Gnorb helps you manage an entire conversation, possibly
-with multiple threads and multiple participants. Mostly all you need to
-do is hit “C-c t” on newly-received messages, and “C-c t” on the heading
-when it’s time to compose a new reply.
-
-
-File: gnorb.info, Node: Tracking Setup, Next: Beginning and Continuing the
Tracking Process, Prev: Likely Workflow, Up: Email Tracking
-
-4.2 Tracking Setup
-==================
-
-Email tracking requires the following steps:
-
- 1. Tracking is done via the Gnus registry, so that must be activated
- with ’gnus-registry-initialize’.
- 2. It also depends on the org-id package, with ‘org-id-track-globally’
- set to t (that’s the default value, so simply loading the package
- should be enough).
- 3. Add a nngnorb entry to your ‘gnus-secondary-select-methods’
- variable. It will look like (nngnorb “Server name”). This does
- nothing but provide a place to hang nnir searches. If you are
- using the Gnus that comes with Emacs 28 or later (or check
- ‘(featurep 'nnselect)’ to be sure), this step is unnecessary.
- 4. Then put a call to ‘gnorb-tracking-initialize’ in your init files.
- 5. If you’re not using a local archive method for saving your sent
- messages (ie you’re using IMAP), you’ll also need to tell Gnorb
- where to find your sent messages. Set the variable
- ‘gnorb-gnus-sent-groups’ to a list of strings; each string should
- indicate a fully-qualified group name, eg “nnimap+SERVER:GROUP”.
- 6. Set ‘gnorb-gnus-new-todo-capture-key’ to the key of a capture
- template you want to use for creating TODOs from sent messages.
-
-
-File: gnorb.info, Node: Beginning and Continuing the Tracking Process, Next:
Trigger Actions, Prev: Tracking Setup, Up: Email Tracking
-
-4.3 Beginning and Continuing the Tracking Process
-=================================================
-
-Email tracking starts in one of three ways:
-
- 1. With an Org heading that represents an email TODO. Call
- ‘gnorb-org-handle-mail’ (see below) on the heading to compose a new
- message, and start the tracking process.
- 2. By calling org-capture on a received message. Capturing from a
- Gnus Summary buffer automatically initiates tracking.
- 3. By calling ‘gnorb-gnus-outgoing-do-todo’ while composing a message.
- This will create a new TODO heading after the message is sent.
-
- After tracking begins, it is continued by using Gnorb-specific
-commands when sending and receiving email:
-
- 1. When you receive an email in Gnus that should be part of a tracked
- conversation, use ‘gnorb-gnus-incoming-to-todo’ on it to associate
- it with the relevant Org heading.
- 2. When it’s time to reply to that email, use ‘gnorb-org-handle-mail’
- on the Org heading to start a reply to the thread.
-
- The default setup binds all these functions to “C-c t” in their
-respective modes, so just use that keybinding everywhere to keep the
-conversation going.
-
- Some more detail on the various functions:
-
- 1. ‘gnorb-org-handle-mail’ (“C-c t” in org-mode) is called on an Org
- heading to compose a new message. By default, this will begin a
- reply to the most recent message in the conversation. If there are
- no associated messages to reply to (or you call the function with a
- single prefix arg), Gnorb will look for mailto: or bbdb: links in
- the heading, and compose a new message to them.
-
- Calling the function with a double prefix arg will ignore all
- associated messages and links, and compose a blank message.
-
- Once sent, the message will be associated with the Org heading, and
- you’ll be brought back to the heading and asked to trigger an
- action on it. See *note Trigger Actions:: for more information.
-
- ‘gnorb-email-subtree’ is an alternative to ‘gnorb-org-handle-mail’.
- It does the same thing as the latter, but first exports the body of
- the subtree as either text or a file, then inserts the text into
- the message body, or attaches the file to the message,
- respectively.
- 2. ‘gnorb-gnus-incoming-do-todo’ (“C-c t” in gnus-summary-mode and
- gnus-article-mode) is called on a message in a Gnus *Summary*
- buffer. You’ll be prompted for an Org heading, taken to that
- heading, and asked to trigger an action on it.
- 3. ‘gnorb-gnus-outgoing-do-todo’ (“C-c t” in message-mode) is called
- in message mode, while composing a new message. Usually this is
- only necessary when starting a new tracked conversation.
-
- If called without a prefix arg, a new Org heading will be created
- after the message is sent, and the sent message associated with it.
- The new heading will be created as a capture heading, using the
- template specified by the ‘gnorb-gnus-new-todo-capture-key’ option.
-
- If you call this function with a single prefix arg, you’ll be
- prompted to choose an existing Org heading instead. After the
- message is sent, you’ll be taken to that heading and prompted to
- trigger an action on it.
-
- If you’ve called this function, and then realize you’ve associated
- the message with the wrong TODO, call it again with a double prefix
- to clear all associations.
-
- It’s also possible to call this function *after* a message is sent,
- in case you forgot. Gnorb saves information about the most
- recently sent message for this purpose.
-
- An additional convenience command is available for use in Gnus
-summary buffers: ‘gnorb-gnus-quick-reply’. If you don’t want to go
-through the whole round trip of triggering an action and then starting a
-new reply, call this command on an incoming message to associate it with
-a heading, start a reply, and associate your reply with the same
-heading.
-
-
-File: gnorb.info, Node: Trigger Actions, Next: Viewing Things, Prev:
Beginning and Continuing the Tracking Process, Up: Email Tracking
-
-4.4 Trigger Actions
-===================
-
-After receiving or sending a message in a tracked conversation, you’ll
-be taken to the relevant Org heading and asked to “trigger an action” on
-it. The main purpose of triggering is to associate the message with the
-Org heading, but the action also gives you a chance to do something
-useful like changing the TODO keyword, or leaving a note.
-
- At the moment there are six different possibilities:
-
- 1. Change the heading’s TODO state.
- 2. Take a note on the heading.
- 3. Associate the message, but do nothing else.
- 4. Capture a new Org heading as a sibling to the tracked heading
- 5. Capture a new Org heading as a child to the tracked heading
- 6. Do nothing – do not associate the message.
-
- More actions may be added in the future; it’s also possible to
-rearrange or delete existing actions, and add your own: see the
-docstring of ‘gnorb-org-trigger-actions’.
-
-
-File: gnorb.info, Node: Viewing Things, Next: Hinting in Gnus, Prev:
Trigger Actions, Up: Email Tracking
-
-4.5 Viewing Things
-==================
-
-Keeping track of a conversation is one thing, but it’s very useful to be
-able to see an overview of history and current state. For this purpose
-Gnorb provides “view” commands, which by default are bound to “C-c v” in
-all contexts.
-
- Calling ‘gnorb-org-view’ (“C-c v”) on an Org heading will open an
-nnir summary buffer showing all the messages associated with that
-heading and child headings (this requires you to have added an nngnorb
-server to your Gnus backends). A minor mode is in effect, ensuring that
-any replies you send to messages in this buffer will automatically be
-associated with the original Org heading. You can also invoke
-‘gnorb-summary-disassociate-message’ (“C-c d”) to disassociate the
-message with the Org heading.
-
- If you call ‘gnorb-org-view’ with a prefix argument, the search group
-will be made persistent across Gnus sessions. You can re-run the search
-and update the group contents by hitting “M-g” on the group in the Gnus
-*Group* buffer.
-
- Calling ‘gnorb-gnus-view’ (“C-c v”) on a tracked message will take
-you to the tracked Org heading.
-
- From a Gnus *Summary* buffer, you can insert all tracked messages in
-the current group into the buffer with
-‘gnorb-gnus-insert-tracked-messages’, bound to “/ G” in the default
-keybindings. By default this will only insert messages associated with
-headings that are not in a DONE state; call with a prefix arg to insert
-all messages.
-
- As a bonus, it’s possible to go into Gnus’ *Server* buffer, find the
-line specifying your nngnorb server, and hit “G” (aka
-‘gnus-group-make-nnir-group’). At the query prompt, enter an Org-style
-tags-todo Agenda query string (eg “+work-computer”, or what have you).
-Gnorb will find all headings matching this query, scan their subtrees
-for gnus links, and then give you a Summary buffer containing all the
-linked messages. This is dog-slow at the moment; it will get faster.
-
-
-File: gnorb.info, Node: Hinting in Gnus, Next: Message Attachments, Prev:
Viewing Things, Up: Email Tracking
-
-4.6 Hinting in Gnus
-===================
-
-When you receive new mails that might be relevant to existing Org TODOs,
-Gnorb can alert you to that fact. When
-‘gnorb-gnus-hint-relevant-article’ is t (the default), Gnorb will
-display a message in the minibuffer when opening potentially relevant
-messages. You can then use ‘gnorb-gnus-incoming-to-todo’ to trigger an
-action on the relevant TODO.
-
- This hinting can happen in the Gnus summary buffer as well. If you
-use the escape indicated by ‘gnorb-gnus-summary-mark-format-letter’ as
-part of your ‘gnus-summary-line-format’, articles that may be relevant
-to TODOs will be marked with a special character in the Summary buffer,
-as determined by ‘gnorb-gnus-summary-mark’. By default, the format
-letter is “g” (meaning it is used as “%ug” in the format line), and the
-mark is “&” for messages that are already tracked, and “¡” for messages
-that may be relevant.
-
-
-File: gnorb.info, Node: Message Attachments, Next: Registry Usage, Prev:
Hinting in Gnus, Up: Email Tracking
-
-4.7 Message Attachments
-=======================
-
-Gnorb simplifies the handling of attachments that you receive in emails.
-When you call ‘gnorb-gnus-incoming-do-todo’ on a message, you’ll be
-prompted to re-attach the email’s attachments onto the Org heading,
-using the org-attach library.
-
- You can also do this as part of the capture process. Set the new
-:gnus-attachments key to “t” in a capture template that you use on mail
-messages, and you’ll be queried to re-attach the message’s attachments
-onto the newly-captured heading.
-
- Or set ‘gnorb-gnus-capture-always-attach’ to “t” to have Gnorb do
-this for all capture templates.
-
- You can also do this using the regular system of MIME commands,
-without invoking the email tracking process. Using the default
-bindings, pressing “a” on a MIME line will prompt you to move the
-attachment to an Org heading.
-
- The same process works in reverse: when you send a message from an
-Org heading using ‘gnorb-org-handle-mail’, Gnorb will ask if you want to
-attach the files in the heading’s org-attach directory to the outgoing
-message.
-
-
-File: gnorb.info, Node: Registry Usage, Prev: Message Attachments, Up:
Email Tracking
-
-4.8 Registry Usage
-==================
-
-You can see how many associations you’ve got stored in the registry by
-calling ‘gnorb-report-tracking-usage’. This will pop up a buffer
-showing how much of the registry you’re using, and offering keybindings
-for ‘gnorb-flush-dead-associations’, to help Gnorb clean up after
-itself.
-
-
-File: gnorb.info, Node: Restoring Window Layout, Next: Recent Mails From
BBDB Contacts, Prev: Email Tracking, Up: Top
-
-5 Restoring Window Layout
-*************************
-
-Many Gnorb functions alter the window layout and value of point. In
-most of these cases, you can restore the previous layout using the
-interactive function ‘gnorb-restore-layout’, by default bound to “C-c
-A”.
-
-
-File: gnorb.info, Node: Recent Mails From BBDB Contacts, Next: Tagging
Messages and Contacts, Prev: Restoring Window Layout, Up: Top
-
-6 Recent Mails From BBDB Contacts
-*********************************
-
-If you’re using a recent git version of BBDB (circa mid-May 2014 or
-later), you can give your BBDB contacts a special field which will
-collect links to recent emails from that contact. The default name of
-the field is “messages”, but you can customize that name using the
-‘gnorb-bbdb-messages-field’ option.
-
- Gnorb will not collect links by default: you need to call
-‘gnorb-bbdb-open-link’ on a contact once to start the process.
-Thereafter, opening mails from that contact will store a link to the
-message.
-
- Once some links are stored, ‘gnorb-bbdb-open-link’ will open them:
-Use a prefix arg to the function call to select particular messages to
-open. There are several options controlling how all this works; see the
-gnorb-bbdb user options section below for details.
-
-
-File: gnorb.info, Node: Tagging Messages and Contacts, Next: BBDB posting
styles, Prev: Recent Mails From BBDB Contacts, Up: Top
-
-7 Tagging Messages and Contacts
-*******************************
-
-It’s possible to use your defined Org tags to tag BBDB contacts and Gnus
-messages.
-
- For BBDB contacts, tags are stored in an xfield named org-tags, by
-default (you can customize the name of this field using the
-‘gnorb-bbdb-org-tag-field’ option). Once contacts are tagged, you can
-search for tags normally in the *BBDB* buffer. You can also pop up a
-*BBDB* buffer alongside an Org Agenda tags search, with contacts
-matching the search terms. You can have this happen automatically, by
-setting ‘gnorb-org-agenda-popup-bbdb’ to a non-nil value, or do it
-manually by calling ‘gnorb-org-popup-bbdb’.
-
- Gnus messages can be tagged from a *Summary* buffer using the command
-‘gnorb-gnus-tag-message’ (bound to “C-c C-t” when using the default
-keybindings). You can also search for tagged messages in a group using
-‘gnorb-gnus-insert-tagged-messages’ (bound to “/ g” when using the
-default keybindings). The search string can be given as a more complex
-tags expression a la Org Agenda searches, ie “cat|bird-dog”.
-
- If the option ‘gnorb-gnus-auto-tag-messages’ is non-nil, any time you
-trigger an Org heading from a Gnus message, the message will “inherit”
-the tags of the Org heading.
-
- You can view Org tags on Gnus messages by adding the “%uG” spec code
-to your ‘gnus-group-line-format’ value. That spec code can be
-customized using the ‘gnorb-gnus-summary-tags-format-letter’ option.
-
-
-File: gnorb.info, Node: BBDB posting styles, Next: Misc BBDB, Prev: Tagging
Messages and Contacts, Up: Top
-
-8 BBDB posting styles
-*********************
-
-Gnorb comes with a BBDB posting-style system, inspired by (copied from)
-gnus-posting-styles. You can specify how messages are composed to
-specific contacts, by matching on contact field values (the same way
-gnus-posting-styles matches on group names). See the docstring of
-‘gnorb-bbdb-posting-styles’ for details.
-
- In order not to be too intrusive, Gnorb doesn’t alter the behavior of
-‘bbdb-mail’, the usual mail-composition function. Instead it provides
-an alternate ‘gnorb-bbdb-mail’, which does exactly the same thing, but
-first processes the new mail according to ‘gnorb-bbdb-posting-styles’.
-If you want to use this feature regularly, you can remap ‘bbdb-mail’ to
-‘gnorb-bbdb-mail’ in the ‘bbdb-mode-map’.
-
-
-File: gnorb.info, Node: Misc BBDB, Next: Misc Org, Prev: BBDB posting
styles, Up: Top
-
-9 Misc BBDB
-***********
-
-* Menu:
-
-* Searching for messages from BBDB contacts::
-* Citing BBDB contacts::
-* User Options::
-
-
-File: gnorb.info, Node: Searching for messages from BBDB contacts, Next:
Citing BBDB contacts, Up: Misc BBDB
-
-9.1 Searching for messages from BBDB contacts
-=============================================
-
-Call ‘gnorb-bbdb-mail-search’ to search for all mail messages from the
-record(s) displayed. Currently supports the notmuch, mairix, and namazu
-search backends; set ‘gnorb-gnus-mail-search-backend’ to one of those
-symbol values.
-
-
-File: gnorb.info, Node: Citing BBDB contacts, Next: User Options, Prev:
Searching for messages from BBDB contacts, Up: Misc BBDB
-
-9.2 Citing BBDB contacts
-========================
-
-Calling ‘gnorb-bbdb-cite-contact’ will prompt for a BBDB record and
-insert a string of the type “Bob Smith <bob@smith.com>”.
-
-
-File: gnorb.info, Node: User Options, Prev: Citing BBDB contacts, Up: Misc
BBDB
-
-9.3 User Options
-================
-
-‘gnorb-bbdb-org-tag-field
- The name of the BBDB xfield, as a symbol, that holds Org-related
- tags. Specified as a string with the “:” separator between tags,
- same as for Org headings. Defaults to org-tag.
-‘gnorb-bbdb-messages-field’
- The name of the BBDB xfield that holds links to recently-received
- messages from this contact. Defaults to ’messages.
-‘gnorb-bbdb-collect-N-messages’
- Collect at most this many links to messages from this contact.
- Defaults to 5.
-‘gnorb-bbdb-define-recent’
- What does “recently-received” mean? Possible values are the
- symbols seen and received. When set to seen, the most
- recently-opened messages are collected. When set to received, the
- most recently-received (by Date header) messages are collected.
- Defaults to seen.
-‘gnorb-bbdb-message-link-format-multi’
- How is a single message’s link formatted in the multi-line BBDB
- layout format? Defaults to “%:count. %D: %:subject” (see the
- docstring for details).
-‘ gnorb-bbdb-message-link-format-one’
- How is a single message’s link formatted in the one-line BBDB
- layout format? Defaults to nil (see the docstring for details).
-‘gnorb-bbdb-posting-styles’
- Styles to use for influencing the format of mails composed to the
- BBDB record(s) under point (see the docstring for details).
-
-
-File: gnorb.info, Node: Misc Org, Next: Misc Gnus, Prev: Misc BBDB, Up: Top
-
-10 Misc Org
-***********
-
-* Menu:
-
-* Inserting BBDB links::
-* User Options: User Options (1).
-
-
-File: gnorb.info, Node: Inserting BBDB links, Next: User Options (1), Up:
Misc Org
-
-10.1 Inserting BBDB links
-=========================
-
-Calling ‘gnorb-org-contact-link’ will prompt for a BBDB record and
-insert an Org link to that record at point.
-
-
-File: gnorb.info, Node: User Options (1), Prev: Inserting BBDB links, Up:
Misc Org
-
-10.2 User Options
-=================
-
-‘gnorb-org-after-message-setup-hook’
- Hook run in a message buffer after setting up the message, from
- ‘gnorb-org-handle-mail’ or ‘gnorb-org-email-subtree’.
-‘gnorb-org-trigger-actions’
- List of potential actions that can be taken on headings after a
- message is sent. See docstring for details.
-‘gnorb-org-mail-scan-scope’
- The number of paragraphs to scan for mail-related links. This
- comes into play when calling ‘gnorb-org-handle-mail’ on a heading
- with no associated messages, or when ‘gnorb-org-handle-mail’ is
- called with a prefix arg.
-‘gnorb-org-find-candidates-match’
- When searching all Org files for headings to collect messages from,
- this option can limit which headings are searched. It is used as
- the second argument to a call to ‘org-map-entries’, and has the
- same syntax as that used in an agenda tags view.
-‘gnorb-org-email-subtree-text-parameters’
- A plist of export parameters corresponding to the EXT-PLIST
- argument to the export functions, for use when exporting to text.
-‘gnorb-org-email-subtree-file-parameters’
- A plist of export parameters corresponding to the EXT-PLIST
- argument to the export functions, for use when exporting to a file.
-‘gnorb-org-email-subtree-text-options’
- A list of ts and nils corresponding to Org’s export options, to be
- used when exporting to text. The options, in order, are async,
- subtreep, visible-only, and body-only.
-‘gnorb-org-email-subtree-file-options’
- A list of ts and nils corresponding to Org’s export options, to be
- used when exporting to a file. The options, in order, are async,
- subtreep, visible-only, and body-only.
-‘gnorb-org-export-extensions’
- Correspondence between export backends and their respective (usual)
- file extensions.
-‘gnorb-org-capture-collect-link-p’
- When this is set to t, the capture process will always store a link
- to the Gnus message or BBDB record under point, even when the link
- isn’t part of the capture template. It can then be added to the
- captured heading with org-insert-link, as usual.
-‘gnorb-org-log-add-link’
- When non-nil, any time a todo trigger action results in adding a
- note, a link to the triggering message will be added to the log
- note text.
-‘gnorb-org-agenda-popup-bbdb’
- Set to “t” to automatically pop up the BBDB buffer displaying
- records corresponding to the Org Agenda tags search underway. If
- this is nil you can always do it manually with the command of the
- same name.
-‘gnorb-org-bbdb-popup-layout’
- Controls the layout of the Agenda-related BBDB popup, takes the
- same values as bbdb-pop-up-layout.
-
-
-File: gnorb.info, Node: Misc Gnus, Next: Default Keybindings, Prev: Misc
Org, Up: Top
-
-11 Misc Gnus
-************
-
-* Menu:
-
-* Searching With the Registry::
-* User Options: User Options (2).
-
-
-File: gnorb.info, Node: Searching With the Registry, Next: User Options (2),
Up: Misc Gnus
-
-11.1 Searching With the Registry
-================================
-
-Gnorb can use the Gnus registry as a sort of limited search index: the
-registry tracks information about sender, recipient, subject, and a few
-other things, and while this isn’t as powerful as a full-text search
-index, it’s often sufficient. It’s also very fast, as it doesn’t rely
-on external program, and doesn’t require the user to mark a particular
-set of groups beforehand.
-
-‘gnorb-gnus-search-registry’
- Prompt the user for a search string, and match it against messages
- tracked in the registry. Search strings are given as a series of
- “key:value” terms, with double quotes around multi-word values.
- See docstring for available keys.
-‘gnorb-helm-search-registry’
- Helm users can use this function to conduct a more visual search of
- the registry. Only sender/recipient and subject lines are matched
- against.
-
- These functions are not bound by default; you might consider:
-
- (with-eval-after-load "gnus-group"
- (define-key gnus-group-group-map (kbd "/") #'gnorb-gnus-search-registry)
- (define-key gnus-group-group-map (kbd "?")
#'gnorb-helm-search-registry))
-
-
-File: gnorb.info, Node: User Options (2), Prev: Searching With the Registry,
Up: Misc Gnus
-
-11.2 User Options
-=================
-
-‘gnorb-gnus-mail-search-backend’
- Specifies the search backend that you use for searching mails.
- Currently supports notmuch, mairix, and namazu: set this option to
- one of those symbols.
-‘gnorb-gnus-capture-always-attach’
- Treat all capture templates as if they had the :gnus-attachments
- key set to “t”. This only has any effect if you’re capturing from
- a Gnus summary or article buffer.
-‘gnorb-gnus-tick-all-tracked-messages’
- When non-nil, always add the tick mark to messages when they are
- first associated with an Org heading. The mark can be safely
- deleted afterwards.
-‘gnorb-trigger-todo-default’
- Set to either ’note or ’todo to tell ‘gnorb-gnus-incoming-do-todo’
- what to do by default. You can reach the non-default behavior by
- calling that function with a prefix argument. Alternately, set to
- ’prompt to always prompt for the appropriate action.
-‘gnorb-gnus-trigger-refile-targets’
- If you use ‘gnorb-gnus-incoming-do-todo’ on an incoming message,
- Gnorb will try to locate a TODO heading that’s relevant to that
- message. If it can’t, it will prompt you for one, using the refile
- interface. This option will be used as the value of
- ‘org-refile-targets’ during that process: see the docstring of
- ‘org-refile-targets’ for the appropriate syntax.
-‘gnorb-gnus-refile-use-outline-path’
- Similar to the previous option, this option will be used as the
- value of ‘org-refile-use-outline-path’ when selecting a heading:
- see the its docstring for the meaning of its potential values.
-‘gnorb-gnus-new-todo-capture-key’
- Set this to a single-character string pointing at an Org capture
- template to use when creating TODOs from outgoing messages. The
- template is a regular capture template, with a few exceptions. If
- Gnus helps you archive outgoing messages (ie you have
- ‘gnus-message-archive-group’ set to something, and your outgoing
- messages have a “Fcc” header), a link to that message will be made,
- and you’ll be able to use all the escapes related to gnus messages.
- If you don’t archive outgoing messages, you’ll still be able to use
- the %:subject, %:to, %:toname, %:toaddress, and %:date escapes in
- the capture template.
-‘gnorb-gnus-hint-relevant-article’
- Set to “t” (the default) to have Gnorb give you a hint in the
- minibuffer when opening messages that might be relevant to existing
- Org TODOs.
-‘gnorb-gnus-summary-mark-format-letter’
- The formatting letter to use as part of your
- ‘gnus-summary-line-format’, to indicate messages which might be
- relevant to Org TODOs. Defaults to “g”, meaning it should be used
- as “%ug” in the format line.
-‘gnorb-gnus-summary-mark’
- The mark used to indicate potentially relevant messages in the
- Summary buffer, when ‘gnorb-gnus-summary-mark-format-letter’ is
- present in the format line. Defaults to “¡”.
-‘gnorb-gnus-summary-tracked-mark’
- The mark used to indicate already-tracked messages in the Summary
- buffer, when ‘gnorb-gnus-summary-mark-format-letter’ is present in
- the format line. Defaults to “&”.
-
-
-File: gnorb.info, Node: Default Keybindings, Prev: Misc Gnus, Up: Top
-
-12 Default Keybindings
-**********************
-
-Using the bundled function ‘gnorb-install-defaults’ runs the code below.
-If you don’t like these defaults, you can always do your own setup.
- (global-set-key (kbd "C-c A") 'gnorb-restore-layout)
- (eval-after-load "gnorb-bbdb"
- '(progn
- (define-key bbdb-mode-map (kbd "C-c S") #'gnorb-bbdb-mail-search)
- (define-key bbdb-mode-map (kbd "C-c l") #'gnorb-bbdb-open-link)
- (define-key bbdb-mode-map [remap bbdb-mail] #'gnorb-bbdb-mail)
- (eval-after-load "gnorb-org"
- (org-defkey org-mode-map (kbd "C-c C") #'gnorb-org-contact-link))))
- (eval-after-load "gnorb-org"
- '(progn
- (org-defkey org-mode-map (kbd "C-c t") #'gnorb-org-handle-mail)
- (org-defkey org-mode-map (kbd "C-c v") #'gnorb-org-view)
- (org-defkey org-mode-map (kbd "C-c E") #'gnorb-org-email-subtree)
- (setq gnorb-org-agenda-popup-bbdb t)
- (eval-after-load "org-agenda"
- '(progn (org-defkey org-agenda-mode-map (kbd "C-c t")
#'gnorb-org-handle-mail)
- (org-defkey org-agenda-mode-map (kbd "C-c v")
#'gnorb-org-view)))))
- (eval-after-load "gnorb-gnus"
- '(progn
- (define-key gnus-summary-mime-map "a"
#'gnorb-gnus-article-org-attach)
- (define-key gnus-summary-mode-map (kbd "C-c t")
#'gnorb-gnus-incoming-do-todo)
- (define-key gnus-summary-mode-map (kbd "C-c v") #'gnorb-gnus-view)
- (define-key gnus-summary-mode-map (kbd "C-c C-t")
#'gnorb-gnus-tag-message)
- (define-key gnus-summary-limit-map (kbd "g")
#'gnorb-gnus-insert-tagged-messages)
- (define-key gnus-summary-limit-map (kbd "G")
#'gnorb-gnus-insert-tracked-messages)
- (setq gnorb-gnus-capture-always-attach t)
- (push '("attach to org heading" . gnorb-gnus-mime-org-attach)
- gnus-mime-action-alist)
- (push '(gnorb-gnus-mime-org-attach "a" "Attach to Org heading")
- gnus-mime-button-commands)
- (setq gnus-mime-button-map
- (let ((map (make-sparse-keymap)))
- (dolist (c gnus-mime-button-commands)
- (define-key map (cadr c) (car c)))
- map))))
- (eval-after-load "message"
- '(progn
- (define-key message-mode-map (kbd "C-c t")
#'gnorb-gnus-outgoing-do-todo)))
-
-
-
-Tag Table:
-Node: Top194
-Node: Introduction1038
-Node: Installation2363
-Node: Setup2741
-Node: Email Tracking3194
-Node: Likely Workflow4398
-Node: Tracking Setup7169
-Node: Beginning and Continuing the Tracking Process8596
-Node: Trigger Actions12789
-Node: Viewing Things13863
-Node: Hinting in Gnus15979
-Node: Message Attachments17044
-Node: Registry Usage18283
-Node: Restoring Window Layout18710
-Node: Recent Mails From BBDB Contacts19107
-Node: Tagging Messages and Contacts20113
-Node: BBDB posting styles21764
-Node: Misc BBDB22671
-Node: Searching for messages from BBDB contacts22887
-Node: Citing BBDB contacts23333
-Node: User Options23654
-Node: Misc Org25177
-Node: Inserting BBDB links25354
-Node: User Options (1)25612
-Node: Misc Gnus28512
-Node: Searching With the Registry28708
-Node: User Options (2)30012
-Node: Default Keybindings33444
-
-End Tag Table
-
-
-Local Variables:
-coding: utf-8
-End:
diff --git a/packages/gnorb/gnorb.org b/packages/gnorb/gnorb.org
deleted file mode 100644
index 2c0a449..0000000
--- a/packages/gnorb/gnorb.org
+++ /dev/null
@@ -1,609 +0,0 @@
-#+TEXINFO_CLASS: info
-#+TEXINFO_HEADER: @syncodeindex pg cp
-#+TITLE: Gnorb Manual
-#+SUBTITLE: for version 1, updated 13 March, 2017
-#+TEXINFO_DIR_CATEGORY: Emacs
-#+TEXINFO_DIR_TITLE: Gnorb: (gnorb)
-#+TEXINFO_DIR_DESC: Glue code for Gnus, Org, and BBDB
-#+OPTIONS: *:nil num:t toc:nil
-* Introduction
-
-Gnorb provides glue code between the Gnus, Org, and BBDB packages.
-It's aimed at supporting email-based project management, and generally
-making it easier to keep track of email communication.
-
-Much of the code consists of single-use convenience functions, but
-tracking email conversations with Org requires is more complicated,
-and requires a bit of setup.
-
-Gnorb can be used in a modular fashion, by selectively loading the
-files "gnorb-org", "gnorb-gnus" or "gnorb-bbdb" instead of plain old
-"gnorb". The package as a whole is rather Org-centric, though, and it
-won't do much of interest without "gnorb-org".
-
-If you've installed from the package manager, of course, you don't
-need `require' statements at all. In that case, simply using the
-(autoloaded) functions that are of interest to you will be sufficient.
-
-This means that Gnorb doesn't have hard requirements to any of the
-three base libraries. For the libraries you are using, however, you'll
-get best results from using the most recent stable version (yes, that
-means BBDB 3). Some of the features in Gnorb only work with
-development versions of these libraries (those cases are noted below).
-* Installation
-Gnorb is installable via the Elpa package manager -- look for it in
-`list-packages'.
-
-An earlier version of the code is available at
-https://github.com/girzel/gnorb, but this is now out of date. Issues
-opened there will still be addressed, however.
-* Setup
-:PROPERTIES:
-:ID: 9da59609-bb3c-4970-88f6-bddca18d2ad4
-:END:
-Loading "gnorb" will make the basic functions available. Using Gnorb
-for email tracking takes a bit more setup, however -- see below.
-
-Gnorb doesn't bind any keys by default, but you can call
-`gnorb-install-defaults' to do a basic installation. The rest of this
-manual assumes those [[id:de1b2579-86c2-4bb1-b77e-3467a3d2b3c7][default
keybindings]].
-* Email Tracking
-The most interesting thing Gnorb does is using Org headings to track
-email conversations.
-
-A "tracked conversation" is essentially a message thread, with
-benefits. An Org heading (and subheadings) collect messages relevant
-to the heading. You can view all the messages at once, reply to the
-most-recently-received message, collect all message attachments on the
-heading (using org-attach), and be reminded that newly-received
-messages might be relevant to the conversation. The state of the Org
-heading tracks the state of your participation in the conversation:
-the TODO keyword might switch between REPLY and WAIT, for instance, or
-you might take notes on how everything's progressing.
-
-In general, the goal is to keep track of whole conversations, reduce
-friction when moving between Gnus and Org, and keep you in the Org
-agenda rather than in Gnus.
-** Likely Workflow
-First of all, here's a hypothetical workflow to show you how tracking
-works.
-
-Say you receive an email from Jimmy, who wants to rent a room in your
-house. "I'll respond to this later," you think.
-
-You capture an Org TODO from the email, writing a headline "Jimmy
-renting a room", and give it a REPLY keyword. Gnorb quietly records
-the correspondence between the email and the TODO, using the Gnus
-registry.
-
-The next day, looking at your Agenda, you see the TODO and decide to
-respond to the email. You hit "C-c t" on the heading, and Gnorb finds
-Jimmy's email and starts a reply to it.
-
-You tell Jimmy the room's available in March, and send the message.
-Gnorb takes you back to the heading, and asks you to trigger an action
-on it. You choose "todo state", and change the heading keyword to
-WAIT.
-
-Two days later, Jimmy replies to your message, saying that March is
-perfect. When you open his response, Gnorb politely reminds you that
-the message is relevant to an existing TODO. You hit "C-c t" on the
-message, and are again taken to the TODO and asked to trigger an
-action. Again you choose "todo state", and change the heading keyword
-back to REPLY.
-
-You get another email, from Samantha, warning you not to rent the room
-to Jimmy. She even attaches a picture of a room in her house, as it
-looked after Jimmy had stayed there for six months. It's bad. You hit
-"C-c t" on her message, and pick the "Jimmy renting a room" heading.
-This time, you choose "take note" as the trigger action, and make a
-brief note about how bad that room looked. Gnorb asks if you'd like to
-attach the picture to the Org heading. You decide you will.
-
-Now it's time to write to Jimmy and say something noncommittal.
-Hitting "C-c t" on the heading would respond to Samantha's email, the
-most recent of the associated messages, which isn't what you want.
-Instead you hit "C-c v" on the heading, which opens up a Gnus
-*Summary* buffer containing all four messages: Jimmy's first, your
-response, his response to that, and Samantha's message. You pick
-Jimmy's second email, and reply to it normally. Gnorb asks if you'd
-like to send the picture of the room as an attachment. You would not.
-When you send the reply Gnorb tracks that as well, and does the
-"trigger an action" trick again.
-
-In this way Gnorb helps you manage an entire conversation, possibly
-with multiple threads and multiple participants. Mostly all you need
-to do is hit "C-c t" on newly-received messages, and "C-c t" on the
-heading when it's time to compose a new reply.
-** Tracking Setup
-
-Email tracking requires the following steps:
-
-1. Tracking is done via the Gnus registry, so that must be activated
- with 'gnus-registry-initialize'.
-2. It also depends on the org-id package, with `org-id-track-globally'
- set to t (that's the default value, so simply loading the package
- should be enough).
-3. Add a nngnorb entry to your `gnus-secondary-select-methods'
- variable. It will look like (nngnorb "Server name"). This does
- nothing but provide a place to hang nnir searches. If you are using
- the Gnus that comes with Emacs 28 or later (or check ~(featurep
- 'nnselect)~ to be sure), this step is unnecessary.
-4. Then put a call to `gnorb-tracking-initialize' in your init files.
-5. If you're not using a local archive method for saving your sent
- messages (ie you're using IMAP), you'll also need to tell Gnorb
- where to find your sent messages. Set the variable
- `gnorb-gnus-sent-groups' to a list of strings; each string should
- indicate a fully-qualified group name, eg "nnimap+SERVER:GROUP".
-6. Set `gnorb-gnus-new-todo-capture-key' to the key of a capture
- template you want to use for creating TODOs from sent messages.
-
-** Beginning and Continuing the Tracking Process
-Email tracking starts in one of three ways:
-
-1. With an Org heading that represents an email TODO. Call
- `gnorb-org-handle-mail' (see below) on the heading to compose a new
- message, and start the tracking process.
-2. By calling org-capture on a received message. Capturing from a Gnus
- Summary buffer automatically initiates tracking.
-3. By calling `gnorb-gnus-outgoing-do-todo' while composing a message.
- This will create a new TODO heading after the message is sent.
-
-After tracking begins, it is continued by using Gnorb-specific
-commands when sending and receiving email:
-
-1. When you receive an email in Gnus that should be part of a tracked
- conversation, use `gnorb-gnus-incoming-to-todo' on it to associate
- it with the relevant Org heading.
-2. When it's time to reply to that email, use `gnorb-org-handle-mail'
- on the Org heading to start a reply to the thread.
-
-The default setup binds all these functions to "C-c t" in their
-respective modes, so just use that keybinding everywhere to keep the
-conversation going.
-
-Some more detail on the various functions:
-
-1. `gnorb-org-handle-mail' ("C-c t" in org-mode) is called on an Org
- heading to compose a new message. By default, this will begin a
- reply to the most recent message in the conversation. If there are
- no associated messages to reply to (or you call the function with a
- single prefix arg), Gnorb will look for mailto: or bbdb: links in
- the heading, and compose a new message to them.
-
- Calling the function with a double prefix arg will ignore all
- associated messages and links, and compose a blank message.
-
- Once sent, the message will be associated with the Org heading, and
- you'll be brought back to the heading and asked to trigger an
- action on it. See [[id:6bc4a833-e16a-4538-a675-b8ff21c9345d][Trigger
Actions]] for more information.
-
- `gnorb-email-subtree' is an alternative to `gnorb-org-handle-mail'.
- It does the same thing as the latter, but first exports the body of
- the subtree as either text or a file, then inserts the text into
- the message body, or attaches the file to the message,
- respectively.
-2. `gnorb-gnus-incoming-do-todo' ("C-c t" in gnus-summary-mode and
- gnus-article-mode) is called on a message in a Gnus *Summary*
- buffer. You'll be prompted for an Org heading, taken to that
- heading, and asked to trigger an action on it.
-3. `gnorb-gnus-outgoing-do-todo' ("C-c t" in message-mode) is called
- in message mode, while composing a new message. Usually this is
- only necessary when starting a new tracked conversation.
-
- If called without a prefix arg, a new Org heading will be created
- after the message is sent, and the sent message associated with it.
- The new heading will be created as a capture heading, using the
- template specified by the `gnorb-gnus-new-todo-capture-key' option.
-
- If you call this function with a single prefix arg, you'll be
- prompted to choose an existing Org heading instead. After the
- message is sent, you'll be taken to that heading and prompted to
- trigger an action on it.
-
- If you've called this function, and then realize you've associated
- the message with the wrong TODO, call it again with a double prefix
- to clear all associations.
-
- It's also possible to call this function *after* a message is sent,
- in case you forgot. Gnorb saves information about the most recently
- sent message for this purpose.
-
-An additional convenience command is available for use in Gnus summary
-buffers: `gnorb-gnus-quick-reply'. If you don't want to go through the
-whole round trip of triggering an action and then starting a new
-reply, call this command on an incoming message to associate it with a
-heading, start a reply, and associate your reply with the same
-heading.
-** Trigger Actions
-:PROPERTIES:
-:ID: 6bc4a833-e16a-4538-a675-b8ff21c9345d
-:END:
-After receiving or sending a message in a tracked conversation, you'll
-be taken to the relevant Org heading and asked to "trigger an action"
-on it. The main purpose of triggering is to associate the message with
-the Org heading, but the action also gives you a chance to do
-something useful like changing the TODO keyword, or leaving a note.
-
-At the moment there are six different possibilities:
-
-1. Change the heading's TODO state.
-2. Take a note on the heading.
-3. Associate the message, but do nothing else.
-4. Capture a new Org heading as a sibling to the tracked heading
-5. Capture a new Org heading as a child to the tracked heading
-6. Do nothing -- do not associate the message.
-
-More actions may be added in the future; it's also possible to
-rearrange or delete existing actions, and add your own: see the
-docstring of `gnorb-org-trigger-actions'.
-** Viewing Things
-:PROPERTIES:
-:END:
-
-Keeping track of a conversation is one thing, but it's very useful to
-be able to see an overview of history and current state. For this
-purpose Gnorb provides "view" commands, which by default are bound to
-"C-c v" in all contexts.
-
-Calling `gnorb-org-view' ("C-c v") on an Org heading will open an nnir
-summary buffer showing all the messages associated with that heading
-and child headings (this requires you to have added an nngnorb server
-to your Gnus backends). A minor mode is in effect, ensuring that any
-replies you send to messages in this buffer will automatically be
-associated with the original Org heading. You can also invoke
-`gnorb-summary-disassociate-message' ("C-c d") to disassociate the
-message with the Org heading.
-
-If you call `gnorb-org-view' with a prefix argument, the search group
-will be made persistent across Gnus sessions. You can re-run the
-search and update the group contents by hitting "M-g" on the group in
-the Gnus *Group* buffer.
-
-Calling `gnorb-gnus-view' ("C-c v") on a tracked message will take you
-to the tracked Org heading.
-
-From a Gnus *Summary* buffer, you can insert all tracked messages in
-the current group into the buffer with
-`gnorb-gnus-insert-tracked-messages', bound to "/ G" in the default
-keybindings. By default this will only insert messages associated with
-headings that are not in a DONE state; call with a prefix arg to
-insert all messages.
-
-As a bonus, it's possible to go into Gnus' *Server* buffer, find the
-line specifying your nngnorb server, and hit "G" (aka
-`gnus-group-make-nnir-group'). At the query prompt, enter an Org-style
-tags-todo Agenda query string (eg "+work-computer", or what have you).
-Gnorb will find all headings matching this query, scan their subtrees
-for gnus links, and then give you a Summary buffer containing all the
-linked messages. This is dog-slow at the moment; it will get faster.
-
-** Hinting in Gnus
-:PROPERTIES:
-:END:
-When you receive new mails that might be relevant to existing Org
-TODOs, Gnorb can alert you to that fact. When
-`gnorb-gnus-hint-relevant-article' is t (the default), Gnorb will
-display a message in the minibuffer when opening potentially relevant
-messages. You can then use `gnorb-gnus-incoming-to-todo' to trigger an
-action on the relevant TODO.
-
-This hinting can happen in the Gnus summary buffer as well. If you use
-the escape indicated by `gnorb-gnus-summary-mark-format-letter' as
-part of your `gnus-summary-line-format', articles that may be relevant
-to TODOs will be marked with a special character in the Summary
-buffer, as determined by `gnorb-gnus-summary-mark'. By default, the
-format letter is "g" (meaning it is used as "%ug" in the format line),
-and the mark is "&" for messages that are already tracked, and "¡" for
-messages that may be relevant.
-** Message Attachments
-:PROPERTIES:
-:END:
-Gnorb simplifies the handling of attachments that you receive in
-emails. When you call `gnorb-gnus-incoming-do-todo' on a message,
-you'll be prompted to re-attach the email's attachments onto the Org
-heading, using the org-attach library.
-
-You can also do this as part of the capture process. Set the
-new :gnus-attachments key to "t" in a capture template that you use on
-mail messages, and you'll be queried to re-attach the message's
-attachments onto the newly-captured heading.
-
-Or set `gnorb-gnus-capture-always-attach' to "t" to have Gnorb do this
-for all capture templates.
-
-You can also do this using the regular system of MIME commands,
-without invoking the email tracking process. Using the default
-bindings, pressing "a" on a MIME line will prompt you to move the
-attachment to an Org heading.
-
-The same process works in reverse: when you send a message from an Org
-heading using `gnorb-org-handle-mail', Gnorb will ask if you want to
-attach the files in the heading's org-attach directory to the outgoing
-message.
-** Registry Usage
-You can see how many associations you've got stored in the registry by
-calling `gnorb-report-tracking-usage'. This will pop up a buffer
-showing how much of the registry you're using, and offering
-keybindings for `gnorb-flush-dead-associations', to help Gnorb clean
-up after itself.
-* Restoring Window Layout
-Many Gnorb functions alter the window layout and value of point. In
-most of these cases, you can restore the previous layout using the
-interactive function `gnorb-restore-layout', by default bound to "C-c
-A".
-
-* Recent Mails From BBDB Contacts
-:PROPERTIES:
-:END:
-If you're using a recent git version of BBDB (circa mid-May 2014 or
-later), you can give your BBDB contacts a special field which will
-collect links to recent emails from that contact. The default name of
-the field is "messages", but you can customize that name using the
-`gnorb-bbdb-messages-field' option.
-
-Gnorb will not collect links by default: you need to call
-`gnorb-bbdb-open-link' on a contact once to start the process.
-Thereafter, opening mails from that contact will store a link to the
-message.
-
-Once some links are stored, `gnorb-bbdb-open-link' will open them: Use
-a prefix arg to the function call to select particular messages to
-open. There are several options controlling how all this works; see
-the gnorb-bbdb user options section below for details.
-* Tagging Messages and Contacts
-It's possible to use your defined Org tags to tag BBDB contacts and
-Gnus messages.
-
-For BBDB contacts, tags are stored in an xfield named org-tags, by
-default (you can customize the name of this field using the
-`gnorb-bbdb-org-tag-field' option). Once contacts are tagged, you can
-search for tags normally in the *BBDB* buffer. You can also pop up a
-*BBDB* buffer alongside an Org Agenda tags search, with contacts
-matching the search terms. You can have this happen automatically, by
-setting `gnorb-org-agenda-popup-bbdb' to a non-nil value, or do it
-manually by calling `gnorb-org-popup-bbdb'.
-
-Gnus messages can be tagged from a *Summary* buffer using the command
-`gnorb-gnus-tag-message' (bound to "C-c C-t" when using the default
-keybindings). You can also search for tagged messages in a group using
-`gnorb-gnus-insert-tagged-messages' (bound to "/ g" when using the
-default keybindings). The search string can be given as a more complex
-tags expression a la Org Agenda searches, ie "cat|bird-dog".
-
-If the option `gnorb-gnus-auto-tag-messages' is non-nil, any time you
-trigger an Org heading from a Gnus message, the message will "inherit"
-the tags of the Org heading.
-
-You can view Org tags on Gnus messages by adding the "%uG" spec code
-to your `gnus-group-line-format' value. That spec code can be
-customized using the `gnorb-gnus-summary-tags-format-letter' option.
-* BBDB posting styles
-:PROPERTIES:
-:END:
-Gnorb comes with a BBDB posting-style system, inspired by (copied
-from) gnus-posting-styles. You can specify how messages are composed
-to specific contacts, by matching on contact field values (the same
-way gnus-posting-styles matches on group names). See the docstring of
-`gnorb-bbdb-posting-styles' for details.
-
-In order not to be too intrusive, Gnorb doesn't alter the behavior of
-`bbdb-mail', the usual mail-composition function. Instead it provides
-an alternate `gnorb-bbdb-mail', which does exactly the same thing, but
-first processes the new mail according to `gnorb-bbdb-posting-styles'.
-If you want to use this feature regularly, you can remap `bbdb-mail'
-to `gnorb-bbdb-mail' in the `bbdb-mode-map'.
-* Misc BBDB
-** Searching for messages from BBDB contacts
-:PROPERTIES:
-:END:
-Call `gnorb-bbdb-mail-search' to search for all mail messages from the
-record(s) displayed. Currently supports the notmuch, mairix, and
-namazu search backends; set `gnorb-gnus-mail-search-backend' to one of
-those symbol values.
-** Citing BBDB contacts
-:PROPERTIES:
-:END:
-Calling `gnorb-bbdb-cite-contact' will prompt for a BBDB record and
-insert a string of the type "Bob Smith <bob@smith.com>".
-** User Options
-- `gnorb-bbdb-org-tag-field :: The name of the BBDB xfield, as a
- symbol, that holds Org-related tags. Specified as a string with
- the ":" separator between tags, same as for Org headings.
- Defaults to org-tag.
-- `gnorb-bbdb-messages-field' :: The name of the BBDB xfield that
- holds links to recently-received messages from this contact.
- Defaults to 'messages.
-- `gnorb-bbdb-collect-N-messages' :: Collect at most this many links
- to messages from this contact. Defaults to 5.
-- `gnorb-bbdb-define-recent' :: What does "recently-received" mean?
- Possible values are the symbols seen and received. When set to
- seen, the most recently-opened messages are collected. When set
- to received, the most recently-received (by Date header) messages
- are collected. Defaults to seen.
-- `gnorb-bbdb-message-link-format-multi' :: How is a single message's
- link formatted in the multi-line BBDB layout format? Defaults to
- "%:count. %D: %:subject" (see the docstring for details).
-- ` gnorb-bbdb-message-link-format-one' :: How is a single message's
- link formatted in the one-line BBDB layout format? Defaults to
- nil (see the docstring for details).
-- `gnorb-bbdb-posting-styles' :: Styles to use for influencing the
- format of mails composed to the BBDB record(s) under point (see
- the docstring for details).
-* Misc Org
-** Inserting BBDB links
-:PROPERTIES:
-:END:
-Calling `gnorb-org-contact-link' will prompt for a BBDB record and
-insert an Org link to that record at point.
-** User Options
-- `gnorb-org-after-message-setup-hook' :: Hook run in a message buffer
- after setting up the message, from `gnorb-org-handle-mail' or
- `gnorb-org-email-subtree'.
-- `gnorb-org-trigger-actions' :: List of potential actions that can be
- taken on headings after a message is sent. See docstring for
- details.
-- `gnorb-org-mail-scan-scope' :: The number of paragraphs to scan for
- mail-related links. This comes into play when calling
- `gnorb-org-handle-mail' on a heading with no associated messages,
- or when `gnorb-org-handle-mail' is called with a prefix arg.
-- `gnorb-org-find-candidates-match' :: When searching all Org files
- for headings to collect messages from, this option can limit
- which headings are searched. It is used as the second argument to
- a call to `org-map-entries', and has the same syntax as that used
- in an agenda tags view.
-- `gnorb-org-email-subtree-text-parameters' :: A plist of export
- parameters corresponding to the EXT-PLIST argument to the export
- functions, for use when exporting to text.
-- `gnorb-org-email-subtree-file-parameters' :: A plist of export
- parameters corresponding to the EXT-PLIST argument to the export
- functions, for use when exporting to a file.
-- `gnorb-org-email-subtree-text-options' :: A list of ts and nils
- corresponding to Org's export options, to be used when exporting
- to text. The options, in order, are async, subtreep,
- visible-only, and body-only.
-- `gnorb-org-email-subtree-file-options' :: A list of ts and nils
- corresponding to Org's export options, to be used when exporting
- to a file. The options, in order, are async, subtreep,
- visible-only, and body-only.
-- `gnorb-org-export-extensions' :: Correspondence between export
- backends and their respective (usual) file extensions.
-- `gnorb-org-capture-collect-link-p' :: When this is set to t, the
- capture process will always store a link to the Gnus message or
- BBDB record under point, even when the link isn't part of the
- capture template. It can then be added to the captured heading
- with org-insert-link, as usual.
-- `gnorb-org-log-add-link' :: When non-nil, any time a todo trigger
- action results in adding a note, a link to the triggering message
- will be added to the log note text.
-- `gnorb-org-agenda-popup-bbdb' :: Set to "t" to automatically pop up
- the BBDB buffer displaying records corresponding to the Org
- Agenda tags search underway. If this is nil you can always do it
- manually with the command of the same name.
-- `gnorb-org-bbdb-popup-layout' :: Controls the layout of the
- Agenda-related BBDB popup, takes the same values as
- bbdb-pop-up-layout.
-* Misc Gnus
-** Searching With the Registry
-Gnorb can use the Gnus registry as a sort of limited search index: the
-registry tracks information about sender, recipient, subject, and a
-few other things, and while this isn't as powerful as a full-text
-search index, it's often sufficient. It's also very fast, as it
-doesn't rely on external program, and doesn't require the user to mark
-a particular set of groups beforehand.
-
-- `gnorb-gnus-search-registry' :: Prompt the user for a search string,
- and match it against messages tracked in the registry. Search
- strings are given as a series of "key:value" terms, with double
- quotes around multi-word values. See docstring for available
- keys.
-- `gnorb-helm-search-registry' :: Helm users can use this function to
- conduct a more visual search of the registry. Only
- sender/recipient and subject lines are matched against.
-
-These functions are not bound by default; you might consider:
-
-#+BEGIN_SRC elisp
- (with-eval-after-load "gnus-group"
- (define-key gnus-group-group-map (kbd "/") #'gnorb-gnus-search-registry)
- (define-key gnus-group-group-map (kbd "?") #'gnorb-helm-search-registry))
-#+END_SRC
-** User Options
-- `gnorb-gnus-mail-search-backend' :: Specifies the search backend
- that you use for searching mails. Currently supports notmuch,
- mairix, and namazu: set this option to one of those symbols.
-- `gnorb-gnus-capture-always-attach' :: Treat all capture templates as
- if they had the :gnus-attachments key set to "t". This only has
- any effect if you're capturing from a Gnus summary or article
- buffer.
-- `gnorb-gnus-tick-all-tracked-messages' :: When non-nil, always add
- the tick mark to messages when they are first associated with an
- Org heading. The mark can be safely deleted afterwards.
-- `gnorb-trigger-todo-default' :: Set to either 'note or 'todo to tell
- `gnorb-gnus-incoming-do-todo' what to do by default. You can
- reach the non-default behavior by calling that function with a
- prefix argument. Alternately, set to 'prompt to always prompt for
- the appropriate action.
-- `gnorb-gnus-trigger-refile-targets' :: If you use
- `gnorb-gnus-incoming-do-todo' on an incoming message, Gnorb will
- try to locate a TODO heading that's relevant to that message. If
- it can't, it will prompt you for one, using the refile interface.
- This option will be used as the value of `org-refile-targets'
- during that process: see the docstring of `org-refile-targets'
- for the appropriate syntax.
-- `gnorb-gnus-refile-use-outline-path' :: Similar to the previous
- option, this option will be used as the value of
- `org-refile-use-outline-path' when selecting a heading: see the
- its docstring for the meaning of its potential values.
-- `gnorb-gnus-new-todo-capture-key' :: Set this to a single-character
- string pointing at an Org capture template to use when creating
- TODOs from outgoing messages. The template is a regular capture
- template, with a few exceptions. If Gnus helps you archive
- outgoing messages (ie you have `gnus-message-archive-group' set
- to something, and your outgoing messages have a "Fcc" header), a
- link to that message will be made, and you'll be able to use all
- the escapes related to gnus messages. If you don't archive
- outgoing messages, you'll still be able to use the %:subject,
- %:to, %:toname, %:toaddress, and %:date escapes in the capture
- template.
-- `gnorb-gnus-hint-relevant-article' :: Set to "t" (the default) to
- have Gnorb give you a hint in the minibuffer when opening
- messages that might be relevant to existing Org TODOs.
-- `gnorb-gnus-summary-mark-format-letter' :: The formatting letter to
- use as part of your `gnus-summary-line-format', to indicate
- messages which might be relevant to Org TODOs. Defaults to "g",
- meaning it should be used as "%ug" in the format line.
-- `gnorb-gnus-summary-mark' :: The mark used to indicate potentially
- relevant messages in the Summary buffer, when
- `gnorb-gnus-summary-mark-format-letter' is present in the format
- line. Defaults to "¡".
-- `gnorb-gnus-summary-tracked-mark' :: The mark used to indicate
- already-tracked messages in the Summary buffer, when
- `gnorb-gnus-summary-mark-format-letter' is present in the format
- line. Defaults to "&".
-* Default Keybindings
-:PROPERTIES:
-:ID: de1b2579-86c2-4bb1-b77e-3467a3d2b3c7
-:END:
-Using the bundled function `gnorb-install-defaults' runs the code
-below. If you don't like these defaults, you can always do your own setup.
-#+BEGIN_SRC emacs-lisp
- (global-set-key (kbd "C-c A") 'gnorb-restore-layout)
- (eval-after-load "gnorb-bbdb"
- '(progn
- (define-key bbdb-mode-map (kbd "C-c S") #'gnorb-bbdb-mail-search)
- (define-key bbdb-mode-map (kbd "C-c l") #'gnorb-bbdb-open-link)
- (define-key bbdb-mode-map [remap bbdb-mail] #'gnorb-bbdb-mail)
- (eval-after-load "gnorb-org"
- (org-defkey org-mode-map (kbd "C-c C") #'gnorb-org-contact-link))))
- (eval-after-load "gnorb-org"
- '(progn
- (org-defkey org-mode-map (kbd "C-c t") #'gnorb-org-handle-mail)
- (org-defkey org-mode-map (kbd "C-c v") #'gnorb-org-view)
- (org-defkey org-mode-map (kbd "C-c E") #'gnorb-org-email-subtree)
- (setq gnorb-org-agenda-popup-bbdb t)
- (eval-after-load "org-agenda"
- '(progn (org-defkey org-agenda-mode-map (kbd "C-c t")
#'gnorb-org-handle-mail)
- (org-defkey org-agenda-mode-map (kbd "C-c v")
#'gnorb-org-view)))))
- (eval-after-load "gnorb-gnus"
- '(progn
- (define-key gnus-summary-mime-map "a" #'gnorb-gnus-article-org-attach)
- (define-key gnus-summary-mode-map (kbd "C-c t")
#'gnorb-gnus-incoming-do-todo)
- (define-key gnus-summary-mode-map (kbd "C-c v") #'gnorb-gnus-view)
- (define-key gnus-summary-mode-map (kbd "C-c C-t")
#'gnorb-gnus-tag-message)
- (define-key gnus-summary-limit-map (kbd "g")
#'gnorb-gnus-insert-tagged-messages)
- (define-key gnus-summary-limit-map (kbd "G")
#'gnorb-gnus-insert-tracked-messages)
- (setq gnorb-gnus-capture-always-attach t)
- (push '("attach to org heading" . gnorb-gnus-mime-org-attach)
- gnus-mime-action-alist)
- (push '(gnorb-gnus-mime-org-attach "a" "Attach to Org heading")
- gnus-mime-button-commands)
- (setq gnus-mime-button-map
- (let ((map (make-sparse-keymap)))
- (dolist (c gnus-mime-button-commands)
- (define-key map (cadr c) (car c)))
- map))))
- (eval-after-load "message"
- '(progn
- (define-key message-mode-map (kbd "C-c t")
#'gnorb-gnus-outgoing-do-todo)))
-#+END_SRC
diff --git a/packages/gnorb/gnorb.texi b/packages/gnorb/gnorb.texi
deleted file mode 100644
index 2ad74c4..0000000
--- a/packages/gnorb/gnorb.texi
+++ /dev/null
@@ -1,819 +0,0 @@
-\input texinfo @c -*- texinfo -*-
-@c %**start of header
-@setfilename gnorb.info
-@settitle Gnorb Manual
-@documentencoding UTF-8
-@documentlanguage en
-@syncodeindex pg cp
-@c %**end of header
-
-@dircategory Emacs
-@direntry
-* Gnorb: (gnorb). Glue code for Gnus, Org, and BBDB.
-@end direntry
-
-@finalout
-@titlepage
-@title Gnorb Manual
-@subtitle for version 1, updated 13 March, 2017
-@end titlepage
-
-@ifnottex
-@node Top
-@top Gnorb Manual
-@end ifnottex
-
-@menu
-* Introduction::
-* Installation::
-* Setup::
-* Email Tracking::
-* Restoring Window Layout::
-* Recent Mails From BBDB Contacts::
-* Tagging Messages and Contacts::
-* BBDB posting styles::
-* Misc BBDB::
-* Misc Org::
-* Misc Gnus::
-* Default Keybindings::
-
-@detailmenu
---- The Detailed Node Listing ---
-
-Email Tracking
-
-* Likely Workflow::
-* Tracking Setup::
-* Beginning and Continuing the Tracking Process::
-* Trigger Actions::
-* Viewing Things::
-* Hinting in Gnus::
-* Message Attachments::
-* Registry Usage::
-
-Misc BBDB
-
-* Searching for messages from BBDB contacts::
-* Citing BBDB contacts::
-* User Options::
-
-Misc Org
-
-* Inserting BBDB links::
-* User Options: User Options (1).
-
-Misc Gnus
-
-* Searching With the Registry::
-* User Options: User Options (2).
-
-@end detailmenu
-@end menu
-
-@node Introduction
-@chapter Introduction
-
-Gnorb provides glue code between the Gnus, Org, and BBDB packages.
-It's aimed at supporting email-based project management, and generally
-making it easier to keep track of email communication.
-
-Much of the code consists of single-use convenience functions, but
-tracking email conversations with Org requires is more complicated,
-and requires a bit of setup.
-
-Gnorb can be used in a modular fashion, by selectively loading the
-files ``gnorb-org'', ``gnorb-gnus'' or ``gnorb-bbdb'' instead of plain old
-``gnorb''. The package as a whole is rather Org-centric, though, and it
-won't do much of interest without ``gnorb-org''.
-
-If you've installed from the package manager, of course, you don't
-need `require' statements at all. In that case, simply using the
-(autoloaded) functions that are of interest to you will be sufficient.
-
-This means that Gnorb doesn't have hard requirements to any of the
-three base libraries. For the libraries you are using, however, you'll
-get best results from using the most recent stable version (yes, that
-means BBDB 3). Some of the features in Gnorb only work with
-development versions of these libraries (those cases are noted below).
-
-@node Installation
-@chapter Installation
-
-Gnorb is installable via the Elpa package manager -- look for it in
-`list-packages'.
-
-An earlier version of the code is available at
-@uref{https://github.com/girzel/gnorb}, but this is now out of date. Issues
-opened there will still be addressed, however.
-
-@node Setup
-@chapter Setup
-
-Loading ``gnorb'' will make the basic functions available. Using Gnorb
-for email tracking takes a bit more setup, however -- see below.
-
-Gnorb doesn't bind any keys by default, but you can call
-`gnorb-install-defaults' to do a basic installation. The rest of this
-manual assumes those @ref{Default Keybindings, , default keybindings}.
-
-@node Email Tracking
-@chapter Email Tracking
-
-The most interesting thing Gnorb does is using Org headings to track
-email conversations.
-
-A ``tracked conversation'' is essentially a message thread, with
-benefits. An Org heading (and subheadings) collect messages relevant
-to the heading. You can view all the messages at once, reply to the
-most-recently-received message, collect all message attachments on the
-heading (using org-attach), and be reminded that newly-received
-messages might be relevant to the conversation. The state of the Org
-heading tracks the state of your participation in the conversation:
-the TODO keyword might switch between REPLY and WAIT, for instance, or
-you might take notes on how everything's progressing.
-
-In general, the goal is to keep track of whole conversations, reduce
-friction when moving between Gnus and Org, and keep you in the Org
-agenda rather than in Gnus.
-
-@menu
-* Likely Workflow::
-* Tracking Setup::
-* Beginning and Continuing the Tracking Process::
-* Trigger Actions::
-* Viewing Things::
-* Hinting in Gnus::
-* Message Attachments::
-* Registry Usage::
-@end menu
-
-@node Likely Workflow
-@section Likely Workflow
-
-First of all, here's a hypothetical workflow to show you how tracking
-works.
-
-Say you receive an email from Jimmy, who wants to rent a room in your
-house. ``I'll respond to this later,'' you think.
-
-You capture an Org TODO from the email, writing a headline ``Jimmy
-renting a room'', and give it a REPLY keyword. Gnorb quietly records
-the correspondence between the email and the TODO, using the Gnus
-registry.
-
-The next day, looking at your Agenda, you see the TODO and decide to
-respond to the email. You hit ``C-c t'' on the heading, and Gnorb finds
-Jimmy's email and starts a reply to it.
-
-You tell Jimmy the room's available in March, and send the message.
-Gnorb takes you back to the heading, and asks you to trigger an action
-on it. You choose ``todo state'', and change the heading keyword to
-WAIT@.
-
-Two days later, Jimmy replies to your message, saying that March is
-perfect. When you open his response, Gnorb politely reminds you that
-the message is relevant to an existing TODO@. You hit ``C-c t'' on the
-message, and are again taken to the TODO and asked to trigger an
-action. Again you choose ``todo state'', and change the heading keyword
-back to REPLY@.
-
-You get another email, from Samantha, warning you not to rent the room
-to Jimmy. She even attaches a picture of a room in her house, as it
-looked after Jimmy had stayed there for six months. It's bad. You hit
-``C-c t'' on her message, and pick the ``Jimmy renting a room'' heading.
-This time, you choose ``take note'' as the trigger action, and make a
-brief note about how bad that room looked. Gnorb asks if you'd like to
-attach the picture to the Org heading. You decide you will.
-
-Now it's time to write to Jimmy and say something noncommittal.
-Hitting ``C-c t'' on the heading would respond to Samantha's email, the
-most recent of the associated messages, which isn't what you want.
-Instead you hit ``C-c v'' on the heading, which opens up a Gnus
-*Summary* buffer containing all four messages: Jimmy's first, your
-response, his response to that, and Samantha's message. You pick
-Jimmy's second email, and reply to it normally. Gnorb asks if you'd
-like to send the picture of the room as an attachment. You would not.
-When you send the reply Gnorb tracks that as well, and does the
-``trigger an action'' trick again.
-
-In this way Gnorb helps you manage an entire conversation, possibly
-with multiple threads and multiple participants. Mostly all you need
-to do is hit ``C-c t'' on newly-received messages, and ``C-c t'' on the
-heading when it's time to compose a new reply.
-
-@node Tracking Setup
-@section Tracking Setup
-
-Email tracking requires the following steps:
-
-@enumerate
-@item
-Tracking is done via the Gnus registry, so that must be activated
-with 'gnus-registry-initialize'.
-@item
-It also depends on the org-id package, with `org-id-track-globally'
-set to t (that's the default value, so simply loading the package
-should be enough).
-@item
-Add a nngnorb entry to your `gnus-secondary-select-methods'
-variable. It will look like (nngnorb ``Server name''). This does
-nothing but provide a place to hang nnir searches. If you are using
-the Gnus that comes with Emacs 28 or later (or check @code{(featurep
- 'nnselect)} to be sure), this step is unnecessary.
-@item
-Then put a call to `gnorb-tracking-initialize' in your init files.
-@item
-If you're not using a local archive method for saving your sent
-messages (ie you're using IMAP), you'll also need to tell Gnorb
-where to find your sent messages. Set the variable
-`gnorb-gnus-sent-groups' to a list of strings; each string should
-indicate a fully-qualified group name, eg ``nnimap+SERVER:GROUP''.
-@item
-Set `gnorb-gnus-new-todo-capture-key' to the key of a capture
-template you want to use for creating TODOs from sent messages.
-@end enumerate
-
-@node Beginning and Continuing the Tracking Process
-@section Beginning and Continuing the Tracking Process
-
-Email tracking starts in one of three ways:
-
-@enumerate
-@item
-With an Org heading that represents an email TODO@. Call
-`gnorb-org-handle-mail' (see below) on the heading to compose a new
-message, and start the tracking process.
-@item
-By calling org-capture on a received message. Capturing from a Gnus
-Summary buffer automatically initiates tracking.
-@item
-By calling `gnorb-gnus-outgoing-do-todo' while composing a message.
-This will create a new TODO heading after the message is sent.
-@end enumerate
-
-After tracking begins, it is continued by using Gnorb-specific
-commands when sending and receiving email:
-
-@enumerate
-@item
-When you receive an email in Gnus that should be part of a tracked
-conversation, use `gnorb-gnus-incoming-to-todo' on it to associate
-it with the relevant Org heading.
-@item
-When it's time to reply to that email, use `gnorb-org-handle-mail'
-on the Org heading to start a reply to the thread.
-@end enumerate
-
-The default setup binds all these functions to ``C-c t'' in their
-respective modes, so just use that keybinding everywhere to keep the
-conversation going.
-
-Some more detail on the various functions:
-
-@enumerate
-@item
-`gnorb-org-handle-mail' (``C-c t'' in org-mode) is called on an Org
-heading to compose a new message. By default, this will begin a
-reply to the most recent message in the conversation. If there are
-no associated messages to reply to (or you call the function with a
-single prefix arg), Gnorb will look for mailto: or bbdb: links in
-the heading, and compose a new message to them.
-
-Calling the function with a double prefix arg will ignore all
-associated messages and links, and compose a blank message.
-
-Once sent, the message will be associated with the Org heading, and
-you'll be brought back to the heading and asked to trigger an
-action on it. See @ref{Trigger Actions} for more information.
-
-`gnorb-email-subtree' is an alternative to `gnorb-org-handle-mail'.
-It does the same thing as the latter, but first exports the body of
-the subtree as either text or a file, then inserts the text into
-the message body, or attaches the file to the message,
-respectively.
-@item
-`gnorb-gnus-incoming-do-todo' (``C-c t'' in gnus-summary-mode and
-gnus-article-mode) is called on a message in a Gnus *Summary*
-buffer. You'll be prompted for an Org heading, taken to that
-heading, and asked to trigger an action on it.
-@item
-`gnorb-gnus-outgoing-do-todo' (``C-c t'' in message-mode) is called
-in message mode, while composing a new message. Usually this is
-only necessary when starting a new tracked conversation.
-
-If called without a prefix arg, a new Org heading will be created
-after the message is sent, and the sent message associated with it.
-The new heading will be created as a capture heading, using the
-template specified by the `gnorb-gnus-new-todo-capture-key' option.
-
-If you call this function with a single prefix arg, you'll be
-prompted to choose an existing Org heading instead. After the
-message is sent, you'll be taken to that heading and prompted to
-trigger an action on it.
-
-If you've called this function, and then realize you've associated
-the message with the wrong TODO, call it again with a double prefix
-to clear all associations.
-
-It's also possible to call this function *after* a message is sent,
-in case you forgot. Gnorb saves information about the most recently
-sent message for this purpose.
-@end enumerate
-
-An additional convenience command is available for use in Gnus summary
-buffers: `gnorb-gnus-quick-reply'. If you don't want to go through the
-whole round trip of triggering an action and then starting a new
-reply, call this command on an incoming message to associate it with a
-heading, start a reply, and associate your reply with the same
-heading.
-
-@node Trigger Actions
-@section Trigger Actions
-
-After receiving or sending a message in a tracked conversation, you'll
-be taken to the relevant Org heading and asked to ``trigger an action''
-on it. The main purpose of triggering is to associate the message with
-the Org heading, but the action also gives you a chance to do
-something useful like changing the TODO keyword, or leaving a note.
-
-At the moment there are six different possibilities:
-
-@enumerate
-@item
-Change the heading's TODO state.
-@item
-Take a note on the heading.
-@item
-Associate the message, but do nothing else.
-@item
-Capture a new Org heading as a sibling to the tracked heading
-@item
-Capture a new Org heading as a child to the tracked heading
-@item
-Do nothing -- do not associate the message.
-@end enumerate
-
-More actions may be added in the future; it's also possible to
-rearrange or delete existing actions, and add your own: see the
-docstring of `gnorb-org-trigger-actions'.
-
-@node Viewing Things
-@section Viewing Things
-
-Keeping track of a conversation is one thing, but it's very useful to
-be able to see an overview of history and current state. For this
-purpose Gnorb provides ``view'' commands, which by default are bound to
-``C-c v'' in all contexts.
-
-Calling `gnorb-org-view' (``C-c v'') on an Org heading will open an nnir
-summary buffer showing all the messages associated with that heading
-and child headings (this requires you to have added an nngnorb server
-to your Gnus backends). A minor mode is in effect, ensuring that any
-replies you send to messages in this buffer will automatically be
-associated with the original Org heading. You can also invoke
-`gnorb-summary-disassociate-message' (``C-c d'') to disassociate the
-message with the Org heading.
-
-If you call `gnorb-org-view' with a prefix argument, the search group
-will be made persistent across Gnus sessions. You can re-run the
-search and update the group contents by hitting ``M-g'' on the group in
-the Gnus *Group* buffer.
-
-Calling `gnorb-gnus-view' (``C-c v'') on a tracked message will take you
-to the tracked Org heading.
-
-From a Gnus *Summary* buffer, you can insert all tracked messages in
-the current group into the buffer with
-`gnorb-gnus-insert-tracked-messages', bound to ``/ G'' in the default
-keybindings. By default this will only insert messages associated with
-headings that are not in a DONE state; call with a prefix arg to
-insert all messages.
-
-As a bonus, it's possible to go into Gnus' *Server* buffer, find the
-line specifying your nngnorb server, and hit ``G'' (aka
-`gnus-group-make-nnir-group'). At the query prompt, enter an Org-style
-tags-todo Agenda query string (eg ``+work-computer'', or what have you).
-Gnorb will find all headings matching this query, scan their subtrees
-for gnus links, and then give you a Summary buffer containing all the
-linked messages. This is dog-slow at the moment; it will get faster.
-
-@node Hinting in Gnus
-@section Hinting in Gnus
-
-When you receive new mails that might be relevant to existing Org
-TODOs, Gnorb can alert you to that fact. When
-`gnorb-gnus-hint-relevant-article' is t (the default), Gnorb will
-display a message in the minibuffer when opening potentially relevant
-messages. You can then use `gnorb-gnus-incoming-to-todo' to trigger an
-action on the relevant TODO@.
-
-This hinting can happen in the Gnus summary buffer as well. If you use
-the escape indicated by `gnorb-gnus-summary-mark-format-letter' as
-part of your `gnus-summary-line-format', articles that may be relevant
-to TODOs will be marked with a special character in the Summary
-buffer, as determined by `gnorb-gnus-summary-mark'. By default, the
-format letter is ``g'' (meaning it is used as ``%ug'' in the format line),
-and the mark is ``&'' for messages that are already tracked, and ``¡'' for
-messages that may be relevant.
-
-@node Message Attachments
-@section Message Attachments
-
-Gnorb simplifies the handling of attachments that you receive in
-emails. When you call `gnorb-gnus-incoming-do-todo' on a message,
-you'll be prompted to re-attach the email's attachments onto the Org
-heading, using the org-attach library.
-
-You can also do this as part of the capture process. Set the
-new :gnus-attachments key to ``t'' in a capture template that you use on
-mail messages, and you'll be queried to re-attach the message's
-attachments onto the newly-captured heading.
-
-Or set `gnorb-gnus-capture-always-attach' to ``t'' to have Gnorb do this
-for all capture templates.
-
-You can also do this using the regular system of MIME commands,
-without invoking the email tracking process. Using the default
-bindings, pressing ``a'' on a MIME line will prompt you to move the
-attachment to an Org heading.
-
-The same process works in reverse: when you send a message from an Org
-heading using `gnorb-org-handle-mail', Gnorb will ask if you want to
-attach the files in the heading's org-attach directory to the outgoing
-message.
-
-@node Registry Usage
-@section Registry Usage
-
-You can see how many associations you've got stored in the registry by
-calling `gnorb-report-tracking-usage'. This will pop up a buffer
-showing how much of the registry you're using, and offering
-keybindings for `gnorb-flush-dead-associations', to help Gnorb clean
-up after itself.
-
-@node Restoring Window Layout
-@chapter Restoring Window Layout
-
-Many Gnorb functions alter the window layout and value of point. In
-most of these cases, you can restore the previous layout using the
-interactive function `gnorb-restore-layout', by default bound to ``C-c
-A''.
-
-@node Recent Mails From BBDB Contacts
-@chapter Recent Mails From BBDB Contacts
-
-If you're using a recent git version of BBDB (circa mid-May 2014 or
-later), you can give your BBDB contacts a special field which will
-collect links to recent emails from that contact. The default name of
-the field is ``messages'', but you can customize that name using the
-`gnorb-bbdb-messages-field' option.
-
-Gnorb will not collect links by default: you need to call
-`gnorb-bbdb-open-link' on a contact once to start the process.
-Thereafter, opening mails from that contact will store a link to the
-message.
-
-Once some links are stored, `gnorb-bbdb-open-link' will open them: Use
-a prefix arg to the function call to select particular messages to
-open. There are several options controlling how all this works; see
-the gnorb-bbdb user options section below for details.
-
-@node Tagging Messages and Contacts
-@chapter Tagging Messages and Contacts
-
-It's possible to use your defined Org tags to tag BBDB contacts and
-Gnus messages.
-
-For BBDB contacts, tags are stored in an xfield named org-tags, by
-default (you can customize the name of this field using the
-`gnorb-bbdb-org-tag-field' option). Once contacts are tagged, you can
-search for tags normally in the *BBDB* buffer. You can also pop up a
-*BBDB* buffer alongside an Org Agenda tags search, with contacts
-matching the search terms. You can have this happen automatically, by
-setting `gnorb-org-agenda-popup-bbdb' to a non-nil value, or do it
-manually by calling `gnorb-org-popup-bbdb'.
-
-Gnus messages can be tagged from a *Summary* buffer using the command
-`gnorb-gnus-tag-message' (bound to ``C-c C-t'' when using the default
-keybindings). You can also search for tagged messages in a group using
-`gnorb-gnus-insert-tagged-messages' (bound to ``/ g'' when using the
-default keybindings). The search string can be given as a more complex
-tags expression a la Org Agenda searches, ie ``cat|bird-dog''.
-
-If the option `gnorb-gnus-auto-tag-messages' is non-nil, any time you
-trigger an Org heading from a Gnus message, the message will ``inherit''
-the tags of the Org heading.
-
-You can view Org tags on Gnus messages by adding the ``%uG'' spec code
-to your `gnus-group-line-format' value. That spec code can be
-customized using the `gnorb-gnus-summary-tags-format-letter' option.
-
-@node BBDB posting styles
-@chapter BBDB posting styles
-
-Gnorb comes with a BBDB posting-style system, inspired by (copied
-from) gnus-posting-styles. You can specify how messages are composed
-to specific contacts, by matching on contact field values (the same
-way gnus-posting-styles matches on group names). See the docstring of
-`gnorb-bbdb-posting-styles' for details.
-
-In order not to be too intrusive, Gnorb doesn't alter the behavior of
-`bbdb-mail', the usual mail-composition function. Instead it provides
-an alternate `gnorb-bbdb-mail', which does exactly the same thing, but
-first processes the new mail according to `gnorb-bbdb-posting-styles'.
-If you want to use this feature regularly, you can remap `bbdb-mail'
-to `gnorb-bbdb-mail' in the `bbdb-mode-map'.
-
-@node Misc BBDB
-@chapter Misc BBDB
-
-@menu
-* Searching for messages from BBDB contacts::
-* Citing BBDB contacts::
-* User Options::
-@end menu
-
-@node Searching for messages from BBDB contacts
-@section Searching for messages from BBDB contacts
-
-Call `gnorb-bbdb-mail-search' to search for all mail messages from the
-record(s) displayed. Currently supports the notmuch, mairix, and
-namazu search backends; set `gnorb-gnus-mail-search-backend' to one of
-those symbol values.
-
-@node Citing BBDB contacts
-@section Citing BBDB contacts
-
-Calling `gnorb-bbdb-cite-contact' will prompt for a BBDB record and
-insert a string of the type ``Bob Smith <bob@@smith.com>''.
-
-@node User Options
-@section User Options
-
-@table @asis
-@item `gnorb-bbdb-org-tag-field
-The name of the BBDB xfield, as a
-symbol, that holds Org-related tags. Specified as a string with
-the ``:'' separator between tags, same as for Org headings.
-Defaults to org-tag.
-@item `gnorb-bbdb-messages-field'
-The name of the BBDB xfield that
-holds links to recently-received messages from this contact.
-Defaults to 'messages.
-@item `gnorb-bbdb-collect-N-messages'
-Collect at most this many links
-to messages from this contact. Defaults to 5.
-@item `gnorb-bbdb-define-recent'
-What does ``recently-received'' mean?
-Possible values are the symbols seen and received. When set to
-seen, the most recently-opened messages are collected. When set
-to received, the most recently-received (by Date header) messages
-are collected. Defaults to seen.
-@item `gnorb-bbdb-message-link-format-multi'
-How is a single message's
-link formatted in the multi-line BBDB layout format? Defaults to
-``%:count. %D: %:subject'' (see the docstring for details).
-@item ` gnorb-bbdb-message-link-format-one'
-How is a single message's
-link formatted in the one-line BBDB layout format? Defaults to
-nil (see the docstring for details).
-@item `gnorb-bbdb-posting-styles'
-Styles to use for influencing the
-format of mails composed to the BBDB record(s) under point (see
-the docstring for details).
-@end table
-
-@node Misc Org
-@chapter Misc Org
-
-@menu
-* Inserting BBDB links::
-* User Options: User Options (1).
-@end menu
-
-@node Inserting BBDB links
-@section Inserting BBDB links
-
-Calling `gnorb-org-contact-link' will prompt for a BBDB record and
-insert an Org link to that record at point.
-
-@node User Options (1)
-@section User Options
-
-@table @asis
-@item `gnorb-org-after-message-setup-hook'
-Hook run in a message buffer
-after setting up the message, from `gnorb-org-handle-mail' or
-`gnorb-org-email-subtree'.
-@item `gnorb-org-trigger-actions'
-List of potential actions that can be
-taken on headings after a message is sent. See docstring for
-details.
-@item `gnorb-org-mail-scan-scope'
-The number of paragraphs to scan for
-mail-related links. This comes into play when calling
-`gnorb-org-handle-mail' on a heading with no associated messages,
-or when `gnorb-org-handle-mail' is called with a prefix arg.
-@item `gnorb-org-find-candidates-match'
-When searching all Org files
-for headings to collect messages from, this option can limit
-which headings are searched. It is used as the second argument to
-a call to `org-map-entries', and has the same syntax as that used
-in an agenda tags view.
-@item `gnorb-org-email-subtree-text-parameters'
-A plist of export
-parameters corresponding to the EXT-PLIST argument to the export
-functions, for use when exporting to text.
-@item `gnorb-org-email-subtree-file-parameters'
-A plist of export
-parameters corresponding to the EXT-PLIST argument to the export
-functions, for use when exporting to a file.
-@item `gnorb-org-email-subtree-text-options'
-A list of ts and nils
-corresponding to Org's export options, to be used when exporting
-to text. The options, in order, are async, subtreep,
-visible-only, and body-only.
-@item `gnorb-org-email-subtree-file-options'
-A list of ts and nils
-corresponding to Org's export options, to be used when exporting
-to a file. The options, in order, are async, subtreep,
-visible-only, and body-only.
-@item `gnorb-org-export-extensions'
-Correspondence between export
-backends and their respective (usual) file extensions.
-@item `gnorb-org-capture-collect-link-p'
-When this is set to t, the
-capture process will always store a link to the Gnus message or
-BBDB record under point, even when the link isn't part of the
-capture template. It can then be added to the captured heading
-with org-insert-link, as usual.
-@item `gnorb-org-log-add-link'
-When non-nil, any time a todo trigger
-action results in adding a note, a link to the triggering message
-will be added to the log note text.
-@item `gnorb-org-agenda-popup-bbdb'
-Set to ``t'' to automatically pop up
-the BBDB buffer displaying records corresponding to the Org
-Agenda tags search underway. If this is nil you can always do it
-manually with the command of the same name.
-@item `gnorb-org-bbdb-popup-layout'
-Controls the layout of the
-Agenda-related BBDB popup, takes the same values as
-bbdb-pop-up-layout.
-@end table
-
-@node Misc Gnus
-@chapter Misc Gnus
-
-@menu
-* Searching With the Registry::
-* User Options: User Options (2).
-@end menu
-
-@node Searching With the Registry
-@section Searching With the Registry
-
-Gnorb can use the Gnus registry as a sort of limited search index: the
-registry tracks information about sender, recipient, subject, and a
-few other things, and while this isn't as powerful as a full-text
-search index, it's often sufficient. It's also very fast, as it
-doesn't rely on external program, and doesn't require the user to mark
-a particular set of groups beforehand.
-
-@table @asis
-@item `gnorb-gnus-search-registry'
-Prompt the user for a search string,
-and match it against messages tracked in the registry. Search
-strings are given as a series of ``key:value'' terms, with double
-quotes around multi-word values. See docstring for available
-keys.
-@item `gnorb-helm-search-registry'
-Helm users can use this function to
-conduct a more visual search of the registry. Only
-sender/recipient and subject lines are matched against.
-@end table
-
-These functions are not bound by default; you might consider:
-
-@lisp
-(with-eval-after-load "gnus-group"
- (define-key gnus-group-group-map (kbd "/") #'gnorb-gnus-search-registry)
- (define-key gnus-group-group-map (kbd "?") #'gnorb-helm-search-registry))
-@end lisp
-
-@node User Options (2)
-@section User Options
-
-@table @asis
-@item `gnorb-gnus-mail-search-backend'
-Specifies the search backend
-that you use for searching mails. Currently supports notmuch,
-mairix, and namazu: set this option to one of those symbols.
-@item `gnorb-gnus-capture-always-attach'
-Treat all capture templates as
-if they had the :gnus-attachments key set to ``t''. This only has
-any effect if you're capturing from a Gnus summary or article
-buffer.
-@item `gnorb-gnus-tick-all-tracked-messages'
-When non-nil, always add
-the tick mark to messages when they are first associated with an
-Org heading. The mark can be safely deleted afterwards.
-@item `gnorb-trigger-todo-default'
-Set to either 'note or 'todo to tell
-`gnorb-gnus-incoming-do-todo' what to do by default. You can
-reach the non-default behavior by calling that function with a
-prefix argument. Alternately, set to 'prompt to always prompt for
-the appropriate action.
-@item `gnorb-gnus-trigger-refile-targets'
-If you use
-`gnorb-gnus-incoming-do-todo' on an incoming message, Gnorb will
-try to locate a TODO heading that's relevant to that message. If
-it can't, it will prompt you for one, using the refile interface.
-This option will be used as the value of `org-refile-targets'
-during that process: see the docstring of `org-refile-targets'
-for the appropriate syntax.
-@item `gnorb-gnus-refile-use-outline-path'
-Similar to the previous
-option, this option will be used as the value of
-`org-refile-use-outline-path' when selecting a heading: see the
-its docstring for the meaning of its potential values.
-@item `gnorb-gnus-new-todo-capture-key'
-Set this to a single-character
-string pointing at an Org capture template to use when creating
-TODOs from outgoing messages. The template is a regular capture
-template, with a few exceptions. If Gnus helps you archive
-outgoing messages (ie you have `gnus-message-archive-group' set
-to something, and your outgoing messages have a ``Fcc'' header), a
-link to that message will be made, and you'll be able to use all
-the escapes related to gnus messages. If you don't archive
-outgoing messages, you'll still be able to use the %:subject,
-%:to, %:toname, %:toaddress, and %:date escapes in the capture
-template.
-@item `gnorb-gnus-hint-relevant-article'
-Set to ``t'' (the default) to
-have Gnorb give you a hint in the minibuffer when opening
-messages that might be relevant to existing Org TODOs.
-@item `gnorb-gnus-summary-mark-format-letter'
-The formatting letter to
-use as part of your `gnus-summary-line-format', to indicate
-messages which might be relevant to Org TODOs. Defaults to ``g'',
-meaning it should be used as ``%ug'' in the format line.
-@item `gnorb-gnus-summary-mark'
-The mark used to indicate potentially
-relevant messages in the Summary buffer, when
-`gnorb-gnus-summary-mark-format-letter' is present in the format
-line. Defaults to ``¡''.
-@item `gnorb-gnus-summary-tracked-mark'
-The mark used to indicate
-already-tracked messages in the Summary buffer, when
-`gnorb-gnus-summary-mark-format-letter' is present in the format
-line. Defaults to ``&''.
-@end table
-
-@node Default Keybindings
-@chapter Default Keybindings
-
-Using the bundled function `gnorb-install-defaults' runs the code
-below. If you don't like these defaults, you can always do your own setup.
-@lisp
-(global-set-key (kbd "C-c A") 'gnorb-restore-layout)
-(eval-after-load "gnorb-bbdb"
- '(progn
- (define-key bbdb-mode-map (kbd "C-c S") #'gnorb-bbdb-mail-search)
- (define-key bbdb-mode-map (kbd "C-c l") #'gnorb-bbdb-open-link)
- (define-key bbdb-mode-map [remap bbdb-mail] #'gnorb-bbdb-mail)
- (eval-after-load "gnorb-org"
- (org-defkey org-mode-map (kbd "C-c C") #'gnorb-org-contact-link))))
-(eval-after-load "gnorb-org"
- '(progn
- (org-defkey org-mode-map (kbd "C-c t") #'gnorb-org-handle-mail)
- (org-defkey org-mode-map (kbd "C-c v") #'gnorb-org-view)
- (org-defkey org-mode-map (kbd "C-c E") #'gnorb-org-email-subtree)
- (setq gnorb-org-agenda-popup-bbdb t)
- (eval-after-load "org-agenda"
- '(progn (org-defkey org-agenda-mode-map (kbd "C-c t")
#'gnorb-org-handle-mail)
- (org-defkey org-agenda-mode-map (kbd "C-c v")
#'gnorb-org-view)))))
-(eval-after-load "gnorb-gnus"
- '(progn
- (define-key gnus-summary-mime-map "a" #'gnorb-gnus-article-org-attach)
- (define-key gnus-summary-mode-map (kbd "C-c t")
#'gnorb-gnus-incoming-do-todo)
- (define-key gnus-summary-mode-map (kbd "C-c v") #'gnorb-gnus-view)
- (define-key gnus-summary-mode-map (kbd "C-c C-t")
#'gnorb-gnus-tag-message)
- (define-key gnus-summary-limit-map (kbd "g")
#'gnorb-gnus-insert-tagged-messages)
- (define-key gnus-summary-limit-map (kbd "G")
#'gnorb-gnus-insert-tracked-messages)
- (setq gnorb-gnus-capture-always-attach t)
- (push '("attach to org heading" . gnorb-gnus-mime-org-attach)
- gnus-mime-action-alist)
- (push '(gnorb-gnus-mime-org-attach "a" "Attach to Org heading")
- gnus-mime-button-commands)
- (setq gnus-mime-button-map
- (let ((map (make-sparse-keymap)))
- (dolist (c gnus-mime-button-commands)
- (define-key map (cadr c) (car c)))
- map))))
-(eval-after-load "message"
- '(progn
- (define-key message-mode-map (kbd "C-c t")
#'gnorb-gnus-outgoing-do-todo)))
-@end lisp
-
-@bye
\ No newline at end of file
diff --git a/packages/gnorb/nngnorb.el b/packages/gnorb/nngnorb.el
deleted file mode 100644
index f36423f..0000000
--- a/packages/gnorb/nngnorb.el
+++ /dev/null
@@ -1,194 +0,0 @@
-;;; nngnorb.el --- Gnorb backend for Gnus -*- lexical-binding: t -*-
-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
-
-;; Author: Eric Abrahamsen <eric@ericabrahamsen.net.>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This is a backend for supporting Gnorb-related stuff. In Emacs 28
-;; this file is not needed, and won't be loaded.
-
-;; In Emacs 27 and below, Gnus searches are governed by nnir.el.
-;; Because of the way nnir is set up, the actual function to call the
-;; search is hardcoded to the server-type found in the nnir address.
-
-;; The upshot is that, if you want to return arbitrary lists of
-;; messages, possibly from multiple groups/servers, you can't simply
-;; feed your own search function to nnir. You have to create a whole
-;; new Gnus server, and then associate your search function with that
-;; server in `nnir-engines'. Thus this library, which creates an
-;; entire fake Gnus backend and requires users to add it to their Gnus
-;; config, just so we can call our function.
-
-;; It works by creating an nnir group with a gnorb address. nnir then
-;; looks up the gnorb address and sees that it should use
-;; `nnir-run-gnorb' for the search, it calls that function, which ends
-;; up calling back to `gnorb-run-search', which is the function that
-;; does the real work.
-
-;; In Emacs 28 and above, Gnorb searches are displayed using the
-;; nnselect backend, which allows us to specify our own arbitrary
-;; function -- `gnorb-run-search' -- for retrieving search results,
-;; making the whole thing much simpler.
-
-;;; Code:
-
-(require 'gnus)
-(eval-and-compile
- (require 'gnus-group)
- (require 'nnheader)
- (require 'nnir))
-
-(declare-function gnorb-run-search "gnorb-gnus")
-
-(defvar nngnorb-status-string "")
-
-(gnus-declare-backend "nngnorb" 'post-mail 'virtual)
-
-(add-to-list 'nnir-method-default-engines '(nngnorb . gnorb))
-
-(add-to-list 'nnir-engines
- '(gnorb nnir-run-gnorb))
-
-(defun nnir-run-gnorb (query _server &optional _group)
- "Run the actual search for messages to display. See nnir.el for
-some details of how this gets called.
-
-As things stand, the query string can be given as one of two
-different things. First is the ID string of an Org heading,
-prefixed with \"id+\". This was probably a bad choice as it could
-conceivably look like an org tags search string. Fix that later.
-If it's an ID, then the entire subtree text of that heading is
-scanned for gnus links, and the messages relevant to the subtree
-are collected from the registry, and all the resulting messages
-are displayed in an ephemeral group.
-
-Otherwise, the query string can be a tags match string, a la the
-Org agenda tags search. All headings matched by this string will
-be scanned for gnus messages, and those messages displayed."
- (if (cdr-safe (assq 'articles query))
- ;; The work has already been done elsewhere.
- (cdr (assq 'articles query))
- (let ((q (cdr (assq 'query query))))
- (when (and (equal "5.13" gnus-version-number) (version< emacs-version
"24.4"))
- (setq q (car q)))
- (gnorb-run-search q))))
-
-(defun gnorb-gnus-nnir-search (str persist head-text ret)
- "Create an nnir group that is set up to run a Gnorb search."
- (let* ((nnir-address (gnorb-find-gnorb-server))
- (name (if persist
- (read-string
- (format "Name for group (default %s): " head-text)
- nil nil head-text)
- (concat "gnorb-" str)))
- (method (list 'nnir nnir-address))
- (spec (list
- (cons 'nnir-specs (list (cons 'nnir-query-spec
- `((query . ,str)))
- (cons 'nnir-group-spec
- `((,nnir-address ,(list name))))))
- (cons 'nnir-artlist nil))))
- (if persist
- (progn
- (switch-to-buffer gnus-group-buffer)
- (gnus-group-make-group name method nil spec)
- (gnus-group-select-group))
- (gnus-group-read-ephemeral-group name method nil ret nil nil spec))))
-
-(defun gnorb-gnus-nnir-registry-search (articles)
- (let ((server (gnorb-find-gnorb-server)))
- (gnus-group-read-ephemeral-group
- "registry messages" `(nnir ,server)
- nil `(switch-to-buffer ,gnus-group-buffer)
- nil nil `((nnir-specs ((nnir-query-spec
- ((query . "dummy")
- (articles . ,articles)))
- (nnir-group-spec
- ((,server ("registry messages"))))))
- (nnir-artlist)))))
-
-(defun gnorb-find-gnorb-server (&optional no-error)
- "Try very hard to find a local nngnorb server.
-If NO-ERROR is non-nil, return nil on failure, otherwise an
-error."
- (or (catch 'found
- ;; Try very hard to find the server.
- (when (assoc 'nngnorb gnus-secondary-select-methods)
- (throw 'found
- (format
- "nngnorb:%s"
- (nth 1 (assoc 'nngnorb
- gnus-secondary-select-methods)))))
- (dolist (s (append gnus-server-alist gnus-server-method-cache))
- (when (eq 'nngnorb (cadr s))
- (throw 'found (car s)))))
- (unless no-error
- (user-error
- "Please add a \"nngnorb\" backend to your gnus installation."))))
-
-
-
-(defun nngnorb-retrieve-headers (_articles &optional _group _server _fetch-old)
- (with-current-buffer nntp-server-buffer
- (erase-buffer))
- 'nov)
-
-(defun nngnorb-open-server (_server &optional _definitions)
- t)
-
-(defun nngnorb-close-server (&optional _server)
- t)
-
-(defun nngnorb-request-close ()
- t)
-
-(defun nngnorb-server-opened (&optional _server)
- t)
-
-(defun nngnorb-status-message (&optional _server)
- nngnorb-status-string)
-
-(defun nngnorb-request-article (_article &optional _group _server _to-buffer)
- (setq nngnorb-status-string "No such group")
- nil)
-
-(defun nngnorb-request-group (_group &optional _server _fast _info)
- (let (deactivate-mark)
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert "411 no such news group\n")))
- (setq nngnorb-status-string "No such group")
- nil)
-
-(defun nngnorb-close-group (_group &optional _server)
- t)
-
-(defun nngnorb-request-list (&optional _server)
- (with-current-buffer nntp-server-buffer
- (erase-buffer))
- t)
-
-(defun nngnorb-request-post (&optional _server)
- (setq nngnorb-status-string "Read-only server")
- nil)
-
-(provide 'nngnorb)
-
-;;; nnnil.el ends here
diff --git a/packages/muse/README b/packages/muse/README
deleted file mode 100644
index 5f6e20e..0000000
--- a/packages/muse/README
+++ /dev/null
@@ -1,7 +0,0 @@
-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, and Texinfo.
-
-The markup rules used by Muse are intended to be very friendly to
-people familiar with Emacs. See the included manual for more
-information.
diff --git a/packages/muse/cgi.el b/packages/muse/cgi.el
deleted file mode 100644
index 0e85a52..0000000
--- a/packages/muse/cgi.el
+++ /dev/null
@@ -1,218 +0,0 @@
-;;; cgi.el -- Using Emacs for CGI scripting
-
-;; Copyright (C) 2000, 2006, 2012, 2014 Free Software Foundation, Inc.
-
-;; Author: Eric Marsden <emarsden@laas.fr>
-;; Michael Olson <mwolson@gnu.org> (slight modifications)
-;; Keywords: CGI web scripting slow
-;; Version: 0.3
-;; Time-stamp: <2001-08-24 emarsden>
-
-;; 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, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-;; MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; People who like this sort of thing will find this the sort of
-;; thing they like. -- Abraham Lincoln
-;;
-;;
-;; Overview ==========================================================
-;;
-;; A simple library for the Common Gateway Interface for Emacs,
-;; allowing you to service requests for non static web pages in elisp.
-;; Provides routines for decoding arguments to GET- and POST-type CGI
-;; requests.
-;;
-;; Usage: place a shell script such as the following in your web
-;; server's CGI directory (typically called something like
-;; /var/www/cgi-bin/):
-;;
-;; ,-------------------------------------------------------------------
-;; | #!/bin/sh
-;; |
-;; | emacs -batch -l cgi.el -f cgi-calendar
-;; `-------------------------------------------------------------------
-;;
-;; (`cgi-calendar' is a sample elisp CGI script provided at the end of
-;; this file).
-;;
-;; Alternatively, if you're running version 2.x of the linux kernel
-;; you could make .elc files directly executable via the binfmt_misc
-;; mechanism and run them straight from the cgi-bin directory.
-;;
-;; Efficiency would be improved by having Emacs bind to the http
-;; service port and spawn a thread per connection. Extending Emacs to
-;; support server sockets and multithreading is left as an exercise
-;; for the reader.
-;;
-;; References:
-;; * rfc1738 "Uniform Resource Locators"
-;; * rfc1630 "Universal Resource Identifiers in WWW"
-;;
-;; Thanks to Christoph Conrad <christoph.conrad@gmx.de> for pointing
-;; out a bug in the URI-decoding.
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (require 'calendar))
-
-(defconst cgi-url-unreserved-chars '(
- ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
- ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
- ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M
- ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
- ?\$ ?\- ?\_ ?\. ?\! ?\~ ?\* ?\' ?\( ?\) ?\,))
-
-(defun cgi-int-char (i)
- (if (fboundp 'int-char) (int-char i) i))
-
-(defun cgi-hex-char-p (ch)
- (declare (character ch))
- (let ((hexchars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
- ?A ?B ?C ?D ?E ?F)))
- (member (upcase ch) hexchars)))
-
-;; decode %xx to the corresponding character and + to ' '
-(defun cgi-decode-string (str)
- (do ((i 0)
- (len (length str))
- (decoded '()))
- ((>= i len) (concat (nreverse decoded)))
- (let ((ch (aref str i)))
- (cond ((eq ?+ ch)
- (push ?\ decoded)
- (incf i))
- ((and (eq ?% ch)
- (< (+ i 2) len)
- (cgi-hex-char-p (aref str (+ i 1)))
- (cgi-hex-char-p (aref str (+ i 2))))
- (let ((hex (string-to-number (substring str (+ i 1) (+ i 3)) 16)))
- (push (cgi-int-char hex) decoded)
- (incf i 3)))
- (t (push ch decoded)
- (incf i))))))
-
-(defun cgi-position (item seq &optional start end)
- (or start (setq start 0))
- (or end (setq end (length seq)))
- (while (and (< start end)
- (not (equal item (aref seq start))))
- (setq start (1+ start)))
- (and (< start end) start))
-
-;; Parse "foo=x&bar=y+re" into (("foo" . "x") ("bar" . "y re"))
-;; Substrings are plus-decoded and then URI-decoded.
-(defun cgi-decode (q)
- (when q
- (let ((split-=
- (lambda (str)
- (let ((pos (or (cgi-position ?= str) 0)))
- (cons (cgi-decode-string (substring str 0 pos))
- (cgi-decode-string (substring str (+ pos 1))))))))
- (mapcar split-= (split-string q "&")))))
-
-(defun cgi-lose (fmt &rest args)
- (let ((why (apply #'format fmt args)))
- (message "Script error: %s" why) ; to error_log
- (princ "Content-type: text/html\n\n") ; to browser
- (princ "<html><head><title>Script error</title></head>\r\n")
- (princ "<body><h1>Script error</h1>\r\n<p>\r\n")
- (princ why)
- (princ "\r\n</body></html>\r\n")
- (kill-emacs 0)))
-
-(defmacro cgi-evaluate (&rest forms)
- `(condition-case why
- (princ (with-output-to-string ,@forms))
- (error (cgi-lose "Emacs Lisp error: %s" why))))
-
-(defun cgi-arguments ()
- (let ((method (getenv "REQUEST_METHOD"))
- req buf)
- (cond ((null method)
- (cgi-lose "No request method specified"))
- ((string= "GET" method)
- (unless (getenv "QUERY_STRING")
- (cgi-lose "No query string for GET request"))
- (cgi-decode (getenv "QUERY_STRING")))
- ((string= "POST" method)
- (setq req (getenv "CONTENT_LENGTH"))
- (unless req
- (cgi-lose "No content-length for POST request"))
- (setq buf (get-buffer-create " *cgi*"))
- (set-buffer buf)
- (erase-buffer)
- (loop for i from 1 to (string-to-number req)
- do (insert (read-event)))
- (cgi-decode (buffer-string)))
- (t
- (cgi-lose "Can't handle request method %s" method)))))
-
-;; ====================================================================
-;; a sample application: calendar via the web. If invoked without
-;; arguments, presents a calendar for the three months around the
-;; current date. You can request a calendar for a specific period by
-;; specifying the year and the month in the query string:
-;;
-;; ~$ lynx -dump 'http://localhost/cgi-bin/cal?year=1975&month=6'
-;;
-;; When run in batch mode, text normally displayed in the echo area
-;; (via `princ' for example) goes to stdout, and thus to the browser.
-;; Text output using `message' goes to stderr, and thus normally to
-;; your web server's error_log.
-;; ====================================================================
-
-(eval-and-compile
- (if (fboundp 'calendar-extract-month)
- (defalias 'cgi-calendar-extract-month 'calendar-extract-month)
- (defalias 'cgi-calendar-extract-month 'extract-calendar-month))
-
- (if (fboundp 'calendar-extract-year)
- (defalias 'cgi-calendar-extract-year 'calendar-extract-year)
- (defalias 'cgi-calendar-extract-year 'extract-calendar-year))
-
- (if (fboundp 'calendar-generate)
- (defalias 'cgi-calendar-generate 'calendar-generate)
- (defalias 'cgi-calendar-generate 'generate-calendar)))
-
-(defun cgi-calendar-string ()
- (require 'calendar)
- (let* ((args (cgi-arguments))
- (now (calendar-current-date))
- (mnth (cdr (assoc "month" args)))
- (month (if mnth (string-to-number mnth)
- (cgi-calendar-extract-month now)))
- (yr (cdr (assoc "year" args)))
- (year (if yr (string-to-number yr)
- (cgi-calendar-extract-year now))))
- (with-temp-buffer
- (cgi-calendar-generate month year)
- (buffer-string))))
-
-(defun cgi-calendar ()
- (cgi-evaluate
- (princ "Content-type: text/html\n\n")
- (princ "<html><head><title>Emacs calendar</title></head>\r\n")
- (princ "<body> <h1>Emacs calendar</h1>\r\n")
- (princ "<pre>\r\n")
- (princ (cgi-calendar-string))
- (princ "\r\n</pre></body></html>\r\n")))
-
-(provide 'cgi)
-;;; cgi.el ends here
diff --git a/packages/muse/dir b/packages/muse/dir
deleted file mode 100644
index 22af354..0000000
--- a/packages/muse/dir
+++ /dev/null
@@ -1,18 +0,0 @@
-This is the file .../info/dir, which contains the
-topmost node of the Info hierarchy, called (dir)Top.
-The first time you invoke Info you start off looking at this node.
-
-File: dir, Node: Top This is the top of the INFO tree
-
- This (the Directory node) gives a menu of major topics.
- Typing "q" exits, "?" lists all Info commands, "d" returns here,
- "h" gives a primer for first-timers,
- "mEmacs<Return>" visits the Emacs manual, etc.
-
- In Emacs, you can click mouse button 2 on a menu item or cross reference
- to select it.
-
-* Menu:
-
-Emacs
-* Muse: (muse). Authoring and publishing environment for Emacs.
diff --git a/packages/muse/htmlize-hack.el b/packages/muse/htmlize-hack.el
deleted file mode 100644
index 61627b6..0000000
--- a/packages/muse/htmlize-hack.el
+++ /dev/null
@@ -1,20 +0,0 @@
-;; This file provides a fix for htmlize.el and Emacs 23.
-;; To use it, add the path to this directory to your load path and
-;; add (require 'htmlize-hack) to your Emacs init file.
-
-(require 'cl)
-(if t (require 'htmlize)) ; Don't load during compilation.
-
-(when (equal htmlize-version "1.34")
- (defun htmlize-face-size (face)
- ;; The size (height) of FACE, taking inheritance into account.
- ;; Only works in Emacs 21 and later.
- (let ((size-list
- (loop
- for f = face then (face-attribute f :inherit)
- until (or (null f) (eq f 'unspecified))
- for h = (face-attribute f :height)
- collect (if (eq h 'unspecified) nil h))))
- (reduce 'htmlize-merge-size (cons nil size-list)))))
-
-(provide 'htmlize-hack)
diff --git a/packages/muse/httpd.el b/packages/muse/httpd.el
deleted file mode 100644
index 1fb64a4..0000000
--- a/packages/muse/httpd.el
+++ /dev/null
@@ -1,288 +0,0 @@
-;;; httpd.el -- A web server in Emacs Lisp
-
-;; Copyright (C) 2001, 2003, 2006, 2012 Free Software Foundation, Inc.
-
-;; Author: Eric Marsden <emarsden@laas.fr>
-;; John Wiegley <johnw@gnu.org>
-;; Michael Olson <mwolson@gnu.org> (slight modifications)
-;; Version: 1.1
-;; Keywords: games
-
-;; 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, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-;; MA 02111-1307, USA.
-;;
-;; The latest version of this package should be available from
-;;
-;; <URL:http://purl.org/net/emarsden/home/downloads/>
-
-;;; Commentary:
-
-;; httpd.el is an HTTP server embedded in the Emacs. It can handle GET
-;; and HEAD requests; adding support for POST should not be too
-;; difficult. By default, httpd.el will listen on server side Emacs
-;; sockets for HTTP requests.
-;;
-;; I have only tested this code with Emacs; it may need modifications
-;; to work with XEmacs.
-;;
-;; This version has been modified to work with GNU Emacs 21 and 22.
-;;
-;;; Acknowledgements:
-;;
-;; httpd.el was inspired by pshttpd, an HTTP server written in
-;; Postscript by Anders Karlsson <URL:http://www.pugo.org:8080/>.
-;;
-;; Thanks to John Wiegley and Cyprian Adam Laskowski.
-
-;;; Code:
-
-(defvar httpd-document-root "/var/www")
-
-(defvar httpd-path-handlers '()
- "Alist of (path-regexp . handler) forms.
-If a GET request is made for an URL whose path component matches
-a PATH-REGEXP, the corresponding handler is called to generate
-content.")
-
-(defvar httpd-mime-types-alist
- '(("html" . "text/html; charset=iso-8859-1")
- ("txt" . "text/plain; charset=iso-8859-1")
- ("jpg" . "image/jpeg")
- ("jpeg" . "image/jpeg")
- ("gif" . "image/gif")
- ("png" . "image/png")
- ("tif" . "image/tiff")
- ("tiff" . "image/tiff")
- ("css" . "text/css")
- ("gz" . "application/octet-stream")
- ("ps" . "application/postscript")
- ("pdf" . "application/pdf")
- ("eps" . "application/postscript")
- ("tar" . "application/x-tar")
- ("rpm" . "application/x-rpm")
- ("zip" . "application/zip")
- ("mp3" . "audio/mpeg")
- ("mp2" . "audio/mpeg")
- ("mid" . "audio/midi")
- ("midi" . "audio/midi")
- ("wav" . "audio/x-wav")
- ("au" . "audio/basic")
- ("ram" . "audio/pn-realaudio")
- ("ra" . "audio/x-realaudio")
- ("mpg" . "video/mpeg")
- ("mpeg" . "video/mpeg")
- ("qt" . "video/quicktime")
- ("mov" . "video/quicktime")
- ("avi" . "video/x-msvideo")))
-
-(defun httpd-mime-type (filename)
- (or (cdr (assoc (file-name-extension filename) httpd-mime-types-alist))
- "text/plain"))
-
-(put 'httpd-exception 'error-conditions '(httpd-exception error))
-
-(defun defhttpd-exception (name code msg)
- (put name 'error-conditions (list name 'httpd-exception 'error))
- (put name 'httpd-code code)
- (put name 'httpd-msg msg))
-
-(defhttpd-exception 'httpd-moved/perm 301 "Moved permanently")
-(defhttpd-exception 'httpd-moved/temp 302 "Moved temporarily")
-(defhttpd-exception 'httpd-bad-request 400 "Bad request")
-(defhttpd-exception 'httpd-forbidden 403 "Forbidden")
-(defhttpd-exception 'httpd-file-not-found 404 "Not found")
-(defhttpd-exception 'httpd-method-forbidden 405 "Method not allowed")
-(defhttpd-exception 'httpd-unimplemented 500 "Internal server error")
-(defhttpd-exception 'httpd-unimplemented 501 "Not implemented")
-(defhttpd-exception 'httpd-unimplemented 503 "Service unavailable")
-
-(defvar httpd-endl "\r\n")
-
-(defvar httpd-process nil)
-(defvar httpd-bytes-sent nil) ; only used with `httpd-process'
-(defvar httpd-log-accesses t)
-
-(defun httpd-add-handler (path-regexp handler)
- (push (cons path-regexp handler) httpd-path-handlers))
-
-(defun httpd-try-internal-handler (path &optional cont)
- (catch 'result
- (dolist (elem httpd-path-handlers)
- (let ((regexp (car elem))
- (handler (cdr elem)))
- (if (string-match regexp path)
- (throw 'result (funcall handler path cont)))))))
-
-(defun httpd-date-stamp ()
- (format-time-string "[%d/%b/%Y %H:%M:%S %z]"))
-
-(defun httpd-log (&rest strings)
- (if httpd-log-accesses
- (save-excursion
- (goto-char (point-max))
- (with-current-buffer (get-buffer-create "*httpd access_log*")
- (mapc 'insert strings)))))
-
-(defun httpd-send-data (&rest strings)
- (dolist (s strings)
- (send-string httpd-process s)
- (if httpd-bytes-sent
- (setq httpd-bytes-sent (+ httpd-bytes-sent (length s))))))
-
-(defun httpd-send (code msg &rest strings)
- (httpd-log (number-to-string code) " ")
- (apply 'httpd-send-data
- "HTTP/1.0 " (number-to-string code) " " msg httpd-endl
- strings))
-
-(defun httpd-send-eof ()
- (httpd-log (number-to-string httpd-bytes-sent) "\n")
- (process-send-eof httpd-process))
-
-(defun httpd-send-file (filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (httpd-send-data (buffer-string))))
-
-(defun httpd-lose (code msg)
- (httpd-send code msg
- "Content-Type: text/html" httpd-endl
- "Connection: close" httpd-endl
- httpd-endl
- "<html><head><title>Error</title></head>" httpd-endl
- "<body><h1>" msg "</h1>" httpd-endl
- "<p>" msg httpd-endl
- "</body></html>" httpd-endl)
- (httpd-send-eof))
-
-(defun httpd-handle-redirect (req where)
- "Redirect the client to new location WHERE."
- (httpd-send 301 "Moved permanently"
- "Location: " where httpd-endl
- "URI: " where httpd-endl
- "Connection: close" httpd-endl
- httpd-endl)
- (httpd-send-eof))
-
-(defun httpd-handle-GET+HEAD (path &optional want-data req)
- (if (zerop (length path))
- (setq path "index.html"))
-
- ;; could use `expand-file-name' here instead of `concat', but we
- ;; don't want tilde expansion, etc.
- (let ((filename (concat httpd-document-root "/" path))
- modified-since)
- (cond ((httpd-try-internal-handler path) t)
- ((file-directory-p filename)
- (httpd-handle-redirect path (concat "http://"; (system-name) "/"
- path "/")))
- ((file-readable-p filename)
- (let ((attrs (file-attributes filename)))
- (if (and (string-match "^If-Modified-Since:\\s-+\\(.+\\)" req)
- (setq modified-since
- (apply 'encode-time
- (parse-time-string (match-string 1 req))))
- (time-less-p (nth 5 attrs) modified-since))
- (httpd-send 304 "Not modified"
- "Server: Emacs/httpd.el" httpd-endl
- "Connection: close" httpd-endl
- httpd-endl)
- (httpd-send 200 "OK"
- "Server: Emacs/httpd.el" httpd-endl
- "Connection: close" httpd-endl
- "MIME-Version: 1.0" httpd-endl
- "Content-Type: "
- (httpd-mime-type filename) httpd-endl
- "Content-Length: "
- (number-to-string (nth 7 attrs)) httpd-endl
- httpd-endl)
- (if want-data
- (httpd-send-file filename)))
- (httpd-send-eof)))
-
- (t (signal 'httpd-file-not-found path)))))
-
-(defun httpd-handle-request (req &optional cont)
- (httpd-log (car (process-contact httpd-process)) " - - "
- (httpd-date-stamp) " \"")
- (if (not (string-match ".+" req))
- (progn
- (httpd-log "\"")
- (error "HTTP request was empty"))
- (let ((request (match-string 0 req)))
- (httpd-log request "\" ")
- (cond
- ((string-match "\\.\\." request)
- ;; reject requests containing ".." in the path. Should really
- ;; URI-decode first.
- (signal 'httpd-forbidden request))
-
- ((string-match "\\`\\(GET\\|HEAD\\|POST\\)\\s-/\\(\\S-*\\)" request)
- (let ((kind (match-string 1 request))
- (arg (match-string 2 request)))
- (if (string= kind "POST")
- (unless (httpd-try-internal-handler arg cont)
- (signal 'httpd-unimplemented arg))
- (httpd-handle-GET+HEAD arg (string= kind "GET") req))))
-
- (t (signal 'httpd-bad-request request))))))
-
-(defun httpd-serve (proc string)
- (let ((httpd-process proc)
- (httpd-bytes-sent 0))
- (condition-case why
- (httpd-handle-request string)
- (httpd-exception
- (httpd-lose (get (car why) 'httpd-code)
- (get (car why) 'httpd-msg)))
- ;; Comment out these two lines if you want to catch errors
- ;; inside Emacs itself.
- (error
- (httpd-lose 500 (format "Emacs Lisp error: %s" why)))
- )))
-
-(defun httpd-start (&optional port)
- (interactive (list (read-string "Serve Web requests on port: " "8080")))
- (if (null port)
- (setq port 8080)
- (if (stringp port)
- (setq port (string-to-number port))))
- (if httpd-process
- (delete-process httpd-process))
- (setq httpd-process
- (if (fboundp 'make-network-process)
- (make-network-process :name "httpd"
- :buffer (generate-new-buffer "httpd")
- :host 'local :service port
- :server t :noquery t
- :filter 'httpd-serve)
- (and (fboundp 'open-network-stream-server)
- (open-network-stream-server "httpd"
- (generate-new-buffer "httpd")
- port nil 'httpd-serve))))
- (if (and (processp httpd-process)
- (eq (process-status httpd-process) 'listen))
- (message "httpd.el is listening on port %d" port)))
-
-(defun httpd-stop ()
- (interactive)
- (when httpd-process
- (message "httpd.el server on port %d has stopped"
- (cadr (process-contact httpd-process)))
- (delete-process httpd-process)
- (setq httpd-process nil)))
-
-(provide 'httpd)
-;;; httpd.el ends here
diff --git a/packages/muse/muse-backlink.el b/packages/muse/muse-backlink.el
deleted file mode 100644
index 76c0c9c..0000000
--- a/packages/muse/muse-backlink.el
+++ /dev/null
@@ -1,327 +0,0 @@
-;;; muse-backlink.el --- backlinks for Muse
-
-;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2014
-;; 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)))) ;FIXME: Why? --Stef
- (setq muse-backlink-links nil
- muse-backlink-parent-buffer nil
- muse-backlink-pending nil)
- (remove-hook (muse-backlink-get-mode-hook)
#'muse-backlink-insert-hook-func)))
-
-(defun muse-backlink-handle-link (link)
- "When appropriate, arrange for backlinks on visiting LINK."
- (when (and muse-backlink-create-backlinks
- (not muse-backlink-pending)
- (memq this-command
- '(muse-follow-name-at-point muse-follow-name-at-mouse))
- (not muse-publishing-p)
- (not (and (boundp 'muse-colors-fontifying-p)
- muse-colors-fontifying-p)))
- (require 'muse-mode)
- (setq
- muse-backlink-links
- (save-match-data
- (let* ((orig-link (or link (match-string 1)))
- (link (if (string-match "#" orig-link)
- (substring orig-link 0 (match-beginning 0))
- orig-link)))
- (unless
- (or (not muse-current-project)
- (string-match muse-url-regexp orig-link)
- (string-match muse-image-regexp orig-link)
- (and (boundp 'muse-wiki-interwiki-regexp)
- (string-match muse-wiki-interwiki-regexp
- orig-link))
- ;; Don't add a backlink if the page already
- ;; exists, whether it has been saved or not.
- (or (muse-project-page-file link muse-current-project)
- (muse-backlink-unsaved-page-p link muse-current-project))
- (string-match muse-backlink-exclude-backlink-parent-regexp
- (muse-page-name))
- (string-match muse-backlink-exclude-backlink-regexp link))
- ;; todo: Hmm. This will only work if the child page is the
- ;; same mode as the parent page.
- (add-hook (muse-backlink-get-mode-hook)
#'muse-backlink-insert-hook-func)
- (setq muse-backlink-pending t)
- (when muse-backlink-avoid-bad-links
- (setq muse-backlink-parent-buffer (current-buffer))
- (unless (muse-project-page-file
- (muse-page-name) muse-current-project)
- ;; It must be modified...
- (save-buffer)))
- (cons link
- (append (muse-backlink-get-current)
- (list (muse-make-link (muse-page-name))))))))))
- ;; Make sure we always return nil
- nil)
-
-(defun muse-backlink-install ()
- "Add backlinking functionality to muse-mode."
- (add-to-list 'muse-explicit-link-functions #'muse-backlink-handle-link))
-
-(defun muse-backlink-remove ()
- "Remove backlinking functionality from muse-mode."
- (setq muse-explicit-link-functions
- (delq #'muse-backlink-handle-link muse-explicit-link-functions)))
-
-(provide 'muse-backlink)
-;;; muse-backlink.el ends here
diff --git a/packages/muse/muse-blosxom.el b/packages/muse/muse-blosxom.el
deleted file mode 100644
index d7bce9c..0000000
--- a/packages/muse/muse-blosxom.el
+++ /dev/null
@@ -1,307 +0,0 @@
-;;; muse-blosxom.el --- publish a document tree for serving by (py)Blosxom
-
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2014
-;; 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 "")))
- (unless (member tag tags)
- (setq tags (append tags (list tag)))))
- tags)
- (funcall muse-completing-read-function
- "Category: "
- (mapcar 'list (muse-project-recurse-directory
- muse-blosxom-base-directory))))
- (read-string "Title: ")))
- (let ((file (muse-blosxom-title-to-file title)))
- (muse-project-find-file
- file "blosxom" nil
- (if muse-blosxom-use-tags
- (directory-file-name muse-blosxom-base-directory)
- (concat (directory-file-name muse-blosxom-base-directory)
- "/" category))))
- (goto-char (point-min))
- (insert "#date " (format-time-string "%Y-%m-%d-%H-%M")
- "\n#title " title)
- (if muse-blosxom-use-tags
- (if (> (length category) 0)
- (insert (concat "\n#tags " (mapconcat #'identity category ","))))
- (unless (string= category "")
- (insert (concat "\n#category " category))))
- (insert "\n\n")
- (forward-line 2))
-
-;;; Register the Muse Blosxom Publisher
-
-(muse-derive-style "blosxom-html" "html"
- :suffix 'muse-blosxom-extension
- :link-suffix 'muse-html-extension
- :header 'muse-blosxom-header
- :footer 'muse-blosxom-footer
- :after 'muse-blosxom-update-page-date-alist
- :browser 'find-file)
-
-(muse-derive-style "blosxom-xhtml" "xhtml"
- :suffix 'muse-blosxom-extension
- :link-suffix 'muse-xhtml-extension
- :header 'muse-blosxom-header
- :footer 'muse-blosxom-footer
- :after 'muse-blosxom-update-page-date-alist
- :browser 'find-file)
-
-(provide 'muse-blosxom)
-
-;;; muse-blosxom.el ends here
diff --git a/packages/muse/muse-book.el b/packages/muse/muse-book.el
deleted file mode 100644
index 213a64e..0000000
--- a/packages/muse/muse-book.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-colors.el b/packages/muse/muse-colors.el
deleted file mode 100644
index 401ed94..0000000
--- a/packages/muse/muse-colors.el
+++ /dev/null
@@ -1,1019 +0,0 @@
-;;; muse-colors.el --- coloring and highlighting used by Muse
-
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
-
-;; Author: John Wiegley (johnw AT gnu DOT org)
-;; Keywords: hypermedia
-;; Date: Thu 11-Mar-2004
-
-;; This file is part of Emacs Muse. It is not part of GNU Emacs.
-
-;; Emacs Muse is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation; either version 3, or (at your
-;; option) any later version.
-
-;; Emacs Muse is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with Emacs Muse; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Contributors:
-
-;; Lan Yufeng (nlany DOT web AT gmail DOT com) found an error where
-;; headings were being given the wrong face, contributing a patch to
-;; fix this.
-
-;; Sergey Vlasov (vsu AT altlinux DOT ru) fixed an issue with coloring
-;; links that are in consecutive lines.
-
-;; Jim Ottaway ported the <lisp> tag from emacs-wiki.
-
-;; Per B. Sederberg (per AT med DOT upenn DOT edu) contributed the
-;; viewing of inline images.
-
-;;; Code:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Emacs Muse Highlighting
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(require 'muse-mode)
-(require 'muse-regexps)
-(require 'font-lock)
-
-(defgroup muse-colors nil
- "Options controlling the behavior of Emacs Muse highlighting.
-See `muse-colors-buffer' for more information."
- :group 'muse-mode)
-
-(defcustom muse-colors-autogen-headings t
- "Specify whether the heading faces should be auto-generated.
-The default is to scale them.
-
-Choosing `outline' will copy the colors from the outline-mode
-headings.
-
-If you want to customize each of the headings individually, set
-this to nil."
- :type '(choice (const :tag "Default (scaled) headings" t)
- (const :tag "Use outline-mode headings" outline)
- (const :tag "Don't touch the headings" nil))
- :group 'muse-colors)
-
-(defcustom muse-colors-evaluate-lisp-tags t
- "Specify whether to evaluate the contents of <lisp> tags at
-display time. If nil, don't evaluate them. If non-nil, evaluate
-them.
-
-The actual contents of the buffer are not changed, only the
-displayed text."
- :type 'boolean
- :group 'muse-colors)
-
-(defcustom muse-colors-inline-images t
- "Specify whether to inline images inside the Emacs buffer. If
-nil, don't inline them. If non-nil, an image link will be
-replaced by the image.
-
-The actual contents of the buffer are not changed, only whether
-an image is displayed."
- :type 'boolean
- :group 'muse-colors)
-
-(defcustom muse-colors-inline-image-method 'default-directory
- "Determine how to locate inline images.
-Setting this to 'default-directory uses the current directory of
-the current Muse buffer.
-
-Setting this to a function calls that function with the filename
-of the image to be inlined. The value that is returned will be
-used as the filename of the image."
- :type '(choice (const :tag "Current directory" default-directory)
- (const :tag "Publishing directory"
- muse-colors-use-publishing-directory)
- (function :tag "Custom function"))
- :group 'muse-colors)
-
-(defvar muse-colors-region-end nil
- "Indicate the end of the region that is currently being font-locked.")
-(make-variable-buffer-local 'muse-colors-region-end)
-
-;;;###autoload
-(defun muse-colors-toggle-inline-images ()
- "Toggle display of inlined images on/off."
- (interactive)
- ;; toggle the custom setting
- (if (not muse-colors-inline-images)
- (setq muse-colors-inline-images t)
- (setq muse-colors-inline-images nil))
- ;; reprocess the buffer
- (muse-colors-buffer)
- ;; display informative message
- (if muse-colors-inline-images
- (message "Images are now displayed inline")
- (message "Images are now displayed as links")))
-
-(defvar muse-colors-outline-faces-list
- (if (facep 'outline-1)
- '(outline-1 outline-2 outline-3 outline-4 outline-5)
- ;; these are equivalent in coloring to the outline faces
- '(font-lock-function-name-face
- font-lock-variable-name-face
- font-lock-keyword-face
- font-lock-builtin-face
- font-lock-comment-face))
- "Outline faces to use when assigning Muse header faces.")
-
-(defun muse-make-faces-default (&optional later)
- "Generate the default face definitions for headers."
- (dolist (num '(1 2 3 4 5))
- (let ((newsym (intern (concat "muse-header-" (int-to-string num))))
- (docstring (concat
- "Muse header face. See "
- "`muse-colors-autogen-headings' before changing it.")))
- ;; put in the proper group and give documentation
- (if later
- (unless (featurep 'xemacs)
- (muse-copy-face 'variable-pitch newsym)
- (set-face-attribute newsym nil :height (1+ (* 0.1 (- 5 num)))
- :weight 'bold))
- (if (featurep 'xemacs)
- (eval `(defface ,newsym
- '((t (:size
- ,(nth (1- num)
- '("24pt" "18pt" "14pt" "12pt" "11pt"))
- :bold t)))
- ,docstring
- :group 'muse-colors))
- (eval `(defface ,newsym
- '((t (:height ,(1+ (* 0.1 (- 5 num)))
- :inherit variable-pitch
- :weight bold)))
- ,docstring
- :group 'muse-colors)))))))
-
-(progn (muse-make-faces-default))
-
-(defun muse-make-faces (&optional frame)
- "Generate face definitions for headers based the user's preferences."
- (cond
- ((not muse-colors-autogen-headings)
- nil)
- ((eq muse-colors-autogen-headings t)
- (muse-make-faces-default t))
- (t
- (dolist (num '(1 2 3 4 5))
- (let ((newsym (intern (concat "muse-header-" (int-to-string num)))))
- ;; copy the desired face definition
- (muse-copy-face (nth (1- num) muse-colors-outline-faces-list)
- newsym))))))
-
-;; after displaying the Emacs splash screen, the faces are wiped out,
-;; so recover from that
-(add-hook 'window-setup-hook #'muse-make-faces)
-;; ditto for when a new frame is created
-(when (boundp 'after-make-frame-functions)
- (add-hook 'after-make-frame-functions #'muse-make-faces))
-
-(defface muse-link
- '((t :inherit link))
- "Face for Muse cross-references."
- :group 'muse-colors)
-
-(defface muse-bad-link
- '((default :inherit link)
- (((class color) (background light))
- (:foreground "red" :underline "red" :bold t))
- (((class color) (background dark))
- (:foreground "coral" :underline "coral" :bold t))
- (t (:bold t)))
- "Face for bad Muse cross-references."
- :group 'muse-colors)
-
-(defface muse-verbatim
- '((((class color) (background light))
- (:foreground "slate gray"))
- (((class color) (background dark))
- (:foreground "gray")))
- "Face for verbatim text."
- :group 'muse-colors)
-
-(defface muse-emphasis-1
- '((t (:italic t)))
- "Face for italic emphasized text."
- :group 'muse-colors)
-
-(defface muse-emphasis-2
- '((t (:bold t)))
- "Face for bold emphasized text."
- :group 'muse-colors)
-
-(defface muse-emphasis-3
- '((t (:bold t :italic t)))
- "Face for bold italic emphasized text."
- :group 'muse-colors)
-
-(muse-copy-face 'italic 'muse-emphasis-1)
-(muse-copy-face 'bold 'muse-emphasis-2)
-(muse-copy-face 'bold-italic 'muse-emphasis-3)
-
-(defcustom muse-colors-buffer-hook nil
- "A hook run after a region is highlighted.
-Each function receives three arguments: BEG END VERBOSE.
-BEG and END mark the range being highlighted, and VERBOSE specifies
-whether progress messages should be displayed to the user."
- :type 'hook
- :group 'muse-colors)
-
-(defvar muse-colors-highlighting-registry nil
- "The rules for highlighting Muse and Muse-derived buffers.
-This is automatically generated when using font-lock in Muse buffers.
-
-This an alist of major-mode symbols to `muse-colors-rule' objects.")
-
-(defun muse-colors-make-highlighting-struct ()
- (list nil nil nil))
-(defconst muse-colors-highlighting.regexp 0
- "Regexp matching each car of the markup of the current rule.")
-(defconst muse-colors-highlighting.vector 1
- "Vector of all characters that are part of the markup of the current rule.
-This is composed of the 2nd element of each markup entry.")
-(defconst muse-colors-highlighting.remaining 2
- "Expressions for highlighting a buffer which have no corresponding
-entry in the vector.")
-
-(defsubst muse-colors-highlighting-entry (mode)
- "Return the highlighting rules for MODE."
- (assq mode muse-colors-highlighting-registry))
-
-(defun muse-colors-find-highlighting (mode)
- "Return the highlighting rules to be used for MODE.
-If MODE does not have highlighting rules, check its parent modes."
- (let ((seen nil))
- (catch 'rules
- (while (and mode (not (memq mode seen)))
- (let ((entry (muse-colors-highlighting-entry mode)))
- (when entry (throw 'rules (cdr entry))))
- (setq seen (cons mode seen))
- (setq mode (get mode 'derived-mode-parent)))
- nil)))
-
-(defun muse-colors-define-highlighting (mode markup)
- "Create or update the markup rules for MODE, using MARKUP.
-
-See `muse-colors-markup' for an explanation of the format that MARKUP
-should take."
- (unless (and (symbolp mode) mode (consp markup))
- (error "Invalid arguments"))
- (let* ((highlighting-entry (muse-colors-highlighting-entry mode))
- (struct (cdr highlighting-entry))
- (regexp nil)
- (vector nil)
- (remaining nil))
- ;; Initialize struct
- (if struct
- (setq vector (nth muse-colors-highlighting.vector struct))
- (setq struct (muse-colors-make-highlighting-struct)))
- ;; Initialize vector
- (if vector
- (let ((i 0))
- (while (< i 128)
- (aset vector i nil)
- (setq i (1+ i))))
- (setq vector (make-vector 128 nil)))
- ;; Determine vector, regexp, remaining
- (let ((regexps nil)
- (rules nil))
- (dolist (rule markup)
- (let ((value (cond ((symbolp (car rule))
- (symbol-value (car rule)))
- ((stringp (car rule))
- (car rule))
- (t nil))))
- (when value
- (setq rules (cons rule rules))
- (setq regexps (cons value regexps)))))
- (setq regexps (nreverse regexps))
- (setq regexp (concat "\\(" (mapconcat #'identity regexps "\\|") "\\)"))
- (dolist (rule rules)
- (if (eq (nth 1 rule) t)
- (setq remaining (cons (cons (nth 0 rule) (nth 2 rule))
- remaining))
- (aset vector (nth 1 rule)
- (cons (cons (nth 0 rule) (nth 2 rule))
- (aref vector (nth 1 rule)))))))
- ;; Update the struct
- (setcar (nthcdr muse-colors-highlighting.regexp struct) regexp)
- (setcar (nthcdr muse-colors-highlighting.vector struct) vector)
- (setcar (nthcdr muse-colors-highlighting.remaining struct) remaining)
- ;; Update entry for mode in muse-colors-highlighting-registry
- (if highlighting-entry
- (setcdr highlighting-entry struct)
- (setq muse-colors-highlighting-registry
- (cons (cons mode struct)
- muse-colors-highlighting-registry)))))
-
-(defun muse-configure-highlighting (sym val)
- "Extract color markup information from VAL and set to SYM.
-This is usually called with `muse-colors-markup' as both arguments."
- (muse-colors-define-highlighting 'muse-mode val)
- (set sym val))
-
-(defun muse-colors-emphasized ()
- "Color emphasized text and headings."
- ;; Here we need to check four different points - the start and end
- ;; of the leading *s, and the start and end of the trailing *s. We
- ;; allow the outsides to be surrounded by whitespace or punctuation,
- ;; but no word characters, and the insides must not be surrounded by
- ;; whitespace or punctuation. Thus the following are valid:
- ;;
- ;; " *foo bar* "
- ;; "**foo**,"
- ;; and the following is invalid:
- ;; "** testing **"
- (let* ((beg (match-beginning 0))
- (e1 (match-end 0))
- (leader (- e1 beg))
- b2 e2 multiline)
- (unless (or (eq (get-text-property beg 'invisible) 'muse)
- (get-text-property beg 'muse-comment)
- (get-text-property beg 'muse-directive))
- ;; check if it's a header
- (if (eq (char-after e1) ?\ )
- (when (or (= beg (point-min))
- (eq (char-before beg) ?\n))
- (add-text-properties
- (muse-line-beginning-position) (muse-line-end-position)
- (list 'face (intern (concat "muse-header-"
- (int-to-string leader))))))
- ;; beginning of line or space or symbol
- (when (or (= beg (point-min))
- (eq (char-syntax (char-before beg)) ?\ )
- (memq (char-before beg)
- '(?\- ?\[ ?\< ?\( ?\' ?\` ?\" ?\n)))
- (save-excursion
- (skip-chars-forward "^*<>\n" muse-colors-region-end)
- (when (eq (char-after) ?\n)
- (setq multiline t)
- (skip-chars-forward "^*<>" muse-colors-region-end))
- (setq b2 (point))
- (skip-chars-forward "*" muse-colors-region-end)
- (setq e2 (point))
- ;; Abort if space exists just before end
- ;; or bad leader
- ;; or no '*' at end
- ;; or word constituent follows
- (unless (or (> leader 5)
- (not (eq leader (- e2 b2)))
- (eq (char-syntax (char-before b2)) ?\ )
- (not (eq (char-after b2) ?*))
- (and (not (eobp))
- (eq (char-syntax (char-after (1+ b2))) ?w)))
- (add-text-properties beg e1 '(invisible muse))
- (add-text-properties
- e1 b2 (list 'face (cond ((= leader 1) 'muse-emphasis-1)
- ((= leader 2) 'muse-emphasis-2)
- ((= leader 3) 'muse-emphasis-3))))
- (add-text-properties b2 e2 '(invisible muse))
- (when multiline
- (add-text-properties
- beg e2 '(font-lock-multiline t))))))))))
-
-(defun muse-colors-underlined ()
- "Color underlined text."
- (let ((start (match-beginning 0))
- multiline)
- (unless (or (eq (get-text-property start 'invisible) 'muse)
- (get-text-property start 'muse-comment)
- (get-text-property start 'muse-directive))
- ;; beginning of line or space or symbol
- (when (or (= start (point-min))
- (eq (char-syntax (char-before start)) ?\ )
- (memq (char-before start)
- '(?\- ?\[ ?\< ?\( ?\' ?\` ?\" ?\n)))
- (save-excursion
- (skip-chars-forward "^_<>\n" muse-colors-region-end)
- (when (eq (char-after) ?\n)
- (setq multiline t)
- (skip-chars-forward "^_<>" muse-colors-region-end))
- ;; Abort if space exists just before end
- ;; or no '_' at end
- ;; or word constituent follows
- (unless (or (eq (char-syntax (char-before (point))) ?\ )
- (not (eq (char-after (point)) ?_))
- (and (not (eobp))
- (eq (char-syntax (char-after (1+ (point)))) ?w)))
- (add-text-properties start (1+ start) '(invisible muse))
- (add-text-properties (1+ start) (point) '(face underline))
- (add-text-properties (point)
- (min (1+ (point)) (point-max))
- '(invisible muse))
- (when multiline
- (add-text-properties
- start (min (1+ (point)) (point-max))
- '(font-lock-multiline t)))))))))
-
-(defun muse-colors-verbatim ()
- "Render in teletype and suppress further parsing."
- (let ((start (match-beginning 0))
- multiline)
- (unless (or (eq (get-text-property start 'invisible) 'muse)
- (get-text-property start 'muse-comment)
- (get-text-property start 'muse-directive))
- ;; beginning of line or space or symbol
- (when (or (= start (point-min))
- (eq (char-syntax (char-before start)) ?\ )
- (memq (char-before start)
- '(?\- ?\[ ?\< ?\( ?\' ?\` ?\" ?\n)))
- (let ((pos (point)))
- (skip-chars-forward "^=\n" muse-colors-region-end)
- (when (eq (char-after) ?\n)
- (setq multiline t)
- (skip-chars-forward "^=" muse-colors-region-end))
- ;; Abort if space exists just before end
- ;; or no '=' at end
- ;; or word constituent follows
- (unless (or (eq (char-syntax (char-before (point))) ?\ )
- (not (eq (char-after (point)) ?=))
- (and (not (eobp))
- (eq (char-syntax (char-after (1+ (point)))) ?w)))
- (setq pos (min (1+ (point)) (point-max)))
- (add-text-properties start (1+ start) '(invisible muse))
- (add-text-properties (1+ start) (point) '(face muse-verbatim))
- (add-text-properties (point)
- (min (1+ (point)) (point-max))
- '(invisible muse))
- (when multiline
- (add-text-properties
- start (min (1+ (point)) (point-max))
- '(font-lock-multiline t))))
- (goto-char pos))))))
-
-(defcustom muse-colors-markup
- `(;; make emphasized text appear emphasized
- ("\\*\\{1,5\\}" ?* muse-colors-emphasized)
-
- ;; make underlined text appear underlined
- (,(concat "_[^" muse-regexp-blank "_\n]")
- ?_ muse-colors-underlined)
-
- ("^#title " ?\# muse-colors-title)
-
- (muse-explicit-link-regexp ?\[ muse-colors-explicit-link)
-
- ;; render in teletype and suppress further parsing
- (,(concat "=[^" muse-regexp-blank "=\n]") ?= muse-colors-verbatim)
-
- ;; highlight any markup tags encountered
- (muse-tag-regexp ?\< muse-colors-custom-tags)
-
- ;; display comments
- (,(concat "^;[" muse-regexp-blank "]") ?\; muse-colors-comment)
-
- ;; this has to come later since it doesn't have a special
- ;; character in the second cell
- (muse-url-regexp t muse-colors-implicit-link)
- )
- "Expressions to highlight an Emacs Muse buffer.
-These are arranged in a rather special fashion, so as to be as quick as
-possible.
-
-Each element of the list is itself a list, of the form:
-
- (LOCATE-REGEXP TEST-CHAR MATCH-FUNCTION)
-
-LOCATE-REGEXP is a partial regexp, and should be the smallest possible
-regexp to differentiate this rule from other rules. It may also be a
-symbol containing such a regexp. The buffer region is scanned only
-once, and LOCATE-REGEXP indicates where the scanner should stop to
-look for highlighting possibilities.
-
-TEST-CHAR is a char or t. The character should match the beginning
-text matched by LOCATE-REGEXP. These chars are used to build a vector
-for fast MATCH-FUNCTION calling.
-
-MATCH-FUNCTION is the function called when a region has been
-identified. It is responsible for adding the appropriate text
-properties to change the appearance of the buffer.
-
-This markup is used to modify the appearance of the original text to
-make it look more like the published HTML would look (like making some
-markup text invisible, inlining images, etc).
-
-font-lock is used to apply the markup rules, so that they can happen
-on a deferred basis. They are not always accurate, but you can use
-\\[font-lock-fontifty-block] near the point of error to force
-fontification in that area."
- :type '(repeat
- (list :tag "Highlight rule"
- (choice (regexp :tag "Locate regexp")
- (symbol :tag "Regexp symbol"))
- (choice (character :tag "Confirm character")
- (const :tag "Default rule" t))
- function))
- :set 'muse-configure-highlighting
- :group 'muse-colors)
-
-;; XEmacs users don't have `font-lock-multiline'.
-(unless (boundp 'font-lock-multiline)
- (defvar font-lock-multiline nil))
-
-(defun muse-use-font-lock ()
- "Set up font-locking for Muse."
- (muse-add-to-invisibility-spec 'muse)
- (set (make-local-variable 'font-lock-multiline) 'undecided)
- (set (make-local-variable 'font-lock-defaults)
- `(nil t nil nil beginning-of-line
- (font-lock-fontify-region-function . muse-colors-region)
- (font-lock-unfontify-region-function
- . muse-unhighlight-region)))
- (set (make-local-variable 'font-lock-fontify-region-function)
- 'muse-colors-region)
- (set (make-local-variable 'font-lock-unfontify-region-function)
- 'muse-unhighlight-region)
- (muse-make-faces)
- (muse-colors-define-highlighting 'muse-mode muse-colors-markup)
- (font-lock-mode t))
-
-(defun muse-colors-buffer ()
- "Re-highlight the entire Muse buffer."
- (interactive)
- (muse-colors-region (point-min) (point-max) t))
-
-(defvar muse-colors-fontifying-p nil
- "Indicate whether Muse is fontifying the current buffer.")
-(make-variable-buffer-local 'muse-colors-fontifying-p)
-
-(defvar muse-colors-delayed-commands nil
- "Commands to be run immediately after highlighting a region.
-
-This is meant to accommodate highlighting <lisp> in #title
-directives after everything else.
-
-It may be modified by Muse functions during highlighting, but not
-the user.")
-(make-variable-buffer-local 'muse-colors-delayed-commands)
-
-(defun muse-colors-region (beg end &optional verbose)
- "Apply highlighting according to `muse-colors-markup'.
-Note that this function should NOT change the buffer, nor should any
-of the functions listed in `muse-colors-markup'."
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- (modified-p (buffer-modified-p))
- (muse-colors-fontifying-p t)
- (muse-colors-region-end (muse-line-end-position end))
- (muse-colors-delayed-commands nil)
- (highlighting (muse-colors-find-highlighting major-mode))
- regexp vector remaining
- deactivate-mark)
- (unless highlighting
- (error "No highlighting found for this mode"))
- (setq regexp (nth muse-colors-highlighting.regexp highlighting)
- vector (nth muse-colors-highlighting.vector highlighting)
- remaining (nth muse-colors-highlighting.remaining highlighting))
- (unwind-protect
- (save-excursion
- (save-restriction
- (widen)
- ;; check to see if we should expand the beg/end area for
- ;; proper multiline matches
- (when (and font-lock-multiline
- (> beg (point-min))
- (get-text-property (1- beg) 'font-lock-multiline))
- ;; We are just after or in a multiline match.
- (setq beg (or (previous-single-property-change
- beg 'font-lock-multiline)
- (point-min)))
- (goto-char beg)
- (setq beg (muse-line-beginning-position)))
- (when font-lock-multiline
- (setq end (or (text-property-any end (point-max)
- 'font-lock-multiline nil)
- (point-max))))
- (goto-char end)
- (setq end (muse-line-beginning-position 2))
- ;; Undo any fontification in the area.
- (font-lock-unfontify-region beg end)
- ;; And apply fontification based on `muse-colors-markup'
- (let ((len (float (- end beg)))
- (case-fold-search nil)
- markup-list)
- (goto-char beg)
- (while (and (< (point) end)
- (re-search-forward regexp end t))
- (if verbose
- (message "Highlighting buffer...%d%%"
- (* (/ (float (- (point) beg)) len) 100)))
- (let ((ch (char-after (match-beginning 0))))
- (when (< ch 128)
- (setq markup-list (aref vector ch))))
- (unless markup-list
- (setq markup-list remaining))
- (let ((prev (point)))
- ;; backtrack and figure out which rule matched
- (goto-char (match-beginning 0))
- (catch 'done
- (dolist (entry markup-list)
- (let ((value (cond ((symbolp (car entry))
- (symbol-value (car entry)))
- ((stringp (car entry))
- (car entry))
- (t nil))))
- (when (and (stringp value) (looking-at value))
- (goto-char (match-end 0))
- (when (cdr entry)
- (funcall (cdr entry)))
- (throw 'done t))))
- ;; if no rule matched, which should never happen,
- ;; return to previous position so that forward
- ;; progress is ensured
- (goto-char prev))))
- (dolist (command muse-colors-delayed-commands)
- (apply (car command) (cdr command)))
- (run-hook-with-args 'muse-colors-buffer-hook
- beg end verbose)
- (if verbose (message "Highlighting buffer...done")))))
- (set-buffer-modified-p modified-p))))
-
-(defcustom muse-colors-tags
- '(("example" t nil nil muse-colors-example-tag)
- ("code" t nil nil muse-colors-example-tag)
- ("verbatim" t nil nil muse-colors-literal-tag)
- ("lisp" t t nil muse-colors-lisp-tag)
- ("literal" t nil nil muse-colors-literal-tag))
- "A list of tag specifications for specially highlighting text.
-XML-style tags are the best way to add custom highlighting to Muse.
-This is easily accomplished by customizing this list of markup tags.
-
-For each entry, the name of the tag is given, whether it expects
-a closing tag and/or an optional set of attributes, whether it is
-nestable, and a function that performs whatever action is desired
-within the delimited region.
-
-The function is called with three arguments, the beginning and
-end of the region surrounded by the tags. If properties are
-allowed, they are passed as a third argument in the form of an
-alist. The `end' argument to the function is the last character
-of the enclosed tag or region.
-
-Functions should not modify the contents of the buffer."
- :type '(repeat (list (string :tag "Markup tag")
- (boolean :tag "Expect closing tag" :value t)
- (boolean :tag "Parse attributes" :value nil)
- (boolean :tag "Nestable" :value nil)
- function))
- :group 'muse-colors)
-
-(defvar muse-colors-inhibit-tags-in-directives t
- "If non-nil, don't allow tags to be interpreted in directives.
-This is used to delay highlighting of <lisp> tags in #title until later.")
-(make-variable-buffer-local 'muse-colors-inhibit-tags-in-directives)
-
-(defsubst muse-colors-tag-info (tagname &rest args)
- "Get tag info associated with TAGNAME, ignoring ARGS."
- (assoc tagname muse-colors-tags))
-
-(defun muse-colors-custom-tags ()
- "Highlight `muse-colors-tags'."
- (let ((tag-info (muse-colors-tag-info (match-string 1))))
- (unless (or (not tag-info)
- (get-text-property (match-beginning 0) 'muse-comment)
- (and muse-colors-inhibit-tags-in-directives
- (get-text-property (match-beginning 0) 'muse-directive)))
- (let ((closed-tag (match-string 3))
- (start (match-beginning 0))
- end attrs)
- (when (nth 2 tag-info)
- (let ((attrstr (match-string 2)))
- (while (and attrstr
- (string-match (concat "\\([^"
- muse-regexp-blank
- "=\n]+\\)\\(=\""
- "\\([^\"]+\\)\"\\)?")
- attrstr))
- (let ((attr (cons (downcase
- (muse-match-string-no-properties 1 attrstr))
- (muse-match-string-no-properties 3 attrstr))))
- (setq attrstr (replace-match "" t t attrstr))
- (if attrs
- (nconc attrs (list attr))
- (setq attrs (list attr)))))))
- (if (and (cadr tag-info) (not closed-tag))
- (if (muse-goto-tag-end (car tag-info) (nth 3 tag-info))
- (setq end (match-end 0))
- (setq tag-info nil)))
- (when tag-info
- (let ((args (list start end)))
- (if (nth 2 tag-info)
- (nconc args (list attrs)))
- (apply (nth 4 tag-info) args)))))))
-
-(defun muse-unhighlight-region (begin end &optional verbose)
- "Remove all visual highlights in the buffer (except font-lock)."
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- (modified-p (buffer-modified-p))
- deactivate-mark)
- (unwind-protect
- (remove-text-properties
- begin end '(face nil font-lock-multiline nil end-glyph nil
- invisible nil intangible nil display nil
- mouse-face nil keymap nil help-echo nil
- muse-link nil muse-directive nil muse-comment nil
- muse-no-implicit-link nil muse-no-flyspell nil))
- (set-buffer-modified-p modified-p))))
-
-(defun muse-colors-example-tag (beg end)
- "Strip properties and colorize with `muse-verbatim'."
- (muse-unhighlight-region beg end)
- (let ((multi (save-excursion
- (goto-char beg)
- (forward-line 1)
- (> end (point)))))
- (add-text-properties beg end `(face muse-verbatim
- font-lock-multiline ,multi))))
-
-(defun muse-colors-literal-tag (beg end)
- "Strip properties and mark as literal."
- (muse-unhighlight-region beg end)
- (let ((multi (save-excursion
- (goto-char beg)
- (forward-line 1)
- (> end (point)))))
- (add-text-properties beg end `(font-lock-multiline ,multi))))
-
-(defun muse-colors-lisp-tag (beg end attrs)
- "Color the region enclosed by a <lisp> tag."
- (if (not muse-colors-evaluate-lisp-tags)
- (muse-colors-literal-tag beg end)
- (muse-unhighlight-region beg end)
- (let (beg-lisp end-lisp)
- (save-match-data
- (goto-char beg)
- (setq beg-lisp (and (looking-at "<[^>]+>")
- (match-end 0)))
- (goto-char end)
- (setq end-lisp (and (muse-looking-back "</[^>]+>")
- (match-beginning 0))))
- (add-text-properties
- beg end
- (list 'font-lock-multiline t
- 'display (muse-eval-lisp
- (concat
- "(progn "
- (buffer-substring-no-properties beg-lisp end-lisp)
- ")"))
- 'intangible t)))))
-
-(defvar muse-mode-local-map
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'muse-follow-name-at-point)
- (define-key map [(control ?m)] 'muse-follow-name-at-point)
- (define-key map [(shift return)] 'muse-follow-name-at-point-other-window)
- (if (featurep 'xemacs)
- (progn
- (define-key map [(button2)] 'muse-follow-name-at-mouse)
- (define-key map [(shift button2)]
- 'muse-follow-name-at-mouse-other-window))
- (define-key map [(shift control ?m)]
- 'muse-follow-name-at-point-other-window)
- (define-key map [mouse-2] 'muse-follow-name-at-mouse)
- (define-key map [(shift mouse-2)]
- 'muse-follow-name-at-mouse-other-window)
- (unless (eq emacs-major-version 21)
- (set-keymap-parent map muse-mode-map)))
- map)
- "Local keymap used by Muse while on a link.")
-
-(defvar muse-keymap-property
- (if (or (featurep 'xemacs)
- (>= emacs-major-version 21))
- 'keymap
- 'local-map)
- "The name of the keymap or local-map property.")
-
-(defsubst muse-link-properties (help-str &optional face)
- "Determine text properties to use for a link."
- (append (if face
- (list 'face face 'mouse-face 'highlight 'muse-link t)
- (list 'invisible 'muse 'intangible t))
- (list 'help-echo help-str 'rear-nonsticky t
- muse-keymap-property muse-mode-local-map)))
-
-(defun muse-link-face (link-name &optional explicit)
- "Return the type of LINK-NAME as a face symbol.
-For EXPLICIT links, this is either a normal link or a bad-link
-face. For implicit links, it is either colored normally or
-ignored."
- (save-match-data
- (let ((link (if explicit
- (muse-handle-explicit-link link-name)
- (muse-handle-implicit-link link-name))))
- (when link
- (cond ((string-match muse-url-regexp link)
- 'muse-link)
- ((muse-file-remote-p link)
- 'muse-link)
- ((string-match muse-file-regexp link)
- (when (string-match "/[^/]+#[^#./]+\\'" link)
- ;; strip anchor from the end of a path
- (setq link (substring link 0 (match-beginning 0))))
- (if (file-exists-p link)
- 'muse-link
- 'muse-bad-link))
- ((not (featurep 'muse-project))
- 'muse-link)
- (t
- (if (string-match "#" link)
- (setq link (substring link 0 (match-beginning 0))))
- (if (or (and (muse-project-of-file)
- (muse-project-page-file
- link muse-current-project t))
- (file-exists-p link))
- 'muse-link
- 'muse-bad-link)))))))
-
-(defun muse-colors-use-publishing-directory (link)
- "Make LINK relative to the directory where we will publish the
-current file."
- (let ((style (car (muse-project-applicable-styles
- link (cddr (muse-project)))))
- path)
- (when (and style
- (setq path (muse-style-element :path style)))
- (expand-file-name link path))))
-
-(defun muse-colors-resolve-image-file (link)
- "Determine if we can create images and see if the link is an image
-file."
- (save-match-data
- (and (or (fboundp 'create-image)
- (fboundp 'make-glyph))
- (not (string-match "\\`[uU][rR][lL]:" link))
- (string-match muse-image-regexp link))))
-
-(defun muse-make-file-glyph (filename)
- "Given a file name, return a newly-created image glyph.
-This is a hack for supporting inline images in XEmacs."
- (let ((case-fold-search nil))
- ;; Scan filename to determine image type
- (when (fboundp 'make-glyph)
- (save-match-data
- (cond ((string-match "jpe?g" filename)
- (make-glyph (vector 'jpeg :file filename) 'buffer))
- ((string-match "gif" filename)
- (make-glyph (vector 'gif :file filename) 'buffer))
- ((string-match "png" filename)
- (make-glyph (vector 'png :file filename) 'buffer)))))))
-
-(defun muse-colors-insert-image (link beg end invis-props)
- "Create an image using create-image or make-glyph and insert it
-in place of an image link defined by BEG and END."
- (setq link (expand-file-name link))
- (let ((image-file (cond
- ((eq muse-colors-inline-image-method 'default-directory)
- link)
- ((functionp muse-colors-inline-image-method)
- (funcall muse-colors-inline-image-method link))))
- glyph)
- (when (stringp image-file)
- (if (fboundp 'create-image)
- ;; use create-image and display property
- (let ((display-stuff (condition-case nil
- (create-image image-file)
- (error nil))))
- (when display-stuff
- (add-text-properties beg end (list 'display display-stuff))))
- ;; use make-glyph and invisible property
- (and (setq glyph (muse-make-file-glyph image-file))
- (progn
- (add-text-properties beg end invis-props)
- (add-text-properties beg end (list
- 'end-glyph glyph
- 'help-echo link))))))))
-
-(defun muse-colors-explicit-link ()
- "Color explicit links."
- (when (and (eq ?\[ (char-after (match-beginning 0)))
- (not (get-text-property (match-beginning 0) 'muse-comment))
- (not (get-text-property (match-beginning 0) 'muse-directive)))
- ;; remove flyspell overlays
- (when (fboundp 'flyspell-unhighlight-at)
- (let ((cur (match-beginning 0)))
- (while (> (match-end 0) cur)
- (flyspell-unhighlight-at cur)
- (setq cur (1+ cur)))))
- (let* ((unesc-link (muse-get-link))
- (unesc-desc (muse-get-link-desc))
- (link (muse-link-unescape unesc-link))
- (desc (muse-link-unescape unesc-desc))
- (props (muse-link-properties desc (muse-link-face link t)))
- (invis-props (append props (muse-link-properties desc))))
- ;; see if we should try and inline an image
- (if (and muse-colors-inline-images
- (or (muse-colors-resolve-image-file link)
- (and desc
- (muse-colors-resolve-image-file desc)
- (setq link desc))))
- ;; we found an image, so inline it
- (muse-colors-insert-image
- link
- (match-beginning 0) (match-end 0) invis-props)
- (if desc
- (progn
- ;; we put the normal face properties on the invisible
- ;; portion too, since emacs sometimes will position
- ;; the cursor on an intangible character
- (add-text-properties (match-beginning 0)
- (match-beginning 2) invis-props)
- (add-text-properties (match-beginning 2) (match-end 2) props)
- (add-text-properties (match-end 2) (match-end 0) invis-props)
- ;; in case specials were escaped, cause the unescaped
- ;; text to be displayed
- (unless (string= desc unesc-desc)
- (add-text-properties (match-beginning 2) (match-end 2)
- (list 'display desc))))
- (add-text-properties (match-beginning 0)
- (match-beginning 1) invis-props)
- (add-text-properties (match-beginning 1) (match-end 0) props)
- (add-text-properties (match-end 1) (match-end 0) invis-props)
- (unless (string= link unesc-link)
- (add-text-properties (match-beginning 1) (match-end 1)
- (list 'display link))))
- (goto-char (match-end 0))
- (add-text-properties
- (match-beginning 0) (match-end 0)
- (muse-link-properties (muse-match-string-no-properties 0)
- (muse-link-face link t)))))))
-
-(defun muse-colors-implicit-link ()
- "Color implicit links."
- (unless (or (eq (get-text-property (match-beginning 0) 'invisible) 'muse)
- (get-text-property (match-beginning 0) 'muse-comment)
- (get-text-property (match-beginning 0) 'muse-directive)
- (get-text-property (match-beginning 0) 'muse-no-implicit-link)
- (eq (char-before (match-beginning 0)) ?\")
- (eq (char-after (match-end 0)) ?\"))
- ;; remove flyspell overlays
- (when (fboundp 'flyspell-unhighlight-at)
- (let ((cur (match-beginning 0)))
- (while (> (match-end 0) cur)
- (flyspell-unhighlight-at cur)
- (setq cur (1+ cur)))))
- ;; colorize link
- (let ((link (muse-match-string-no-properties 0))
- (face (muse-link-face (match-string 0))))
- (when face
- (add-text-properties (match-beginning 0) (match-end 0)
- (muse-link-properties
- (muse-match-string-no-properties 0) face))))))
-
-(defun muse-colors-title ()
- "Color #title directives."
- (let ((beg (+ 7 (match-beginning 0))))
- (add-text-properties beg (muse-line-end-position) '(muse-directive t))
- ;; colorize <lisp> tags in #title after other <lisp> tags have had a
- ;; chance to run, so that we can have behavior that is consistent
- ;; with how the document is published
- (setq muse-colors-delayed-commands
- (cons (list 'muse-colors-title-lisp beg (muse-line-end-position))
- muse-colors-delayed-commands))))
-
-(defun muse-colors-title-lisp (beg end)
- "Called after other highlighting is done for a region in order to handle
-<lisp> tags that exist in #title directives."
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (let ((muse-colors-inhibit-tags-in-directives nil)
- (muse-colors-tags '(("lisp" t t nil muse-colors-lisp-tag))))
- (while (re-search-forward muse-tag-regexp nil t)
- (muse-colors-custom-tags))))
- (add-text-properties beg end '(face muse-header-1)))
-
-(defun muse-colors-comment ()
- "Color comments."
- (add-text-properties (match-beginning 0) (muse-line-end-position)
- (list 'face 'font-lock-comment-face
- 'muse-comment t)))
-
-
-(provide 'muse-colors)
-
-;;; muse-colors.el ends here
diff --git a/packages/muse/muse-context.el b/packages/muse/muse-context.el
deleted file mode 100644
index 45968b0..0000000
--- a/packages/muse/muse-context.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-docbook.el b/packages/muse/muse-docbook.el
deleted file mode 100644
index a54089f..0000000
--- a/packages/muse/muse-docbook.el
+++ /dev/null
@@ -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—%s")
- (comment-begin . "<!-- ")
- (comment-end . " -->")
- (rule . "")
- (no-break-space . " ")
- (enddots . "....")
- (dots . "...")
- (section . "<section><title>")
- (section-end . "</title>")
- (subsection . "<section><title>")
- (subsection-end . "</title>")
- (subsubsection . "<section><title>")
- (subsubsection-end . "</title>")
- (section-other . "<section><title>")
- (section-other-end . "</title>")
- (section-close . "</section>")
- (footnote . "<footnote><para>")
- (footnote-end . "</para></footnote>")
- (begin-underline . "")
- (end-underline . "")
- (begin-literal . "<systemitem>")
- (end-literal . "</systemitem>")
- (begin-emph . "<emphasis>")
- (end-emph . "</emphasis>")
- (begin-more-emph . "<emphasis role=\"strong\">")
- (end-more-emph . "</emphasis>")
- (begin-most-emph . "<emphasis role=\"strong\"><emphasis>")
- (end-most-emph . "</emphasis></emphasis>")
- (begin-verse . "<literallayout>\n")
- (verse-space . " ")
- (end-verse . "</literallayout>")
- (begin-example . "<programlisting>")
- (end-example . "</programlisting>")
- (begin-center . "<para role=\"centered\">\n")
- (end-center . "\n</para>")
- (begin-quote . "<blockquote>\n")
- (end-quote . "\n</blockquote>")
- (begin-cite . "<citation role=\"%s\">")
- (begin-cite-author . "<citation role=\"%s\">A:")
- (begin-cite-year . "<citation role=\"%s\">Y:")
- (end-cite . "</citation>")
- (begin-quote-item . "<para>")
- (end-quote-item . "</para>")
- (begin-uli . "<itemizedlist mark=\"bullet\">\n")
- (end-uli . "\n</itemizedlist>")
- (begin-uli-item . "<listitem><para>")
- (end-uli-item . "</para></listitem>")
- (begin-oli . "<orderedlist>\n")
- (end-oli . "\n</orderedlist>")
- (begin-oli-item . "<listitem><para>")
- (end-oli-item . "</para></listitem>")
- (begin-dl . "<variablelist>\n")
- (end-dl . "\n</variablelist>")
- (begin-dl-item . "<varlistentry>\n")
- (end-dl-item . "\n</varlistentry>")
- (begin-ddt . "<term>")
- (end-ddt . "</term>")
- (begin-dde . "<listitem><para>")
- (end-dde . "</para></listitem>")
- (begin-table . "<informaltable>\n")
- (end-table . "</informaltable>")
- (begin-table-group . " <tgroup cols='%s'>\n")
- (end-table-group . " </tgroup>\n")
- (begin-table-row . " <row>\n")
- (end-table-row . " </row>\n")
- (begin-table-entry . " <entry>")
- (end-table-entry . "</entry>\n"))
- "Strings used for marking up text.
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles."
- :type '(alist :key-type symbol :value-type string)
- :group 'muse-docbook)
-
-(defcustom muse-docbook-encoding-default 'utf-8
- "The default Emacs buffer encoding to use in published files.
-This will be used if no special characters are found."
- :type 'symbol
- :group 'muse-docbook)
-
-(defcustom muse-docbook-charset-default "utf-8"
- "The default DocBook XML charset to use if no translation is
-found in `muse-docbook-encoding-map'."
- :type 'string
- :group 'muse-docbook)
-
-(defun muse-docbook-encoding ()
- (muse-xml-transform-content-type
- (or (and (boundp 'buffer-file-coding-system)
- buffer-file-coding-system)
- muse-docbook-encoding-default)
- muse-docbook-charset-default))
-
-(defun muse-docbook-markup-paragraph ()
- (catch 'bail-out
- (let ((end (copy-marker (match-end 0) t)))
- (goto-char (match-beginning 0))
- (when (save-excursion
- (save-match-data
- (and (not (get-text-property (max (point-min) (1- (point)))
- 'muse-no-paragraph))
- (re-search-backward
- "<\\(/?\\)\\(para\\|footnote\\|literallayout\\)[ >]"
- nil t)
- (cond ((string= (match-string 2) "literallayout")
- (and (not (string= (match-string 1) "/"))
- (throw 'bail-out t)))
- ((string= (match-string 2) "para")
- (and
- (not (string= (match-string 1) "/"))
- ;; don't mess up nested lists
- (not (and (muse-looking-back "<listitem>")
- (throw 'bail-out t)))))
- ((string= (match-string 2) "footnote")
- (string= (match-string 1) "/"))
- (t nil)))))
- (when (get-text-property (1- (point)) 'muse-end-list)
- (goto-char (previous-single-property-change (1- (point))
- 'muse-end-list)))
- (muse-insert-markup "</para>"))
- (goto-char end))
- (cond
- ((eobp)
- (unless (bolp)
- (insert "\n")))
- ((get-text-property (point) 'muse-no-paragraph)
- (forward-char 1)
- nil)
- ((eq (char-after) ?\<)
- (when (looking-at (concat "<\\(emphasis\\|systemitem\\|inlinemediaobject"
- "\\|u?link\\|anchor\\|email\\)[ >]"))
- (muse-insert-markup "<para>")))
- (t
- (muse-insert-markup "<para>")))))
-
-(defun muse-docbook-get-author (&optional author)
- "Split the AUTHOR directive into separate fields.
-AUTHOR should be of the form: \"Firstname Other Names Lastname\",
-and anything after `Firstname' is optional."
- (setq author (save-match-data (split-string author)))
- (let ((num-el (length author)))
- (cond ((eq num-el 1)
- (concat "<firstname>" (car author) "</firstname>"))
- ((eq num-el 2)
- (concat "<firstname>" (nth 0 author) "</firstname>"
- "<surname>" (nth 1 author) "</surname>"))
- ((eq num-el 3)
- (concat "<firstname>" (nth 0 author) "</firstname>"
- "<othername>" (nth 1 author) "</othername>"
- "<surname>" (nth 2 author) "</surname>"))
- (t
- (let (first last)
- (setq first (car author))
- (setq author (nreverse (cdr author)))
- (setq last (car author))
- (setq author (nreverse (cdr author)))
- (concat "<firstname>" first "</firstname>"
- "<othername>"
- (mapconcat 'identity author " ")
- "</othername>"
- "<surname>" last "</surname>"))))))
-
-(defun muse-docbook-fixup-images ()
- (goto-char (point-min))
- (while (re-search-forward (concat "<imagedata fileref=\"[^\"]+\""
- " format=\"\\([^\"]+\\)\" />$")
- nil t)
- (replace-match (upcase (match-string 1)) t t nil 1)))
-
-(defun muse-docbook-fixup-citations ()
- ;; remove the role attribute if there is no role
- (goto-char (point-min))
- (while (re-search-forward "<\\(citation role=\"nil\"\\)>" nil t)
- (replace-match "citation" t t nil 1))
- ;; replace colons in multi-head citations with semicolons
- (goto-char (point-min))
- (while (re-search-forward "<citation.*>" nil t)
- (let ((start (point))
- (end (re-search-forward "</citation>")))
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (while (re-search-forward "," nil t)
- (replace-match ";"))))))
-
-(defun muse-docbook-munge-buffer ()
- (muse-docbook-fixup-images)
- (muse-docbook-fixup-citations))
-
-(defun muse-docbook-entities ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "<citation" nil t)
- (concat
- " [\n<!ENTITY bibliography SYSTEM \""
- (if (string-match ".short$" (muse-page-name))
- (substring (muse-page-name) 0 -6)
- (muse-page-name))
- ".bib.xml\">\n]")
- "")))
-
-(defun muse-docbook-bibliography ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "<citation" nil t)
- "&bibliography;\n"
- "")))
-
-(defun muse-docbook-finalize-buffer ()
- (when (boundp 'buffer-file-coding-system)
- (when (memq buffer-file-coding-system '(no-conversion undecided-unix))
- ;; make it agree with the default charset
- (setq buffer-file-coding-system muse-docbook-encoding-default))))
-
-;;; Register the Muse DocBook XML Publisher
-
-(muse-define-style "docbook"
- :suffix 'muse-docbook-extension
- :regexps 'muse-docbook-markup-regexps
- :functions 'muse-docbook-markup-functions
- :strings 'muse-docbook-markup-strings
- :specials 'muse-xml-decide-specials
- :before-end 'muse-docbook-munge-buffer
- :after 'muse-docbook-finalize-buffer
- :header 'muse-docbook-header
- :footer 'muse-docbook-footer
- :browser 'find-file)
-
-(provide 'muse-docbook)
-
-;;; muse-docbook.el ends here
diff --git a/packages/muse/muse-groff.el b/packages/muse/muse-groff.el
deleted file mode 100644
index 7218652..0000000
--- a/packages/muse/muse-groff.el
+++ /dev/null
@@ -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:
diff --git a/packages/muse/muse-html.el b/packages/muse/muse-html.el
deleted file mode 100644
index bcdee56..0000000
--- a/packages/muse/muse-html.el
+++ /dev/null
@@ -1,756 +0,0 @@
-;;; muse-html.el --- publish to HTML and XHTML
-
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2014
-;; Free Software Foundation, Inc.
-
-;; This file is part of Emacs Muse. It is not part of GNU Emacs.
-
-;; Emacs Muse is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation; either version 3, or (at your
-;; option) any later version.
-
-;; Emacs Muse is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with Emacs Muse; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Contributors:
-
-;; Zhiqiang Ye (yezq AT mail DOT cbi DOT pku DOT edu DOT cn) suggested
-;; appending an 'encoding="..."' fragment to the first line of the
-;; sample publishing header so that when editing the resulting XHTML
-;; file, Emacs would use the proper encoding.
-
-;; Sun Jiyang (sunyijiang AT gmail DOT com) came up with the idea for
-;; the <src> tag and provided an implementation for emacs-wiki.
-
-;; Charles Wang (wcy123 AT gmail DOT com) provided an initial
-;; implementation of the <src> tag for Muse.
-
-;; Clinton Ebadi (clinton AT unknownlamer DOT org) provided further
-;; ideas for the implementation of the <src> tag.
-
-;;; Code:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Muse HTML Publishing
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(require 'muse-publish)
-(require 'muse-regexps)
-(require 'muse-xml-common)
-
-(defgroup muse-html nil
- "Options controlling the behavior of Muse HTML publishing."
- :group 'muse-publish)
-
-(defcustom muse-html-extension ".html"
- "Default file extension for publishing HTML files."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-xhtml-extension ".html"
- "Default file extension for publishing XHTML files."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-html-style-sheet
- "<style type=\"text/css\">
-body {
- background: white; color: black;
- margin-left: 3%; margin-right: 7%;
-}
-
-p { margin-top: 1% }
-p.verse { margin-left: 3% }
-
-.example { margin-left: 3% }
-
-h2 {
- margin-top: 25px;
- margin-bottom: 0px;
-}
-h3 { margin-bottom: 0px; }
- </style>"
- "Store your stylesheet definitions here.
-This is used in `muse-html-header'.
-You can put raw CSS in here or a <link> tag to an external stylesheet.
-This text may contain <lisp> markup tags.
-
-An example of using <link> is as follows.
-
-<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\"
href=\"/default.css\">"
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-xhtml-style-sheet
- "<style type=\"text/css\">
-body {
- background: white; color: black;
- margin-left: 3%; margin-right: 7%;
-}
-
-p { margin-top: 1% }
-p.verse { margin-left: 3% }
-
-.example { margin-left: 3% }
-
-h2 {
- margin-top: 25px;
- margin-bottom: 0px;
-}
-h3 { margin-bottom: 0px; }
- </style>"
- "Store your stylesheet definitions here.
-This is used in `muse-xhtml-header'.
-You can put raw CSS in here or a <link> tag to an external stylesheet.
-This text may contain <lisp> markup tags.
-
-An example of using <link> is as follows.
-
-<link rel=\"stylesheet\" type=\"text/css\" charset=\"utf-8\" media=\"all\"
href=\"/default.css\" />"
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-html-header
- "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">
-<html>
- <head>
- <title><lisp>
- (concat (muse-publishing-directive \"title\")
- (let ((author (muse-publishing-directive \"author\")))
- (if (not (string= author (user-full-name)))
- (concat \" (by \" author \")\"))))</lisp></title>
- <meta name=\"generator\" content=\"muse.el\">
- <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
- content=\"<lisp>muse-html-meta-content-type</lisp>\">
- <lisp>
- (let ((maintainer (muse-style-element :maintainer)))
- (when maintainer
- (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\">\")))
- </lisp><lisp>
- (muse-style-element :style-sheet muse-publishing-current-style)
- </lisp>
- </head>
- <body>
- <h1><lisp>
- (concat (muse-publishing-directive \"title\")
- (let ((author (muse-publishing-directive \"author\")))
- (if (not (string= author (user-full-name)))
- (concat \" (by \" author \")\"))))</lisp></h1>
- <!-- Page published by Emacs Muse begins here -->\n"
- "Header used for publishing HTML files. This may be text or a filename."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-html-footer "
-<!-- Page published by Emacs Muse ends here -->
- </body>
-</html>\n"
- "Footer used for publishing HTML files. This may be text or a filename."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-xhtml-header
- "<?xml version=\"1.0\" encoding=\"<lisp>
- (muse-html-encoding)</lisp>\"?>
-<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
- \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\";>
-<html xmlns=\"http://www.w3.org/1999/xhtml\";>
- <head>
- <title><lisp>
- (concat (muse-publishing-directive \"title\")
- (let ((author (muse-publishing-directive \"author\")))
- (if (not (string= author (user-full-name)))
- (concat \" (by \" author \")\"))))</lisp></title>
- <meta name=\"generator\" content=\"muse.el\" />
- <meta http-equiv=\"<lisp>muse-html-meta-http-equiv</lisp>\"
- content=\"<lisp>muse-html-meta-content-type</lisp>\" />
- <lisp>
- (let ((maintainer (muse-style-element :maintainer)))
- (when maintainer
- (concat \"<link rev=\\\"made\\\" href=\\\"\" maintainer \"\\\"
/>\")))
- </lisp><lisp>
- (muse-style-element :style-sheet muse-publishing-current-style)
- </lisp>
- </head>
- <body>
- <h1><lisp>
- (concat (muse-publishing-directive \"title\")
- (let ((author (muse-publishing-directive \"author\")))
- (if (not (string= author (user-full-name)))
- (concat \" (by \" author \")\"))))</lisp></h1>
- <!-- Page published by Emacs Muse begins here -->\n"
- "Header used for publishing XHTML files. This may be text or a filename."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-xhtml-footer "
-<!-- Page published by Emacs Muse ends here -->
- </body>
-</html>\n"
- "Footer used for publishing XHTML files. This may be text or a filename."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-html-anchor-on-word nil
- "When true, anchors surround the closest word. This allows you
-to select them in a browser (i.e. for pasting), but has the
-side-effect of marking up headers in multiple colors if your
-header style is different from your link style."
- :type 'boolean
- :group 'muse-html)
-
-(defcustom muse-html-table-attributes
- " class=\"muse-table\" border=\"2\" cellpadding=\"5\""
- "The attribute to be used with HTML <table> tags.
-Note that Muse supports insertion of raw HTML tags, as long
-as you wrap the region in <literal></literal>."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-html-markup-regexps
- `(;; Beginning of doc, end of doc, or plain paragraph separator
- (10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*"
- "\\([" muse-regexp-blank "]*\n\\)\\)"
- "\\|\\`\\s-*\\|\\s-*\\'\\)")
- ;; this is somewhat repetitive because we only require the
- ;; line just before the paragraph beginning to be not
- ;; read-only
- 3 muse-html-markup-paragraph))
- "List of markup rules for publishing a Muse page to HTML.
-For more on the structure of this list, see `muse-publish-markup-regexps'."
- :type '(repeat (choice
- (list :tag "Markup rule"
- integer
- (choice regexp symbol)
- integer
- (choice string function symbol))
- function))
- :group 'muse-html)
-
-(defcustom muse-html-markup-functions
- '((anchor . muse-html-markup-anchor)
- (table . muse-html-markup-table)
- (footnote . muse-html-markup-footnote))
- "An alist of style types to custom functions for that kind of text.
-For more on the structure of this list, see
-`muse-publish-markup-functions'."
- :type '(alist :key-type symbol :value-type function)
- :group 'muse-html)
-
-(defcustom muse-html-markup-strings
- '((image-with-desc . "<table class=\"image\" width=\"100%%\">
- <tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\"></td></tr>
- <tr><td align=\"center\" class=\"image-caption\">%3%</td></tr>
-</table>")
- (image . "<img src=\"%s.%s\" alt=\"\">")
- (image-link . "<a class=\"image-link\" href=\"%s\">
-<img src=\"%s.%s\"></a>")
- (anchor-ref . "<a href=\"#%s\">%s</a>")
- (url . "<a href=\"%s\">%s</a>")
- (link . "<a href=\"%s\">%s</a>")
- (link-and-anchor . "<a href=\"%s#%s\">%s</a>")
- (email-addr . "<a href=\"mailto:%s\";>%s</a>")
- (anchor . "<a name=\"%1%\" id=\"%1%\">")
- (emdash . "%s—%s")
- (comment-begin . "<!-- ")
- (comment-end . " -->")
- (rule . "<hr>")
- (fn-sep . "<hr>\n")
- (no-break-space . " ")
- (line-break . "<br>")
- (enddots . "....")
- (dots . "...")
- (section . "<h2>")
- (section-end . "</h2>")
- (subsection . "<h3>")
- (subsection-end . "</h3>")
- (subsubsection . "<h4>")
- (subsubsection-end . "</h4>")
- (section-other . "<h5>")
- (section-other-end . "</h5>")
- (begin-underline . "<u>")
- (end-underline . "</u>")
- (begin-literal . "<code>")
- (end-literal . "</code>")
- (begin-cite . "<span class=\"citation\">")
- (begin-cite-author . "<span class=\"citation-author\">")
- (begin-cite-year . "<span class=\"citation-year\">")
- (end-cite . "</span>")
- (begin-emph . "<em>")
- (end-emph . "</em>")
- (begin-more-emph . "<strong>")
- (end-more-emph . "</strong>")
- (begin-most-emph . "<strong><em>")
- (end-most-emph . "</em></strong>")
- (begin-verse . "<p class=\"verse\">\n")
- (verse-space . " ")
- (end-verse-line . "<br>")
- (end-last-stanza-line . "<br>")
- (empty-verse-line . "<br>")
- (end-verse . "</p>")
- (begin-example . "<pre class=\"example\">")
- (end-example . "</pre>")
- (begin-center . "<center>\n<p>")
- (end-center . "</p>\n</center>")
- (begin-quote . "<blockquote>\n")
- (end-quote . "\n</blockquote>")
- (begin-quote-item . "<p class=\"quoted\">")
- (end-quote-item . "</p>")
- (begin-uli . "<ul>\n")
- (end-uli . "\n</ul>")
- (begin-uli-item . "<li>")
- (end-uli-item . "</li>")
- (begin-oli . "<ol>\n")
- (end-oli . "\n</ol>")
- (begin-oli-item . "<li>")
- (end-oli-item . "</li>")
- (begin-dl . "<dl>\n")
- (end-dl . "\n</dl>")
- (begin-ddt . "<dt><strong>")
- (end-ddt . "</strong></dt>")
- (begin-dde . "<dd>")
- (end-dde . "</dd>")
- (begin-table . "<table%s>\n")
- (end-table . "</table>")
- (begin-table-row . " <tr>\n")
- (end-table-row . " </tr>\n")
- (begin-table-entry . " <%s>")
- (end-table-entry . "</%s>\n"))
- "Strings used for marking up text as HTML.
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles."
- :type '(alist :key-type symbol :value-type string)
- :group 'muse-html)
-
-(defcustom muse-xhtml-markup-strings
- '((image-with-desc . "<table class=\"image\" width=\"100%%\">
- <tr><td align=\"center\"><img src=\"%1%.%2%\" alt=\"%3%\" /></td></tr>
- <tr><td align=\"center\" class=\"image-caption\">%3%</td></tr>
-</table>")
- (image . "<img src=\"%s.%s\" alt=\"\" />")
- (image-link . "<a class=\"image-link\" href=\"%s\">
-<img src=\"%s.%s\" alt=\"\" /></a>")
- (rule . "<hr />")
- (fn-sep . "<hr />\n")
- (line-break . "<br />")
- (begin-underline . "<span style=\"text-decoration: underline;\">")
- (end-underline . "</span>")
- (begin-center . "<p style=\"text-align: center;\">\n")
- (end-center . "\n</p>")
- (end-verse-line . "<br />")
- (end-last-stanza-line . "<br />")
- (empty-verse-line . "<br />"))
- "Strings used for marking up text as XHTML.
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-If a markup rule is not found here, `muse-html-markup-strings' is
-searched."
- :type '(alist :key-type symbol :value-type string)
- :group 'muse-html)
-
-(defcustom muse-xhtml1.1-markup-strings
- '((anchor . "<a id=\"%s\">"))
- "Strings used for marking up text as XHTML 1.1.
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-If a markup rule is not found here, `muse-xhtml-markup-strings'
-and `muse-html-markup-strings' are searched."
- :type '(alist :key-type symbol :value-type string)
- :group 'muse-html)
-
-(defcustom muse-html-markup-tags
- '(("class" t t t muse-html-class-tag)
- ("div" t t t muse-html-div-tag)
- ("src" t t nil muse-html-src-tag))
- "A list of tag specifications, for specially marking up HTML."
- :type '(repeat (list (string :tag "Markup tag")
- (boolean :tag "Expect closing tag" :value t)
- (boolean :tag "Parse attributes" :value nil)
- (boolean :tag "Nestable" :value nil)
- function))
- :group 'muse-html)
-
-(defcustom muse-html-meta-http-equiv "Content-Type"
- "The http-equiv attribute used for the HTML <meta> tag."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-html-meta-content-type "text/html"
- "The content type used for the HTML <meta> tag.
-If you are striving for XHTML 1.1 compliance, you may want to
-change this to \"application/xhtml+xml\"."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-html-meta-content-encoding (if (featurep 'mule)
- 'detect
- "iso-8859-1")
- "The charset to append to the HTML <meta> tag.
-If set to the symbol `detect', use `muse-html-encoding-map' to try
-and determine the HTML charset from emacs's coding. If set to a
-string, this string will be used to force a particular charset"
- :type '(choice string symbol)
- :group 'muse-html)
-
-(defcustom muse-html-encoding-default 'iso-8859-1
- "The default Emacs buffer encoding to use in published files.
-This will be used if no special characters are found."
- :type 'symbol
- :group 'muse-html)
-
-(defcustom muse-html-charset-default "iso-8859-1"
- "The default HTML meta charset to use if no translation is found in
-`muse-html-encoding-map'."
- :type 'string
- :group 'muse-html)
-
-(defcustom muse-html-src-allowed-modes t
- "Modes that we allow the <src> tag to colorize.
-If t, permit the <src> tag to colorize any mode.
-
-If a list of mode names, such as (\"html\" \"latex\"), and the
-lang argument to <src> is not in the list, then use fundamental
-mode instead."
- :type '(choice (const :tag "Any" t)
- (repeat (string :tag "Mode")))
- :group 'muse-html)
-
-(defun muse-html-insert-anchor (anchor)
- "Insert an anchor, either around the word at point, or within a tag."
- (skip-chars-forward (concat muse-regexp-blank "\n"))
- (if (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>"))
- (let ((tag (match-string 1)))
- (goto-char (match-end 0))
- (muse-insert-markup (muse-markup-text 'anchor anchor))
- (when muse-html-anchor-on-word
- (or (and (search-forward (format "</%s>" tag)
- (muse-line-end-position) t)
- (goto-char (match-beginning 0)))
- (forward-word 1)))
- (muse-insert-markup "</a>"))
- (muse-insert-markup (muse-markup-text 'anchor anchor))
- (when muse-html-anchor-on-word
- (forward-word 1))
- (muse-insert-markup "</a>\n")))
-
-(defun muse-html-markup-anchor ()
- (unless (get-text-property (match-end 1) 'muse-link)
- (save-match-data
- (muse-html-insert-anchor (match-string 2)))
- (match-string 1)))
-
-(defun muse-html-markup-paragraph ()
- (let ((end (copy-marker (match-end 0) t)))
- (goto-char (match-beginning 0))
- (when (save-excursion
- (save-match-data
- (and (not (get-text-property (max (point-min) (1- (point)))
- 'muse-no-paragraph))
- (re-search-backward "<\\(/?\\)p[ >]" nil t)
- (not (string-equal (match-string 1) "/")))))
- (when (get-text-property (1- (point)) 'muse-end-list)
- (goto-char (previous-single-property-change (1- (point))
- 'muse-end-list)))
- (muse-insert-markup "</p>"))
- (goto-char end))
- (cond
- ((eobp)
- (unless (bolp)
- (insert "\n")))
- ((get-text-property (point) 'muse-no-paragraph)
- (forward-char 1)
- nil)
- ((eq (char-after) ?\<)
- (cond
- ((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]")
- (muse-insert-markup "<p>"))
- ((looking-at "<a ")
- (if (looking-at "<a[^>\n]+><img")
- (muse-insert-markup "<p class=\"image-link\">")
- (muse-insert-markup "<p>")))
- ((looking-at "<img[ >]")
- (muse-insert-markup "<p class=\"image\">"))
- (t
- (forward-char 1)
- nil)))
- ((muse-looking-back "\\(</h[1-4]>\\|<hr>\\)\n\n")
- (muse-insert-markup "<p class=\"first\">"))
- (t
- (muse-insert-markup "<p>"))))
-
-(defun muse-html-markup-footnote ()
- (cond
- ((get-text-property (match-beginning 0) 'muse-link)
- nil)
- ((= (muse-line-beginning-position) (match-beginning 0))
- (prog1
- (let ((text (match-string 1)))
- (muse-insert-markup
- (concat "<p class=\"footnote\">"
- "<a class=\"footnum\" name=\"fn." text
- "\" href=\"#fnr." text "\">"
- text ".</a>")))
- (save-excursion
- (save-match-data
- (let* ((beg (goto-char (match-end 0)))
- (end (and (search-forward "\n\n" nil t)
- (prog1
- (copy-marker (match-beginning 0))
- (goto-char beg)))))
- (while (re-search-forward (concat "^["
- muse-regexp-blank
- "]+\\([^\n]\\)")
- end t)
- (replace-match "\\1" t)))))
- (replace-match "")))
- (t (let ((text (match-string 1)))
- (muse-insert-markup
- (concat "<sup><a class=\"footref\" name=\"fnr." text
- "\" href=\"#fn." text "\">"
- text "</a></sup>")))
- (replace-match ""))))
-
-(defun muse-html-markup-table ()
- (muse-xml-markup-table muse-html-table-attributes))
-
-;; Handling of tags for HTML
-
-(defun muse-html-strip-links (string)
- "Remove all HTML links from STRING."
- (muse-replace-regexp-in-string "\\(<a .*?>\\|</a>\\)" "" string nil t))
-
-(defun muse-html-insert-contents (depth)
- "Scan the current document and generate a table of contents at point.
-DEPTH indicates how many levels of headings to include. The default is 2."
- (let ((max-depth (or depth 2))
- (index 1)
- base contents l end)
- (save-excursion
- (goto-char (point-min))
- (search-forward "Page published by Emacs Muse begins here" nil t)
- (catch 'done
- (while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
- (unless (and (get-text-property (point) 'read-only)
- (not (get-text-property (match-beginning 0)
- 'muse-contents)))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(muse-contents nil))
- (setq l (1- (string-to-number (match-string 1))))
- (if (null base)
- (setq base l)
- (if (< l base)
- (throw 'done t)))
- (when (<= l max-depth)
- ;; escape specials now before copying the text, so that we
- ;; can deal sanely with both emphasis in titles and
- ;; special characters
- (goto-char (match-end 2))
- (setq end (point-marker))
- (muse-publish-escape-specials (match-beginning 2) end
- nil 'document)
- (muse-publish-mark-read-only (match-beginning 2) end)
- (setq contents (cons (cons l (buffer-substring-no-properties
- (match-beginning 2) end))
- contents))
- (set-marker end nil)
- (goto-char (match-beginning 2))
- (muse-html-insert-anchor (concat "sec" (int-to-string index)))
- (setq index (1+ index)))))))
- (setq index 1 contents (nreverse contents))
- (let ((depth 1) (sub-open 0) (p (point)))
- (muse-insert-markup "<div class=\"contents\">\n<dl>\n")
- (while contents
- (muse-insert-markup "<dt>\n"
- "<a href=\"#sec" (int-to-string index) "\">"
- (muse-html-strip-links (cdar contents))
- "</a>\n"
- "</dt>\n")
- (setq index (1+ index)
- depth (caar contents)
- contents (cdr contents))
- (when contents
- (cond
- ((< (caar contents) depth)
- (let ((idx (caar contents)))
- (while (< idx depth)
- (muse-insert-markup "</dl>\n</dd>\n")
- (setq sub-open (1- sub-open)
- idx (1+ idx)))))
- ((> (caar contents) depth) ; can't jump more than one ahead
- (muse-insert-markup "<dd>\n<dl>\n")
- (setq sub-open (1+ sub-open))))))
- (while (> sub-open 0)
- (muse-insert-markup "</dl>\n</dd>\n")
- (setq sub-open (1- sub-open)))
- (muse-insert-markup "</dl>\n</div>\n")
- (muse-publish-mark-read-only p (point)))))
-
-(defun muse-html-denote-headings ()
- "Place a text property on any headings in the current buffer.
-This allows the headings to be picked up later on if publishing a
-table of contents."
- (save-excursion
- (goto-char (point-min))
- (search-forward "Page published by Emacs Muse begins here" nil t)
- (while (re-search-forward "<h\\([0-9]+\\)>\\(.+?\\)</h\\1>$" nil t)
- (unless (get-text-property (point) 'read-only)
- (add-text-properties (match-beginning 0) (match-end 0)
- '(muse-contents t))))))
-
-(defun muse-html-class-tag (beg end attrs)
- (let ((name (cdr (assoc "name" attrs))))
- (when name
- (goto-char beg)
- (muse-insert-markup "<span class=\"" name "\">")
- (save-excursion
- (goto-char end)
- (muse-insert-markup "</span>")))))
-
-(defun muse-html-div-tag (beg end attrs)
- "Publish a <div> tag for HTML."
- (let ((id (cdr (assoc "id" attrs)))
- (style (cdr (assoc "style" attrs))))
- (when (or id style)
- (goto-char beg)
- (if (null id)
- (muse-insert-markup "<div style=\"" style "\">")
- (muse-insert-markup "<div id=\"" id "\">"))
- (save-excursion
- (goto-char end)
- (muse-insert-markup "</div>")))))
-
-(defun muse-html-src-tag (beg end attrs)
- "Publish the region using htmlize.
-The language to use may be specified by the \"lang\" attribute.
-
-Muse will look for a function named LANG-mode, where LANG is the
-value of the \"lang\" attribute.
-
-This tag requires htmlize 1.34 or later in order to work."
- (if (condition-case nil
- (progn
- (require 'htmlize)
- (if (fboundp 'htmlize-region-for-paste)
- nil
- (muse-display-warning
- (concat "The `htmlize-region-for-paste' function was not"
- " found.\nThis is available in htmlize.el 1.34"
- " or later."))
- t))
- (error nil t))
- ;; if htmlize.el was not found, treat this like an example tag
- (muse-publish-example-tag beg end)
- (muse-publish-ensure-block beg end)
- (let* ((lang (cdr (assoc "lang" attrs)))
- (mode (or (and (not (eq muse-html-src-allowed-modes t))
- (not (member lang muse-html-src-allowed-modes))
- 'fundamental-mode)
- (intern-soft (concat lang "-mode"))))
- (text (muse-delete-and-extract-region beg end))
- (htmltext
- (with-temp-buffer
- (insert text)
- (if (functionp mode)
- (funcall mode)
- (fundamental-mode))
- (if (fboundp 'font-lock-ensure)
- (font-lock-ensure)
- (font-lock-fontify-buffer))
- ;; silence the byte-compiler
- (when (fboundp 'htmlize-region-for-paste)
- ;; transform the region to HTML
- (htmlize-region-for-paste (point-min) (point-max))))))
- (save-restriction
- (narrow-to-region (point) (point))
- (insert htmltext)
- (goto-char (point-min))
- (re-search-forward "<pre\\([^>]*\\)>\n?" nil t)
- (replace-match "<pre class=\"src\">")
- (goto-char (point-max))
- (muse-publish-mark-read-only (point-min) (point-max))))))
-
-;; Register the Muse HTML Publisher
-
-(defun muse-html-browse-file (file)
- (browse-url (concat "file:" file)))
-
-(defun muse-html-encoding ()
- (if (stringp muse-html-meta-content-encoding)
- muse-html-meta-content-encoding
- (muse-xml-transform-content-type
- (or (and (boundp 'buffer-file-coding-system)
- buffer-file-coding-system)
- muse-html-encoding-default)
- muse-html-charset-default)))
-
-(defun muse-html-prepare-buffer ()
- (make-local-variable 'muse-html-meta-http-equiv)
- (set (make-local-variable 'muse-html-meta-content-type)
- (if (save-match-data
- (string-match "charset=" muse-html-meta-content-type))
- muse-html-meta-content-type
- (concat muse-html-meta-content-type "; charset="
- (muse-html-encoding)))))
-
-(defun muse-html-munge-buffer ()
- (if muse-publish-generate-contents
- (progn
- (goto-char (car muse-publish-generate-contents))
- (muse-html-insert-contents (cdr muse-publish-generate-contents))
- (setq muse-publish-generate-contents nil))
- (muse-html-denote-headings)))
-
-(defun muse-html-finalize-buffer ()
- (when (and (boundp 'buffer-file-coding-system)
- (memq buffer-file-coding-system '(no-conversion undecided-unix)))
- ;; make it agree with the default charset
- (setq buffer-file-coding-system muse-html-encoding-default)))
-
-;;; Register the Muse HTML and XHTML Publishers
-
-(muse-define-style "html"
- :suffix 'muse-html-extension
- :regexps 'muse-html-markup-regexps
- :functions 'muse-html-markup-functions
- :strings 'muse-html-markup-strings
- :tags 'muse-html-markup-tags
- :specials 'muse-xml-decide-specials
- :before 'muse-html-prepare-buffer
- :before-end 'muse-html-munge-buffer
- :after 'muse-html-finalize-buffer
- :header 'muse-html-header
- :footer 'muse-html-footer
- :style-sheet 'muse-html-style-sheet
- :browser 'muse-html-browse-file)
-
-(muse-derive-style "xhtml" "html"
- :suffix 'muse-xhtml-extension
- :strings 'muse-xhtml-markup-strings
- :header 'muse-xhtml-header
- :footer 'muse-xhtml-footer
- :style-sheet 'muse-xhtml-style-sheet)
-
-;; xhtml1.0 is an alias for xhtml
-(muse-derive-style "xhtml1.0" "xhtml")
-
-;; xhtml1.1 has some quirks that need attention from us
-(muse-derive-style "xhtml1.1" "xhtml"
- :strings 'muse-xhtml1.1-markup-strings)
-
-(provide 'muse-html)
-
-;;; muse-html.el ends here
diff --git a/packages/muse/muse-http.el b/packages/muse/muse-http.el
deleted file mode 100644
index 0c83c92..0000000
--- a/packages/muse/muse-http.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-ikiwiki.el b/packages/muse/muse-ikiwiki.el
deleted file mode 100644
index a664880..0000000
--- a/packages/muse/muse-ikiwiki.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-import-docbook.el
b/packages/muse/muse-import-docbook.el
deleted file mode 100644
index ed1b22b..0000000
--- a/packages/muse/muse-import-docbook.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-import-latex.el
b/packages/muse/muse-import-latex.el
deleted file mode 100644
index 5297131..0000000
--- a/packages/muse/muse-import-latex.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-import-xml.el b/packages/muse/muse-import-xml.el
deleted file mode 100644
index 2579ce8..0000000
--- a/packages/muse/muse-import-xml.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-ipc.el b/packages/muse/muse-ipc.el
deleted file mode 100644
index da8eb37..0000000
--- a/packages/muse/muse-ipc.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-journal.el b/packages/muse/muse-journal.el
deleted file mode 100644
index e523b4c..0000000
--- a/packages/muse/muse-journal.el
+++ /dev/null
@@ -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\"> </a>
- <div class=\"entry-body\">
- <div class=\"entry-head\">
- <div class=\"entry-date\">
- <span class=\"date\">%date%</span>
- </div>
- <div class=\"entry-title\">
- <h2>%title%</h2>
- </div>
- </div>
- <div class=\"entry-text\">
- <div class=\"entry-qotd\">
- <p>%qotd%</p>
- </div>
-%text%
- </div>
- </div>
-</div>\n\n"
- "Template used to publish individual journal entries as HTML.
-This may be text or a filename."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-latex-section
- "\\section*{%title% \\hfill {\\normalsize %date%}}
-\\addcontentsline{toc}{chapter}{%title%}"
- "Template used to publish a LaTeX section."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-latex-subsection
- "\\subsection*{%title%}
-\\addcontentsline{toc}{section}{%title%}"
- "Template used to publish a LaTeX subsection."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-markup-tags
- '(("qotd" t nil nil muse-journal-qotd-tag))
- "A list of tag specifications, for specially marking up Journal entries.
-See `muse-publish-markup-tags' for more info.
-
-This is used by journal-latex and its related styles, as well as
-the journal-rss-entry style, which both journal-rdf and
-journal-rss use."
- :type '(repeat (list (string :tag "Markup tag")
- (boolean :tag "Expect closing tag" :value t)
- (boolean :tag "Parse attributes" :value nil)
- (boolean :tag "Nestable" :value nil)
- function))
- :group 'muse-journal)
-
-;; FIXME: This doesn't appear to be used.
-(defun muse-journal-generate-pages ()
- (let ((output-dir (muse-style-element :path)))
- (goto-char (point-min))
- (while (re-search-forward muse-journal-heading-regexp nil t)
- (let* ((date (match-string 1))
- (category (match-string 1))
- (category-file (concat output-dir category "/index.html"))
- (heading (match-string 1)))
- t))))
-
-(defcustom muse-journal-rdf-extension ".rdf"
- "Default file extension for publishing RDF (RSS 1.0) files."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rdf-base-url ""
- "The base URL of the website referenced by the RDF file."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rdf-header
- "<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\";
- xmlns=\"http://purl.org/rss/1.0/\";
- xmlns:dc=\"http://purl.org/dc/elements/1.1/\";>
- <channel rdf:about=\"<lisp>(concat (muse-style-element :base-url)
- (muse-publish-link-name))</lisp>\">
- <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
- <link><lisp>(concat (muse-style-element :base-url)
- (concat (muse-page-name)
- muse-html-extension))</lisp></link>
- <description><lisp>(muse-publishing-directive
\"desc\")</lisp></description>
- <items>
- <rdf:Seq>
- <rdf:li resource=\"<lisp>
- (concat (muse-style-element :base-url)
- (concat (muse-page-name)
- muse-html-extension))</lisp>\"/>
- </rdf:Seq>
- </items>
- </channel>\n"
- "Header used for publishing RDF (RSS 1.0) files.
-This may be text or a filename."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rdf-footer
- "</rdf:RDF>\n"
- "Footer used for publishing RDF (RSS 1.0) files.
-This may be text or a filename."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rdf-date-format
- "%Y-%m-%dT%H:%M:%S"
- "Date format to use for RDF entries."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rdf-entry-template
- "\n <item rdf:about=\"%link%#%anchor%\">
- <title>%title%</title>
- <description>
- %desc%
- </description>
- <link>%link%#%anchor%</link>
- <dc:date>%date%</dc:date>
- <dc:creator>%maintainer%</dc:creator>
- </item>\n"
- "Template used to publish individual journal entries as RDF.
-This may be text or a filename."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rdf-summarize-entries nil
- "If non-nil, include only summaries in the RDF file, not the full data.
-
-The default is nil, because this annoys some subscribers."
- :type 'boolean
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-extension ".xml"
- "Default file extension for publishing RSS 2.0 files."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-base-url ""
- "The base URL of the website referenced by the RSS file."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-header
- "<\?xml version=\"1.0\" encoding=\"<lisp>
- (muse-html-encoding)</lisp>\"?>
-<rss version=\"2.0\">
- <channel>
- <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
- <link><lisp>(concat (muse-style-element :base-url)
- (concat (muse-page-name)
- muse-html-extension))</lisp></link>
- <description><lisp>(muse-publishing-directive
\"desc\")</lisp></description>
- <language>en-us</language>
- <generator>Emacs Muse</generator>\n\n"
- "Header used for publishing RSS 2.0 files. This may be text or a filename."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-footer
- "\n\n </channel>
-</rss>\n"
- "Footer used for publishing RSS 2.0 files. This may be text or a filename."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-date-format
- "%a, %d %b %Y %H:%M:%S %Z"
- "Date format to use for RSS 2.0 entries."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-entry-template
- "\n <item>
- <title>%title%</title>
- <link>%link%#%anchor%</link>
- <description>%desc%</description>
- <author><lisp>(muse-publishing-directive \"author\")</lisp></author>
- <pubDate>%date%</pubDate>
- <guid>%link%#%anchor%</guid>
- %enclosure%
- </item>\n"
- "Template used to publish individual journal entries as RSS 2.0.
-This may be text or a filename."
- :type 'string
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-enclosure-types-alist
- '(("mp3" . "audio/mpeg"))
- "File types that are accepted as RSS enclosures.
-This is an alist that maps file extension to content type.
-Useful for podcasting."
- :type '(alist :key-type string :value-type string)
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-summarize-entries nil
- "If non-nil, include only summaries in the RSS file, not the full data.
-
-The default is nil, because this annoys some subscribers."
- :type 'boolean
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-markup-regexps
- '((10000 muse-explicit-link-regexp 0 "\\2"))
- "List of markup rules for publishing a Muse journal page to RSS 2.0.
-For more information on the structure of this list, see
-`muse-publish-markup-regexps'."
- :type '(repeat (choice
- (list :tag "Markup rule"
- integer
- (choice regexp symbol)
- integer
- (choice string function symbol))
- function))
- :group 'muse-journal)
-
-(defcustom muse-journal-rss-markup-functions
- '((email . ignore)
- (link . ignore)
- (url . ignore))
- "An alist of style types to custom functions for that kind of text.
-For more on the structure of this list, see
-`muse-publish-markup-functions'."
- :type '(alist :key-type symbol :value-type function)
- :group 'muse-journal)
-
-(defun muse-journal-anchorize-title (title)
- "This strips tags from TITLE, truncates TITLE at begin parenthesis,
-and escapes any remaining non-alphanumeric characters."
- (save-match-data
- (if (string-match "(" title)
- (setq title (substring title 0 (match-beginning 0))))
- (if (string-match "<[^>]+>" title)
- (setq title (replace-match "" nil nil title)))
- (let (pos code len ch)
- (while (setq pos (string-match (concat "[^" muse-regexp-alnum "_]")
- title pos))
- (setq ch (aref title pos)
- code (format "%%%02X" (cond ((fboundp 'char-to-ucs)
- (char-to-ucs ch))
- ((fboundp 'char-to-int)
- (char-to-int ch))
- (t ch)))
- len (length code)
- title (concat (substring title 0 pos)
- code
- (when (< pos (length title))
- (substring title (1+ pos) nil)))
- pos (+ len pos)))
- title)))
-
-(defun muse-journal-sort-entries (&optional direction)
- (interactive "P")
- (sort-subr
- direction
- (function
- (lambda ()
- (if (re-search-forward "^\\* [0-9]+" nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max)))))
- (function
- (lambda ()
- (if (re-search-forward "^\\* [0-9]+" nil t)
- (goto-char (1- (match-beginning 0)))
- (goto-char (point-max)))))
- (function
- (lambda ()
- (forward-char 2)))
- (function
- (lambda ()
- (end-of-line)))))
-
-(defun muse-journal-qotd-tag (beg end)
- (muse-publish-ensure-block beg end)
- (muse-insert-markup (muse-markup-text 'begin-quote))
- (muse-insert-markup (muse-markup-text 'begin-quote-item))
- (goto-char end)
- (muse-insert-markup (muse-markup-text 'end-quote-item))
- (muse-insert-markup (muse-markup-text 'end-quote)))
-
-(defun muse-journal-html-munge-buffer ()
- (goto-char (point-min))
- (let ((heading-regexp muse-journal-html-heading-regexp)
- (inhibit-read-only t))
- (while (re-search-forward heading-regexp nil t)
- (let* ((date (match-string 1))
- (orig-date date)
- (title (match-string 2))
- (clean-title title)
- datestamp qotd text)
- (delete-region (match-beginning 0) (match-end 0))
- (if clean-title
- (save-match-data
- (while (string-match "\\(^<[^>]+>\\|<[^>]+>$\\)" clean-title)
- (setq clean-title (replace-match "" nil nil clean-title)))))
- (save-match-data
- (when (and date
- (string-match
- (concat "\\`\\([1-9][0-9][0-9][0-9]\\)[./]?"
- "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
- (setq datestamp
- (encode-time
- 0 0 0
- (string-to-number (match-string 3 date))
- (string-to-number (match-string 2 date))
- (string-to-number (match-string 1 date))
- nil)
- date (concat (format-time-string
- muse-journal-date-format datestamp)
- (substring date (match-end 0))))))
- (save-restriction
- (narrow-to-region
- (point) (if (re-search-forward
- (concat "\\(^<hr>$\\|"
- heading-regexp "\\)") nil t)
- (match-beginning 0)
- (point-max)))
- (goto-char (point-max))
- (while (and (not (bobp))
- (eq ?\ (char-syntax (char-before))))
- (delete-char -1))
- (goto-char (point-min))
- (while (and (not (eobp))
- (eq ?\ (char-syntax (char-after))))
- (delete-char 1))
- (save-excursion
- (when (search-forward "<qotd>" nil t)
- (let ((tag-beg (match-beginning 0))
- (beg (match-end 0))
- end)
- (re-search-forward "</qotd>\n*")
- (setq end (point-marker))
- (save-restriction
- (narrow-to-region beg (match-beginning 0))
- (muse-publish-escape-specials (point-min) (point-max)
- nil 'document)
- (setq qotd (buffer-substring-no-properties
- (point-min) (point-max))))
- (delete-region tag-beg end)
- (set-marker end nil))))
- (setq text (buffer-string))
- (delete-region (point-min) (point-max))
- (let ((entry muse-journal-html-entry-template))
- (muse-insert-file-or-string entry)
- (muse-publish-mark-read-only (point-min) (point-max))
- (goto-char (point-min))
- (while (search-forward "%date%" nil t)
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(read-only nil rear-nonsticky nil))
- (replace-match (or date "") nil t))
- (goto-char (point-min))
- (while (search-forward "%title%" nil t)
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(read-only nil rear-nonsticky nil))
- (replace-match (or title " ") nil t))
- (goto-char (point-min))
- (while (search-forward "%anchor%" nil t)
- (replace-match (muse-journal-anchorize-title
- (or clean-title orig-date))
- nil t))
- (goto-char (point-min))
- (while (search-forward "%qotd%" nil t)
- (save-restriction
- (narrow-to-region (match-beginning 0) (match-end 0))
- (delete-region (point-min) (point-max))
- (when qotd (muse-insert-markup qotd))))
- (goto-char (point-min))
- (while (search-forward "%text%" nil t)
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(read-only nil rear-nonsticky nil))
- (replace-match text nil t))
- (when (null qotd)
- (goto-char (point-min))
- (when (search-forward "<div class=\"entry-qotd\">" nil t)
- (let ((beg (match-beginning 0)))
- (re-search-forward "</div>\n*" nil t)
- (delete-region beg (point))))))))))
- ;; indicate that we are to continue the :before-end processing
- nil)
-
-(defun muse-journal-latex-munge-buffer ()
- (goto-char (point-min))
- (let ((heading-regexp
- (concat "^" (regexp-quote (muse-markup-text 'section))
- muse-journal-heading-regexp
- (regexp-quote (muse-markup-text 'section-end)) "$"))
- (inhibit-read-only t))
- (when (re-search-forward heading-regexp nil t)
- (goto-char (match-beginning 0))
- (sort-subr nil
- (function
- (lambda ()
- (if (re-search-forward heading-regexp nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max)))))
- (function
- (lambda ()
- (if (re-search-forward heading-regexp nil t)
- (goto-char (1- (match-beginning 0)))
- (goto-char (point-max)))))
- (function
- (lambda ()
- (forward-char 2)))
- (function
- (lambda ()
- (end-of-line)))))
- (while (re-search-forward heading-regexp nil t)
- (let ((date (match-string 1))
- (title (match-string 2))
- ;; FIXME: Nothing is done with qotd
- qotd section)
- (save-match-data
- (when (and date
- (string-match
- (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
- "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
- (setq date (encode-time
- 0 0 0
- (string-to-number (match-string 3 date))
- (string-to-number (match-string 2 date))
- (string-to-number (match-string 1 date))
- nil)
- date (format-time-string
- muse-journal-date-format date))))
- (save-restriction
- (narrow-to-region (match-beginning 0) (match-end 0))
- (delete-region (point-min) (point-max))
- (muse-insert-markup muse-journal-latex-section)
- (goto-char (point-min))
- (while (search-forward "%title%" nil t)
- (replace-match (or title "Untitled") nil t))
- (goto-char (point-min))
- (while (search-forward "%date%" nil t)
- (replace-match (or date "") nil t))))))
- (goto-char (point-min))
- (let ((subheading-regexp
- (concat "^" (regexp-quote (muse-markup-text 'subsection))
- "\\([^\n}]+\\)"
- (regexp-quote (muse-markup-text 'subsection-end)) "$"))
- (inhibit-read-only t))
- (while (re-search-forward subheading-regexp nil t)
- (let ((title (match-string 1)))
- (save-restriction
- (narrow-to-region (match-beginning 0) (match-end 0))
- (delete-region (point-min) (point-max))
- (muse-insert-markup muse-journal-latex-subsection)
- (goto-char (point-min))
- (while (search-forward "%title%" nil t)
- (replace-match title nil t))))))
- ;; indicate that we are to continue the :before-end processing
- nil)
-
-(defun muse-journal-rss-munge-buffer ()
- (goto-char (point-min))
- (let ((heading-regexp muse-journal-rss-heading-regexp)
- (inhibit-read-only t))
- (while (re-search-forward heading-regexp nil t)
- (let* ((date (match-string 1))
- (orig-date date)
- (title (match-string 2))
- ;; FIXME: Nothing is done with qotd
- enclosure qotd desc)
- (if title
- (save-match-data
- (if (string-match muse-explicit-link-regexp title)
- (setq enclosure (muse-get-link title)
- title (muse-get-link-desc title)))))
- (save-match-data
- (when (and date
- (string-match
- (concat "\\([1-9][0-9][0-9][0-9]\\)[./]?"
- "\\([0-1][0-9]\\)[./]?\\([0-3][0-9]\\)") date))
- (setq date (encode-time 0 0 0
- (string-to-number (match-string 3 date))
- (string-to-number (match-string 2 date))
- (string-to-number (match-string 1 date))
- nil)
- ;; make sure that date is in a format that RSS
- ;; readers can handle
- date (let ((system-time-locale "C"))
- (format-time-string
- (muse-style-element :date-format) date)))))
- (save-restriction
- (narrow-to-region
- (match-beginning 0)
- (if (re-search-forward heading-regexp nil t)
- (match-beginning 0)
- (if (re-search-forward "^Footnotes:" nil t)
- (match-beginning 0)
- (point-max))))
- (goto-char (point-min))
- (delete-region (point) (muse-line-end-position))
- (re-search-forward "</qotd>\n+" nil t)
- (while (and (char-after)
- (eq ?\ (char-syntax (char-after))))
- (delete-char 1))
- (let ((beg (point)))
- (if (muse-style-element :summarize)
- (progn
- (forward-sentence 2)
- (setq desc (concat (buffer-substring beg (point)) "...")))
- (save-restriction
- (muse-publish-markup-buffer "rss-entry" "journal-rss-entry")
- (goto-char (point-min))
- (if (re-search-forward "Page published by Emacs Muse" nil t)
- (goto-char (muse-line-end-position))
- (muse-display-warning
- (concat
- "Cannot find 'Page published by Emacs Muse begins here'.\n"
- "You will probably need this text in your header."))
- (goto-char (point-min)))
- (setq beg (point))
- (if (re-search-forward "Page published by Emacs Muse" nil t)
- (goto-char (muse-line-beginning-position))
- (muse-display-warning
- (concat
- "Cannot find 'Page published by Emacs Muse ends here'.\n"
- "You will probably need this text in your footer."))
- (goto-char (point-max)))
- (setq desc (buffer-substring beg (point))))))
- (unless (string= desc "")
- (setq desc (concat "<![CDATA[" desc "]]>")))
- (delete-region (point-min) (point-max))
- (let ((entry (muse-style-element :entry-template)))
- (muse-insert-file-or-string entry)
- (goto-char (point-min))
- (while (search-forward "%date%" nil t)
- (replace-match (or date "") nil t))
- (goto-char (point-min))
- (while (search-forward "%title%" nil t)
- (replace-match "")
- (save-restriction
- (narrow-to-region (point) (point))
- (insert (or title "Untitled"))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(read-only nil rear-nonsticky nil))
- (let ((muse-publishing-current-style (muse-style "html")))
- (muse-publish-escape-specials (point-min) (point-max)
- nil 'document))))
- (goto-char (point-min))
- (while (search-forward "%desc%" nil t)
- (replace-match desc nil t))
- (goto-char (point-min))
- (while (search-forward "%enclosure%" nil t)
- (replace-match
- (if (null enclosure)
- ""
- (save-match-data
- (format
- "<enclosure url=\"%s\" %stype=\"%s\"/>"
- (if (string-match "//" enclosure)
- enclosure
- (concat (muse-style-element :base-url)
- enclosure))
- (let ((file
- (expand-file-name enclosure
- (muse-style-element :path))))
- (if (file-readable-p file)
- (format "length=\"%d\" "
- (nth 7 (file-attributes file)))
- ""))
- (if (string-match "\\.\\([^.]+\\)$" enclosure)
- (let* ((ext (match-string 1 enclosure))
- (type
- (assoc
- ext muse-journal-rss-enclosure-types-alist)))
- (if type
- (cdr type)
- "application/octet-stream"))))))
- nil t))
- (goto-char (point-min))
- (while (search-forward "%link%" nil t)
- (replace-match
- (concat (muse-style-element :base-url)
- (concat (muse-page-name)
- muse-html-extension))
- nil t))
- (goto-char (point-min))
- (while (search-forward "%anchor%" nil t)
- (replace-match
- (muse-journal-anchorize-title (or title orig-date))
- nil t))
- (goto-char (point-min))
- (while (search-forward "%maintainer%" nil t)
- (replace-match
- (or (muse-style-element :maintainer)
- (concat "webmaster@" (system-name)))
- nil t)))))))
- ;; indicate that we are to continue the :before-end processing
- nil)
-
-
-;;; Register the Muse Journal Publishers
-
-(muse-derive-style "journal-html" "html"
- :before-end 'muse-journal-html-munge-buffer)
-
-(muse-derive-style "journal-xhtml" "xhtml"
- :before-end 'muse-journal-html-munge-buffer)
-
-(muse-derive-style "journal-latex" "latex"
- :tags 'muse-journal-markup-tags
- :before-end 'muse-journal-latex-munge-buffer)
-
-(muse-derive-style "journal-pdf" "pdf"
- :tags 'muse-journal-markup-tags
- :before-end 'muse-journal-latex-munge-buffer)
-
-(muse-derive-style "journal-book-latex" "book-latex"
- ;;:nochapters
- :tags 'muse-journal-markup-tags
- :before-end 'muse-journal-latex-munge-buffer)
-
-(muse-derive-style "journal-book-pdf" "book-pdf"
- ;;:nochapters
- :tags 'muse-journal-markup-tags
- :before-end 'muse-journal-latex-munge-buffer)
-
-(muse-define-style "journal-rdf"
- :suffix 'muse-journal-rdf-extension
- :regexps 'muse-journal-rss-markup-regexps
- :functions 'muse-journal-rss-markup-functions
- :before 'muse-journal-rss-munge-buffer
- :header 'muse-journal-rdf-header
- :footer 'muse-journal-rdf-footer
- :date-format 'muse-journal-rdf-date-format
- :entry-template 'muse-journal-rdf-entry-template
- :base-url 'muse-journal-rdf-base-url
- :summarize 'muse-journal-rdf-summarize-entries)
-
-(muse-define-style "journal-rss"
- :suffix 'muse-journal-rss-extension
- :regexps 'muse-journal-rss-markup-regexps
- :functions 'muse-journal-rss-markup-functions
- :before 'muse-journal-rss-munge-buffer
- :header 'muse-journal-rss-header
- :footer 'muse-journal-rss-footer
- :date-format 'muse-journal-rss-date-format
- :entry-template 'muse-journal-rss-entry-template
- :base-url 'muse-journal-rss-base-url
- :summarize 'muse-journal-rss-summarize-entries)
-
-;; Used by `muse-journal-rss-munge-buffer' to mark up individual entries
-(muse-derive-style "journal-rss-entry" "html"
- :tags 'muse-journal-markup-tags)
-
-(provide 'muse-journal)
-
-;;; muse-journal.el ends here
diff --git a/packages/muse/muse-latex.el b/packages/muse/muse-latex.el
deleted file mode 100644
index e416367..0000000
--- a/packages/muse/muse-latex.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-latex2png.el b/packages/muse/muse-latex2png.el
deleted file mode 100644
index 2b4373d..0000000
--- a/packages/muse/muse-latex2png.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-mode.el b/packages/muse/muse-mode.el
deleted file mode 100644
index 75b1db3..0000000
--- a/packages/muse/muse-mode.el
+++ /dev/null
@@ -1,1012 +0,0 @@
-;;; muse-mode.el --- mode for editing Muse files; has font-lock support
-
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
-
-;; This file is part of Emacs Muse. It is not part of GNU Emacs.
-
-;; Emacs Muse is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation; either version 3, or (at your
-;; option) any later version.
-
-;; Emacs Muse is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with Emacs Muse; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; The Emacs Muse major mode is basically a hyped-up text-mode which
-;; knows a lot more about the apparent structure of the document.
-
-;;; Contributors:
-
-;; Andrea Riciputi (ariciputi AT pito DOT com) gave an initial
-;; implementation for tag completion by means of the `muse-insert-tag'
-;; function.
-
-;; Per B. Sederberg (per AT med DOT upenn DOT edu) contributed the
-;; insertion of relative links and list items, backlink searching, and
-;; other things as well.
-
-;; Stefan Schlee (stefan_schlee AT yahoo DOT com) fixed a bug in
-;; muse-next-reference and muse-previous-reference involving links
-;; that begin at point 1.
-
-;; Gregory Collins (greg AT gregorycollins DOT net) fixed a bug with
-;; paragraph separation and headings when filling.
-
-;;; Code:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Emacs Muse Major Mode
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(provide 'muse-mode)
-
-(require 'muse)
-(require 'muse-regexps)
-(require 'muse-project)
-
-(autoload 'muse-use-font-lock "muse-colors")
-(autoload 'muse-publish-this-file "muse-publish")
-(autoload 'muse-publish-get-style "muse-publish")
-(autoload 'muse-publish-output-file "muse-publish")
-
-(require 'derived)
-(eval-when-compile
- (condition-case nil
- (require 'pcomplete) ; load if available
- (error nil)))
-
-;;; Options:
-
-(defgroup muse-mode nil
- "Options controlling the behavior of the Muse editing Mode."
- :group 'muse)
-
-(defcustom muse-mode-highlight-p t
- "If non-nil, highlight the content of Muse buffers."
- :type 'boolean
- :require 'muse-colors
- :group 'muse-mode)
-
-(defcustom muse-mode-auto-p nil
- "If non-nil, automagically determine when Muse mode should be activated."
- :type 'boolean
- :set (function
- (lambda (sym value)
- (if value
- (add-hook 'find-file-hook 'muse-mode-maybe)
- (remove-hook 'find-file-hook 'muse-mode-maybe))
- (set sym value)))
- :group 'muse-mode)
-
-(defun muse-mode-maybe-after-init ()
- (when muse-mode-auto-p
- (add-hook 'find-file-hook 'muse-mode-maybe)))
-
-;; If the user sets this value in their init file, make sure that
-;; it takes effect
-(add-hook 'after-init-hook 'muse-mode-maybe-after-init)
-
-(defcustom muse-mode-intangible-links nil
- "If non-nil, use the intangible property on links.
-This can cause problems with flyspell (and potentially fill-mode),
-so only enable this if you don't use either of these."
- :type 'boolean
- :group 'muse-mode)
-
-(defcustom muse-mode-hook nil
- "A hook that is run when Muse mode is entered."
- :type 'hook
- :options '(flyspell-mode footnote-mode turn-on-auto-fill
- highlight-changes-mode)
- :group 'muse-mode)
-
-(defcustom muse-grep-command
- "find %D -type f ! -name '*~' | xargs -I {} echo \\\"{}\\\" | xargs egrep -n
-e \"%W\""
- "The command to use when grepping for backlinks and other
-searches through the muse projects. The string %D is replaced by
-the directories from muse-project-alist, space-separated. The
-string %W is replaced with the name of the muse page or whatever
-else you are searching for. This command has been modified to
-handle spaces in filenames, which were giving egrep a problem.
-
-Note: We highly recommend using glimpse to search large projects.
-To use glimpse, install and edit a file called .glimpse_exclude
-in your home directory. Put a list of glob patterns in that file
-to exclude Emacs backup files, etc. Then, run the indexer using:
-
- glimpseindex -o <list of Wiki directories>
-
-Once that's completed, customize this variable to have the
-following value:
-
- glimpse -nyi \"%W\"
-
-Your searches will go much, much faster, especially for very
-large projects. Don't forget to add a user cronjob to update the
-index at intervals."
- :type 'string
- :group 'muse-mode)
-
-(defvar muse-insert-map
- (let ((map (make-sparse-keymap)))
- (define-key map "l" 'muse-insert-relative-link-to-file)
- (define-key map "t" 'muse-insert-tag)
- (define-key map "u" 'muse-insert-url)
-
- map))
-
-;;; Muse mode
-
-(defvar muse-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(control ?c) (control ?a)] 'muse-index)
- (define-key map [(control ?c) (control ?e)] 'muse-edit-link-at-point)
- (define-key map [(control ?c) (control ?l)] 'font-lock-mode)
- (define-key map [(control ?c) (control ?t)]
- 'muse-project-publish-this-file)
- (define-key map [(control ?c) (control ?T)] 'muse-publish-this-file)
- (define-key map [(control ?c) (meta control ?t)] 'muse-publish-this-file)
- (define-key map [(control ?c) (control ?v)] 'muse-browse-result)
-
- (define-key map [(control ?c) ?=] 'muse-what-changed)
-
- (define-key map [tab] 'muse-next-reference)
- (define-key map [(control ?i)] 'muse-next-reference)
-
- (if (featurep 'xemacs)
- (progn
- (define-key map [(button2)] 'muse-follow-name-at-mouse)
- (define-key map [(shift button2)]
- 'muse-follow-name-at-mouse-other-window))
- (define-key map [(shift control ?m)]
- 'muse-follow-name-at-point-other-window)
- (define-key map [mouse-2] 'muse-follow-name-at-mouse)
- (define-key map [(shift mouse-2)]
- 'muse-follow-name-at-mouse-other-window))
-
- (define-key map [(shift tab)] 'muse-previous-reference)
- (unless (featurep 'xemacs)
- (define-key map [(shift iso-lefttab)] 'muse-previous-reference)
- (define-key map [(shift control ?i)] 'muse-previous-reference))
-
- (define-key map [(control ?c) (control ?f)] 'muse-project-find-file)
- (define-key map [(control ?c) (control ?p)] 'muse-project-publish)
-
- (define-key map [(control ?c) (control ?i)] 'muse-insert-thing)
- (define-key map [(control ?c) tab] 'muse-insert-thing)
-
- ;; Searching functions
- (define-key map [(control ?c) (control ?b)] 'muse-find-backlinks)
- (define-key map [(control ?c) (control ?s)] 'muse-search)
-
- ;; Enhanced list functions
- (define-key map [(meta return)] 'muse-insert-list-item)
- (define-key map [(control ?>)] 'muse-increase-list-item-indentation)
- (define-key map [(control ?<)] 'muse-decrease-list-item-indentation)
-
- (when (featurep 'pcomplete)
- (define-key map [(meta tab)] 'pcomplete)
- (define-key map [(meta control ?i)] 'pcomplete))
-
- map)
- "Keymap used by Emacs Muse mode.")
-
-;;;###autoload
-(define-derived-mode muse-mode text-mode "Muse"
- "Muse is an Emacs mode for authoring and publishing documents.
-\\{muse-mode-map}"
- ;; Since we're not inheriting from normal-mode, we need to
- ;; explicitly run file variables.
- (condition-case err
- (hack-local-variables)
- (error (message "File local-variables error: %s"
- (prin1-to-string err))))
- ;; Avoid lock-up caused by use of the 'intangible' text property
- ;; with flyspell.
- (unless muse-mode-intangible-links
- (set (make-local-variable 'inhibit-point-motion-hooks) t))
- (setq muse-current-project (muse-project-of-file))
- (muse-project-set-variables)
- ;; Make fill not split up links
- (when (boundp 'fill-nobreak-predicate)
- (make-local-variable 'fill-nobreak-predicate)
- ;; Work around annoying inconsistency in fill handling between
- ;; Emacs 21 and 22.
- (if (< emacs-major-version 22)
- (setq fill-nobreak-predicate 'muse-mode-fill-nobreak-p)
- (add-to-list 'fill-nobreak-predicate
- 'muse-mode-fill-nobreak-p)))
- ;; Make fill work nicely with item lists
- (let ((regexp (concat "\\s-+\\(-\\|[0-9]+\\.\\)\\s-+"
- "\\|\\[[0-9]+\\]\\s-*"
- "\\|.*\\s-*::\\s-+"
- "\\|\\*+\\s-+")))
- (set (make-local-variable 'adaptive-fill-regexp)
- (concat regexp "\\|\\s-*"))
- (set (make-local-variable 'paragraph-start)
- (concat paragraph-start "\\|" regexp))
- (set (make-local-variable 'paragraph-separate)
- (concat paragraph-separate "\\|\\*+\\s-+")))
- (set (make-local-variable 'fill-paragraph-function)
- 'muse-mode-fill-paragraph)
-
- ;; Comment syntax is `; comment'
- (set (make-local-variable 'comment-start)
- "; ")
- (set (make-local-variable 'comment-start-skip)
- "^;\\s-+")
- (set (make-local-variable 'indent-line-function)
- #'ignore)
- ;; If we're using Emacs21, this makes flyspell work like it should
- (when (boundp 'flyspell-generic-check-word-p)
- (set (make-local-variable 'flyspell-generic-check-word-p)
- 'muse-mode-flyspell-p))
- ;; If pcomplete is available, set it up
- (when (featurep 'pcomplete)
- (set (make-local-variable 'pcomplete-default-completion-function)
- 'muse-mode-completions)
- (set (make-local-variable 'pcomplete-command-completion-function)
- 'muse-mode-completions)
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- 'muse-mode-current-word))
- ;; Initialize any auto-generated variables
- (run-hooks 'muse-update-values-hook)
- (when muse-mode-highlight-p
- (muse-use-font-lock)))
-
-(put 'muse-mode
- 'flyspell-mode-predicate
- 'muse-mode-flyspell-p)
-
-(defun muse-mode-fill-nobreak-p ()
- "Return nil if we should allow a fill to occur at point.
-Otherwise return non-nil.
-
-This is used to keep long explicit links from being mangled by
-fill mode."
- (save-excursion
- (save-match-data
- (and (re-search-backward "\\[\\[\\|\\]\\]"
- (line-beginning-position) t)
- (string= (or (match-string 0) "")
- "[[")))))
-
-(defun muse-mode-fill-paragraph (arg)
- "If a definition list is at point, use special filling rules for it.
-Otherwise return nil to let the normal filling function take care
-of things.
-
-ARG is passed to `fill-paragraph'."
- (let ((count 2))
- (and (not (muse-mode-fill-nobreak-p))
- (save-excursion
- (beginning-of-line)
- (and (looking-at muse-dl-term-regexp)
- (prog1 t
- ;; Take initial whitespace into account
- (when (looking-at (concat "[" muse-regexp-blank "]+"))
- (setq count (+ count (length (match-string 0))))))))
- (let ((fill-prefix (make-string count ?\ ))
- (fill-paragraph-function nil))
- (prog1 t
- (fill-paragraph arg))))))
-
-(defun muse-mode-flyspell-p ()
- "Return non-nil if we should allow spell-checking to occur at point.
-Otherwise return nil.
-
-This is used to keep links from being improperly colorized by flyspell."
- (let ((pos (if (bobp) (point) (1- (point)))))
- (and (not (get-text-property pos 'muse-no-flyspell))
- (not (get-text-property pos 'muse-link))
- (save-match-data
- (null (muse-link-at-point))))))
-
-;;;###autoload
-(defun muse-mode-choose-mode ()
- "Turn the proper Emacs Muse related mode on for this file."
- (let ((project (muse-project-of-file)))
- (funcall (or (and project (muse-get-keyword :major-mode (cadr project) t))
- 'muse-mode))))
-
-(defun muse-mode-maybe ()
- "Maybe turn Emacs Muse mode on for this file."
- (let ((project (muse-project-of-file)))
- (and project
- (funcall (or (muse-get-keyword :major-mode (cadr project) t)
- 'muse-mode)))))
-
-;;; Enhanced list editing
-
-(defun muse-on-blank-line ()
- "See if point is on a blank line"
- (save-excursion
- (beginning-of-line)
- (looking-at (concat "[" muse-regexp-blank "]*$"))))
-
-(defun muse-get-paragraph-start ()
- "Return the start of the current paragraph. This function will
-return nil if there are no prior paragraphs and the beginning of
-the line if point is on a blank line."
- (let ((para-start (concat "^[" muse-regexp-blank "]*$")))
- ;; search back to start of paragraph
- (save-excursion
- (save-match-data
- (if (not (muse-on-blank-line))
- (re-search-backward para-start nil t)
- (line-beginning-position))))))
-
-(defun muse-insert-thing ()
- "Prompt for something to insert into the current buffer."
- (interactive)
- (message "Insert:\nl link\nt Muse tag\nu URL")
- (let (key cmd)
- (let ((overriding-local-map muse-insert-map))
- (setq key (read-key-sequence nil)))
- (if (commandp (setq cmd (lookup-key muse-insert-map key)))
- (progn (message "")
- (call-interactively cmd))
- (message "Not inserting anything"))))
-
-;;;###autoload
-(defun muse-insert-list-item ()
- "Insert a list item at the current point, taking into account
-your current list type and indentation level."
- (interactive)
- (let ((newitem " - ")
- (itemno nil)
- (pstart (muse-get-paragraph-start))
- (list-item (format muse-list-item-regexp
- (concat "[" muse-regexp-blank "]*"))))
- ;; search backwards for start of current item
- (save-excursion
- (when (re-search-backward list-item pstart t)
- ;; save the matching item
- (setq newitem (match-string 0))
- ;; see what type it is
- (if (string-match "::" (match-string 0))
- ;; is a definition, replace the term
- (setq newitem (concat " "
- (read-string "Term: ")
- " :: "))
- ;; see if it's a numbered list
- (when (string-match "[0-9]+" newitem)
- ;; is numbered, so increment
- (setq itemno (1+
- (string-to-number
- (match-string 0 newitem))))
- (setq newitem (replace-match
- (number-to-string itemno)
- nil nil newitem))))))
- ;; insert the new item
- (insert (concat "\n" newitem))))
-
-(defun muse-alter-list-item-indentation (operation)
- "Alter the indentation of the current list item.
-Valid values of OPERATION are `increase' and `decrease'."
- (let ((pstart (muse-get-paragraph-start))
- (list-item (format muse-list-item-regexp
- (concat "[" muse-regexp-blank "]*")))
- beg move-func indent)
- ;; search backwards until start of paragraph to see if we are on a
- ;; current item
- (save-excursion
- (if (or (progn (goto-char (muse-line-beginning-position))
- ;; we are on an item
- (looking-at list-item))
- ;; not on item, so search backwards
- (re-search-backward list-item pstart t))
- (let ((beg (point)))
- ;; we are on an item
- (setq indent (buffer-substring (match-beginning 0)
- (match-beginning 1)))
- (muse-forward-list-item (muse-list-item-type (match-string 1))
- (concat "[" muse-regexp-blank "]*")
- t)
- (save-restriction
- (narrow-to-region beg (point))
- (goto-char (point-min))
- (let ((halt nil))
- (while (< (point) (point-max))
- ;; increase or decrease the indentation
- (unless halt
- (cond ((eq operation 'increase)
- (insert " "))
- ((eq operation 'decrease)
- (if (looking-at " ")
- ;; we have enough space, so delete it
- (delete-region (match-beginning 0)
- (match-end 0))
- (setq halt t)))))
- (forward-line 1)))))
- ;; we are not on an item, so warn
- (message "You are not on a list item.")))))
-
-;;;###autoload
-(defun muse-increase-list-item-indentation ()
- "Increase the indentation of the current list item."
- (interactive)
- (muse-alter-list-item-indentation 'increase))
-
-;;;###autoload
-(defun muse-decrease-list-item-indentation ()
- "Decrease the indentation of the current list item."
- (interactive)
- (muse-alter-list-item-indentation 'decrease))
-
-;;; Support page name completion using pcomplete
-
-(defun muse-mode-completions ()
- "Return a list of possible completions names for this buffer."
- (let ((project (muse-project-of-file)))
- (if project
- (while (pcomplete-here
- (mapcar 'car (muse-project-file-alist project)))))))
-
-(defun muse-mode-current-word ()
- (let ((end (point)))
- (save-excursion
- (save-restriction
- (skip-chars-backward (concat "^\\[\n" muse-regexp-blank))
- (narrow-to-region (point) end))
- (pcomplete-parse-buffer-arguments))))
-
-;;; Navigate/visit links or URLs. Use TAB, S-TAB and RET (or mouse-2).
-
-(defun muse-link-at-point (&optional pos)
- "Return link text if a URL or link is at point."
- (let ((case-fold-search nil)
- (inhibit-point-motion-hooks t)
- (here (or pos (point))))
- ;; if we are using muse-colors, we can just use link properties to
- ;; determine whether we are on a link
- (if (featurep 'muse-colors)
- (when (get-text-property here 'muse-link)
- (save-excursion
- (when (and (not (bobp))
- (get-text-property (1- here) 'muse-link))
- (goto-char (or (previous-single-property-change here 'muse-link)
- (point-min))))
- (if (looking-at muse-explicit-link-regexp)
- (progn
- (goto-char (match-beginning 1))
- (muse-handle-explicit-link))
- (muse-handle-implicit-link))))
- ;; use fallback method to find a link
- (when (or (null pos)
- (and (char-after pos)
- (not (eq (char-syntax (char-after pos)) ?\ ))))
- (save-excursion
- (goto-char here)
- ;; check for explicit link here or before point
- (if (or (looking-at muse-explicit-link-regexp)
- (and
- (re-search-backward "\\[\\[\\|\\]\\]"
- (muse-line-beginning-position)
- t)
- (string= (or (match-string 0) "") "[[")
- (looking-at muse-explicit-link-regexp)))
- (progn
- (goto-char (match-beginning 1))
- (muse-handle-explicit-link))
- (goto-char here)
- ;; check for bare URL or other link type
- (skip-chars-backward (concat "^'\"<>{}(\n" muse-regexp-blank))
- (and (looking-at muse-implicit-link-regexp)
- (muse-handle-implicit-link))))))))
-
-(defun muse-make-link (link &optional desc)
- "Return a link to LINK with DESC as the description."
- (when (string-match muse-explicit-link-regexp link)
- (unless desc (setq desc (muse-get-link-desc link)))
- (setq link (muse-get-link link)))
- (if (and desc
- link
- (not (string= desc ""))
- (not (string= link desc)))
- (concat "[[" (muse-link-escape link) "][" (muse-link-escape desc) "]]")
- (concat "[[" (or (muse-link-escape link) "") "]]")))
-
-;;;###autoload
-(defun muse-insert-relative-link-to-file ()
- "Insert a relative link to a file, with optional description, at point."
- ;; Perhaps the relative location should be configurable, so that the
- ;; file search would start in the publishing directory and then
- ;; insert the link relative to the publishing directory
- (interactive)
- (insert
- (muse-make-link (file-relative-name (read-file-name "Link: "))
- (read-string "Text: "))))
-
-(defcustom muse-insert-url-initial-input "http://";
- "The string to insert before reading a URL interactively.
-This is used by the `muse-insert-url' command."
- :type 'string
- :group 'muse-mode)
-
-(defun muse-insert-url ()
- "Insert a URL, with optional description, at point."
- (interactive)
- (insert
- (muse-make-link (read-string "URL: " muse-insert-url-initial-input)
- (read-string "Text: "))))
-
-;;;###autoload
-(defun muse-edit-link-at-point ()
- "Edit the current link.
-Do not rename the page originally referred to."
- (interactive)
- (if (muse-link-at-point)
- (let ((link (muse-link-unescape (muse-get-link)))
- (desc (muse-link-unescape (muse-get-link-desc))))
- (replace-match
- (save-match-data
- (muse-make-link
- (read-string "Link: " link)
- (read-string "Text: " desc)))
- t t))
- (error "There is no valid link at point")))
-
-(defun muse-visit-link-default (link &optional other-window)
- "Visit the URL or link named by LINK.
-If ANCHOR is specified, search for it after opening LINK.
-
-This is the default function to call when visiting links; it is
-used by `muse-visit-link' if you have not specified :visit-link
-in `muse-project-alist'."
- (if (string-match muse-url-regexp link)
- (muse-browse-url link)
- (let (anchor
- base-buffer)
- (when (string-match "#" link)
- (setq anchor (substring link (match-beginning 0))
- link (if (= (match-beginning 0) 0)
- ;; If there is an anchor but no link, default
- ;; to the current page.
- nil
- (substring link 0 (match-beginning 0)))))
- (when link
- (setq base-buffer (get-buffer link))
- (if (and base-buffer (not (buffer-file-name base-buffer)))
- ;; If file is temporary (no associated file), just switch to
- ;; the buffer
- (if other-window
- (switch-to-buffer-other-window base-buffer)
- (switch-to-buffer base-buffer))
- (let ((project (muse-project-of-file)))
- (if project
- (muse-project-find-file link project
- (and other-window
- 'find-file-other-window))
- (if other-window
- (find-file-other-window link)
- (find-file link))))))
- (when anchor
- (let ((pos (point))
- (regexp (concat "^\\W*" (regexp-quote anchor) "\\b"))
- last)
- (goto-char (point-min))
- (while (and (setq last (re-search-forward regexp nil t))
- (muse-link-at-point)))
- (unless last
- (goto-char pos)
- (message "Could not find anchor `%s'" anchor)))))))
-
-(defun muse-visit-link (link &optional other-window)
- "Visit the URL or link named by LINK."
- (let ((visit-link-function
- (muse-get-keyword :visit-link (cadr (muse-project-of-file)) t)))
- (if visit-link-function
- (funcall visit-link-function link other-window)
- (muse-visit-link-default link other-window))))
-
-;;;###autoload
-(defun muse-browse-result (style &optional other-window)
- "Visit the current page's published result."
- (interactive
- (list (muse-project-get-applicable-style buffer-file-name
- (cddr muse-current-project))
- current-prefix-arg))
- (setq style (muse-style style))
- (muse-project-publish-this-file nil style)
- (let* ((output-dir (muse-style-element :path style))
- (output-suffix (muse-style-element :osuffix style))
- (output-path (muse-publish-output-file buffer-file-name output-dir
- style))
- (target (if output-suffix
- (concat (muse-path-sans-extension output-path)
- output-suffix)
- output-path))
- (muse-current-output-style (list :base (car style)
- :path output-dir)))
- (if (not (file-readable-p target))
- (error "Cannot open output file '%s'" target)
- (if other-window
- (find-file-other-window target)
- (let ((func (muse-style-element :browser style t)))
- (if func
- (funcall func target)
- (message "The %s publishing style does not support browsing."
- style)))))))
-
-;;;###autoload
-(defun muse-follow-name-at-point (&optional other-window)
- "Visit the link at point."
- (interactive "P")
- (let ((link (muse-link-at-point)))
- (if link
- (muse-visit-link link other-window)
- (error "There is no valid link at point"))))
-
-;;;###autoload
-(defun muse-follow-name-at-point-other-window ()
- "Visit the link at point in other window."
- (interactive)
- (muse-follow-name-at-point t))
-
-(defun muse-follow-name-at-mouse (event &optional other-window)
- "Visit the link at point, or yank text if none is found."
- (interactive "eN")
- (unless
- (save-excursion
- (cond ((fboundp 'event-window) ; XEmacs
- (set-buffer (window-buffer (event-window event)))
- (and (funcall (symbol-function 'event-point) event)
- (goto-char (funcall (symbol-function 'event-point)
- event))))
- ((fboundp 'posn-window) ; Emacs
- (set-buffer (window-buffer (posn-window (event-start event))))
- (goto-char (posn-point (event-start event)))))
- (let ((link (muse-link-at-point)))
- (when link
- (muse-visit-link link other-window)
- t)))
- ;; Fall back to normal binding for this event
- (call-interactively
- (lookup-key (current-global-map) (this-command-keys)))))
-
-(defun muse-follow-name-at-mouse-other-window (event)
- "Visit the link at point"
- (interactive "e")
- ;; throw away the old window position, since other-window will
- ;; change it anyway
- (select-window (car (cadr event)))
- (muse-follow-name-at-mouse event t))
-
-;;;###autoload
-(defun muse-next-reference ()
- "Move forward to next Muse link or URL, cycling if necessary."
- (interactive)
- (let ((pos))
- (save-excursion
- (when (get-text-property (point) 'muse-link)
- (goto-char (or (next-single-property-change (point) 'muse-link)
- (point-max))))
-
- (setq pos (next-single-property-change (point) 'muse-link))
-
- (when (not pos)
- (if (get-text-property (point-min) 'muse-link)
- (setq pos (point-min))
- (setq pos (next-single-property-change (point-min) 'muse-link)))))
-
- (when pos
- (goto-char pos))))
-
-;;;###autoload
-(defun muse-previous-reference ()
- "Move backward to the next Muse link or URL, cycling if necessary.
-In case of Emacs x <= 21 and ignoring of intangible properties (see
-`muse-mode-intangible-links').
-
-This function is not entirely accurate, but it's close enough."
- (interactive)
- (let ((pos))
- (save-excursion
-
- ;; Hack: The user perceives the two cases of point ("|")
- ;; position (1) "|[[" and (2) "[[|" or "][|" as "point is at
- ;; start of link". But in the sense of the function
- ;; "previous-single-property-change" these two cases are
- ;; different. The following code aligns these two cases. Emacs
- ;; 21: If the intangible property is ignored case (2) is more
- ;; complicate and this hack only solves the problem partially.
- ;;
- (when (and (get-text-property (point) 'muse-link)
- (muse-looking-back "\\[\\|\\]"))
- (goto-char (or (previous-single-property-change (point) 'muse-link)
- (point-min))))
-
- (when (eq (point) (point-min))
- (goto-char (point-max)))
-
- (setq pos (previous-single-property-change (point) 'muse-link))
-
- (when (not pos)
- (if (get-text-property (point-min) 'muse-link)
- (setq pos (point-min))
- (setq pos (previous-single-property-change (point-max)
- 'muse-link)))))
-
- (when pos
- (if (get-text-property pos 'muse-link)
- (goto-char pos)
- (goto-char (or (previous-single-property-change pos 'muse-link)
- (point-min)))))))
-
-;;;###autoload
-(defun muse-what-changed ()
- "Show the unsaved changes that have been made to the current file."
- (interactive)
- (diff-backup buffer-file-name))
-
-
-;;; Find text in project pages, or pages referring to the current page
-
-(defvar muse-search-history nil)
-
-(defun muse-grep (string &optional grep-command-no-shadow)
- "Grep for STRING in the project directories.
-GREP-COMMAND if passed will supplant `muse-grep-command'."
- ;; careful - grep-command leaks into compile, so we call it
- ;; -no-shadow instead
- (require 'compile)
- (let* ((str (or grep-command-no-shadow muse-grep-command))
- (muse-directories (mapcar
- (lambda (thing)
- (car (cadr thing)))
- muse-project-alist))
- (dirs (mapconcat (lambda (dir)
- (shell-quote-argument
- (expand-file-name dir)))
- muse-directories " ")))
- (if (string= dirs "")
- (muse-display-warning
- "No directories were found in the current project; aborting search")
- (while (string-match "%W" str)
- (setq str (replace-match string t t str)))
- (while (string-match "%D" str)
- (setq str (replace-match dirs t t str)))
- (if (fboundp 'compilation-start)
- (compilation-start str nil (lambda (&rest args) "*search*")
- grep-regexp-alist)
- (and (fboundp 'compile-internal)
- (compile-internal str "No more search hits" "search"
- nil grep-regexp-alist))))))
-
-;;;###autoload
-(defun muse-search-with-command (text)
- "Search for the given TEXT string in the project directories
-using the specified command."
- (interactive
- (list (let ((str (concat muse-grep-command)) pos)
- (when (string-match "%W" str)
- (setq pos (match-beginning 0))
- (unless (featurep 'xemacs)
- (setq pos (1+ pos)))
- (setq str (replace-match "" t t str)))
- (read-from-minibuffer "Search command: "
- (cons str pos) nil nil
- 'muse-search-history))))
- (muse-grep nil text))
-
-;;;###autoload
-(defun muse-search ()
- "Search for the given TEXT using the default grep command."
- (interactive)
- (muse-grep (read-string "Search: ")))
-
-;;;###autoload
-(defun muse-find-backlinks ()
- "Grep for the current pagename in all the project directories."
- (interactive)
- (muse-grep (muse-page-name)))
-
-
-;;; Generate an index of all known Muse pages
-
-(defun muse-generate-index (&optional as-list exclude-private)
- "Generate an index of all Muse pages."
- (let ((index (muse-index-as-string as-list exclude-private)))
- (with-current-buffer (get-buffer-create "*Muse Index*")
- (erase-buffer)
- (insert index)
- (current-buffer))))
-
-;;;###autoload
-(defun muse-index ()
- "Display an index of all known Muse pages."
- (interactive)
- (message "Generating Muse index...")
- (let ((project (muse-project)))
- (with-current-buffer (muse-generate-index)
- (goto-char (point-min))
- (muse-mode)
- (setq muse-current-project project)
- (pop-to-buffer (current-buffer))))
- (message "Generating Muse index...done"))
-
-(defun muse-index-as-string (&optional as-list exclude-private exclude-current)
- "Generate an index of all Muse pages.
-If AS-LIST is non-nil, insert a dash and spaces before each item.
-If EXCLUDE-PRIVATE is non-nil, exclude files that have private permissions.
-If EXCLUDE-CURRENT is non-nil, exclude the current file from the output."
- (let ((files (sort (copy-alist (muse-project-file-alist))
- (function
- (lambda (l r)
- (string-lessp (car l) (car r)))))))
- (when (and exclude-current (muse-page-name))
- (setq files (delete (assoc (muse-page-name) files) files)))
- (with-temp-buffer
- (while files
- (unless (and exclude-private
- (muse-project-private-p (cdar files)))
- (insert (if as-list " - " "") "[[" (caar files) "]]\n"))
- (setq files (cdr files)))
- (buffer-string))))
-
-;;; Insert tags interactively on C-c TAB t
-
-(defvar muse-tag-history nil
- "List of recently-entered tags; used by `muse-insert-tag'.
-If you want a tag to start as the default, you may manually set
-this variable to a list.")
-
-(defvar muse-custom-tags nil
- "Keep track of any new tags entered in `muse-insert-tag'.
-If there are (X)HTML tags that you use frequently with that
-function, you might want to set this manually.")
-
-;;;###autoload
-(defun muse-insert-tag (tag)
- "Insert a tag interactively with a blank line after it."
- (interactive
- (list
- (funcall
- muse-completing-read-function
- (concat "Tag: "
- (when muse-tag-history
- (concat "(default: " (car muse-tag-history) ") ")))
- (progn
- (require 'muse-publish)
- (mapcar 'list (nconc (mapcar 'car muse-publish-markup-tags)
- muse-custom-tags)))
- nil nil nil 'muse-tag-history
- (car muse-tag-history))))
- (when (equal tag "")
- (setq tag (car muse-tag-history)))
- (require 'muse-publish)
- (let ((tag-entry (assoc tag muse-publish-markup-tags))
- (options ""))
- ;; Add to custom list if no entry exists
- (unless tag-entry
- (add-to-list 'muse-custom-tags tag))
- ;; Get option
- (when (nth 2 tag-entry)
- (setq options (read-string "Option: ")))
- (unless (equal options "")
- (setq options (concat " " options)))
- ;; Insert the tag, closing if necessary
- (when tag (insert (concat "<" tag options ">")))
- (when (nth 1 tag-entry)
- (insert (concat "\n\n</" tag ">\n"))
- (forward-line -2))))
-
-;;; Muse list edit minor mode
-
-(defvar muse-list-edit-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(meta return)] 'muse-l-e-m-m-insert-list-item)
- (define-key map [(control ?>)] 'muse-l-e-m-m-increase-list-item-indent)
- (define-key map [(control ?<)] 'muse-l-e-m-m-decrease-list-item-indent)
-
- map)
- "Keymap used by Muse list edit minor mode.")
-
-(defvar muse-l-e-m-m-list-item-regexp
- (concat "^%s\\(\\([^\n" muse-regexp-blank "].*?\\)?::"
- "\\(?:[" muse-regexp-blank "]+\\|$\\)"
- "\\|[" muse-regexp-blank "]?[-*+][" muse-regexp-blank "]*"
- "\\|[" muse-regexp-blank "][0-9]+\\.[" muse-regexp-blank "]*\\)")
- "Regexp used to match the beginning of a list item.
-This is used by `muse-list-edit-minor-mode'.
-The `%s' will be replaced with a whitespace regexp when publishing.")
-
-(defun muse-l-e-m-m-insert-list-item ()
- "Insert a list item at the current point, taking into account
-your current list type and indentation level."
- (interactive)
- (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp))
- (call-interactively 'muse-insert-list-item)))
-
-(defun muse-l-e-m-m-increase-list-item-indent ()
- "Increase the indentation of the current list item."
- (interactive)
- (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp))
- (call-interactively 'muse-increase-list-item-indentation)))
-
-(defun muse-l-e-m-m-decrease-list-item-indent ()
- "Decrease the indentation of the current list item."
- (interactive)
- (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp))
- (call-interactively 'muse-decrease-list-item-indentation)))
-
-(defvar muse-l-e-m-m-data nil
- "A list of data that was changed by Muse list edit minor mode.")
-(make-variable-buffer-local 'muse-l-e-m-m-data)
-
-;;;###autoload
-(define-minor-mode muse-list-edit-minor-mode
- "This is a global minor mode for editing files with lists.
-It is meant to be used with other major modes, and not with Muse mode.
-
-Interactively, with no prefix argument, toggle the mode.
-With universal prefix ARG turn mode on.
-With zero or negative ARG turn mode off.
-
-This minor mode provides the Muse keybindings for editing lists,
-and support for filling lists properly.
-
-It recognizes not only Muse-style lists, which use the \"-\"
-character or numbers, but also lists that use asterisks or plus
-signs. This should make the minor mode generally useful.
-
-Definition lists and footnotes are also recognized.
-
-Note that list items may omit leading spaces, for compatibility
-with modes that set `left-margin', such as
-`debian-changelog-mode'.
-
-\\{muse-list-edit-minor-mode-map}"
- :init-value nil
- :lighter ""
- :keymap muse-list-edit-minor-mode-map
- :global nil
- :group 'muse-mode
- (if (not muse-list-edit-minor-mode)
- ;; deactivate
- (when muse-l-e-m-m-data
- (setq adaptive-fill-regexp (cdr (assoc "a-f-r" muse-l-e-m-m-data))
- paragraph-start (cdr (assoc "p-s" muse-l-e-m-m-data))
- fill-prefix (cdr (assoc "f-p" muse-l-e-m-m-data)))
- (setq muse-l-e-m-m-data nil))
- ;; activate
- (unless muse-l-e-m-m-data
- ;; save previous fill-related data so we can restore it later
- (setq muse-l-e-m-m-data
- (list (cons "a-f-r" adaptive-fill-regexp)
- (cons "p-s" paragraph-start)
- (cons "f-p" fill-prefix))))
- ;; make fill work nicely with item lists
- (let ((regexp (concat "\\s-*\\([-*+]\\|[0-9]+\\.\\)\\s-+"
- "\\|\\[[0-9]+\\]\\s-*"
- "\\|.*\\s-*::\\s-+")))
- (set (make-local-variable 'adaptive-fill-regexp)
- (concat regexp "\\|\\s-*"))
- (set (make-local-variable 'paragraph-start)
- (concat paragraph-start "\\|" regexp)))
- ;; force fill-prefix to be nil, because if it is a string that has
- ;; initial spaces, it messes up fill-paragraph's algorithm
- (set (make-local-variable 'fill-prefix) nil)))
-
-(defun turn-on-muse-list-edit-minor-mode ()
- "Unconditionally turn on Muse list edit minor mode."
- (muse-list-edit-minor-mode 1))
-
-(defun turn-off-muse-list-edit-minor-mode ()
- "Unconditionally turn off Muse list edit minor mode."
- (muse-list-edit-minor-mode -1))
-
-;;; muse-mode.el ends here
diff --git a/packages/muse/muse-poem.el b/packages/muse/muse-poem.el
deleted file mode 100644
index bd08b7e..0000000
--- a/packages/muse/muse-poem.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-project.el b/packages/muse/muse-project.el
deleted file mode 100644
index 57b0f32..0000000
--- a/packages/muse/muse-project.el
+++ /dev/null
@@ -1,979 +0,0 @@
-;;; muse-project.el --- handle Muse projects
-
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2014
-;; 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))
- (unless (member (car head) res)
- (setq res (append res (list (car head)))))
- (setq head (cdr head)))
- ((symbolp (car head))
- (let ((x (list (symbol-name (car head)) (cadr head))))
- (unless (member x res)
- (setq res (append res (list x)))))
- (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))
- (unless (member (car head) res)
- (setq res (append res (list (car head))))))
- ((consp (car head))
- (let ((x (intern (caar head)))
- (y (car (cdar head))))
- (unless (member x res) (setq res (append res (list x))))
- (unless (member y res) (setq res (append res (list y)))))))
- (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 (called-interactively-p 'interactive)
- (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 (called-interactively-p 'interactive) (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)
- (if (fboundp 'make-local-hook)
- (make-local-hook sym))
- (make-local-variable sym)))
- (funcall custom-set var (car (cdr vars)))
- (setq vars (cdr (cdr vars))))))
-
-(custom-add-option 'muse-before-publish-hook 'muse-project-set-variables)
-(add-to-list 'muse-before-publish-hook 'muse-project-set-variables)
-
-(defun muse-project-delete-output-files (project)
- (interactive
- (list (muse-read-project "Remove all output files for project: " nil t)))
- (setq project (muse-project project))
- (let ((file-alist (muse-project-file-alist project))
- (styles (cddr project))
- output-file path)
- (dolist (entry file-alist)
- (dolist (style styles)
- (setq output-file
- (and (setq path (muse-style-element :path style))
- (expand-file-name
- (concat (muse-style-element :prefix style)
- (car entry)
- (or (muse-style-element :osuffix style)
- (muse-style-element :suffix style)))
- path)))
- (if output-file
- (muse-delete-file-if-exists output-file))))))
-
-;;; muse-project.el ends here
diff --git a/packages/muse/muse-protocols.el b/packages/muse/muse-protocols.el
deleted file mode 100644
index 5e1061c..0000000
--- a/packages/muse/muse-protocols.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-publish.el b/packages/muse/muse-publish.el
deleted file mode 100644
index 1e79c9f..0000000
--- a/packages/muse/muse-publish.el
+++ /dev/null
@@ -1,2195 +0,0 @@
-;;; muse-publish.el --- base publishing implementation
-
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2014
-;; Free Software Foundation, Inc.
-
-;; This file is part of Emacs Muse. It is not part of GNU Emacs.
-
-;; Emacs Muse is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation; either version 3, or (at your
-;; option) any later version.
-
-;; Emacs Muse is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with Emacs Muse; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Contributors:
-
-;; Yann Hodique (yann DOT hodique AT gmail DOT com) fixed an
-;; unnecessary URL description transform in `muse-publish-url'.
-
-;; Peter K. Lee (saint AT corenova DOT com) provided the
-;; `muse-style-elements-list' function.
-
-;; Jim Ottaway (j DOT ottaway AT lse DOT ac DOT uk) provided a
-;; reference implementation for nested lists, as well as some code for
-;; the "style" element of the <literal> tag.
-
-;; Deus Max (deusmax AT gmail DOT com) provided the <php> tag.
-
-;;; Code:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Muse Publishing
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(provide 'muse-publish)
-
-(require 'muse)
-(require 'muse-regexps)
-
-(defgroup muse-publish nil
- "Options controlling the general behavior of Muse publishing."
- :group 'muse)
-
-(defcustom muse-before-publish-hook nil
- "A hook run in the buffer to be published, before it is done."
- :type 'hook
- :group 'muse-publish)
-
-(defcustom muse-after-publish-hook nil
- "A hook run in the buffer to be published, after it is done."
- :type 'hook
- :group 'muse-publish)
-
-(defcustom muse-publish-url-transforms
- '(muse-resolve-url)
- "A list of functions used to prepare URLs for publication.
-Each is passed the URL. The transformed URL should be returned."
- :type 'hook
- :options '(muse-resolve-url)
- :group 'muse-publish)
-
-(defcustom muse-publish-desc-transforms
- '(muse-publish-strip-URL)
- "A list of functions used to prepare URL desciptions for publication.
-Each is passed the description. The modified description should
-be returned."
- :type 'hook
- :options '(muse-publish-strip-URL)
- :group 'muse-publish)
-
-(defcustom muse-publish-date-format "%B %e, %Y"
- "Format string for the date, used by `muse-publish-markup-buffer'.
-See `format-time-string' for details on the format options."
- :type 'string
- :group 'muse-publish)
-
-(defcustom muse-publish-comments-p nil
- "If nil, remove comments before publishing.
-If non-nil, publish comments using the markup of the current style."
- :type 'boolean
- :group 'muse-publish)
-
-(defcustom muse-publish-report-threshhold 100000
- "If a file is this size or larger, report publishing progress."
- :type 'integer
- :group 'muse-publish)
-
-(defcustom muse-publish-markup-regexps
- `(;; Remove leading and trailing whitespace from the file
- (1000 "\\(\\`\n+\\|\n+\\'\\)" 0 "")
-
- ;; Remove trailing whitespace from all lines
- (1100 ,(concat "[" muse-regexp-blank "]+$") 0 "")
-
- ;; Handle any leading #directives
- (1200 "\\`#\\([a-zA-Z-]+\\)\\s-+\\(.+\\)\n+" 0 directive)
-
- ;; commented lines
- (1250 ,(concat "^;\\(?:[" muse-regexp-blank "]+\\(.+\\)\\|$\\|'\\)")
- 0 comment)
-
- ;; markup tags
- (1300 muse-tag-regexp 0 tag)
-
- ;; prevent emphasis characters in explicit links from being marked
- (1400 muse-explicit-link-regexp 0 muse-publish-mark-link)
-
- ;; emphasized or literal text
- (1600 ,(concat "\\(^\\|[-[" muse-regexp-blank
- "<('`\"\n]\\)\\(=[^=" muse-regexp-blank
- "\n]\\|_[^_" muse-regexp-blank
- "\n]\\|\\*+[^*" muse-regexp-blank
- "\n]\\)")
- 2 word)
-
- ;; headings, outline-mode style
- (1700 "^\\(\\*+\\)\\s-+" 0 heading)
-
- ;; ellipses
- (1800 "\\.\\.\\.\\." 0 enddots)
- (1850 "\\.\\.\\." 0 dots)
-
- ;; horizontal rule, or section separator
- (1900 "^----+" 0 rule)
-
- ;; non-breaking space
- (1950 "~~" 0 no-break-space)
-
- ;; beginning of footnotes section
- (2000 "^Footnotes:?\\s-*" 0 fn-sep)
- ;; footnote definition/reference (def if at beginning of line)
- (2100 "\\[\\([1-9][0-9]*\\)\\]" 0 footnote)
-
- ;; unnumbered List items begin with a -. numbered list items
- ;; begin with number and a period. definition lists have a
- ;; leading term separated from the body with ::. centered
- ;; paragraphs begin with at least six columns of whitespace; any
- ;; other whitespace at the beginning indicates a blockquote. The
- ;; reason all of these rules are handled here, is so that
- ;; blockquote detection doesn't interfere with indented list
- ;; members.
- (2200 ,(format muse-list-item-regexp (concat "[" muse-regexp-blank "]*"))
- 0 list)
-
- ;; support table.el style tables
- (2300 ,(concat "^" muse-table-el-border-regexp "\n"
- "\\(\\(" muse-table-el-line-regexp "\n\\)+"
- "\\(" muse-table-el-border-regexp "\\)"
- "\\(\n\\|\\'\\)\\)+")
- 0 table-el)
-
- ;; simple table markup is supported, nothing fancy. use | to
- ;; separate cells, || to separate header cells, and ||| for footer
- ;; cells
- (2350 ,(concat "\\(\\([" muse-regexp-blank "]*\n\\)?"
- "\\(\\(?:" muse-table-line-regexp "\\|"
- muse-table-hline-regexp "\\)\\(?:\n\\|\\'\\)\\)\\)+")
- 0 table)
-
- ;; blockquote and centered text
- (2400 ,(concat "^\\([" muse-regexp-blank "]+\\).+") 0 quote)
-
- ;; the emdash ("--" or "---")
- (2500 ,(concat "\\(^\\|[" muse-regexp-blank "]*\\)---?\\($\\|["
- muse-regexp-blank "]*\\)")
- 0 emdash)
-
- ;; "verse" text is indicated the same way as a quoted e-mail
- ;; response: "> text", where text may contain initial whitespace
- ;; (see below).
- (2600 ,(concat "^[" muse-regexp-blank "]*> ") 0 verse)
-
- ;; define anchor points
- (2700 "^\\(\\W*\\)#\\(\\S-+\\)\\s-*" 0 anchor)
-
- ;; replace links in the buffer (links to other pages)
- (2900 muse-explicit-link-regexp 0 link)
-
- ;; bare URLs
- (3000 muse-url-regexp 0 url)
-
- ;; bare email addresses
- (3500
- "\\([^[]\\)[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" 0 email)
- )
- "List of markup rules for publishing a page with Muse.
-The rules given in this variable are invoked first, followed by
-whatever rules are specified by the current style.
-
-Each member of the list is either a function, or a list of the form:
-
- (REGEXP/SYMBOL TEXT-BEGIN-GROUP REPLACEMENT-TEXT/FUNCTION/SYMBOL)
-
-REGEXP is a regular expression, or symbol whose value is a regular
-expression, which is searched for using `re-search-forward'.
-TEXT-BEGIN-GROUP is the matching group within that regexp which
-denotes the beginning of the actual text to be marked up.
-REPLACEMENT-TEXT is a string that will be passed to `replace-match'.
-If it is not a string, but a function, it will be called to determine
-what the replacement text should be (it must return a string). If it
-is a symbol, the value of that symbol should be a string.
-
-The replacements are done in order, one rule at a time. Writing
-the regular expressions can be a tricky business. Note that case
-is never ignored. `case-fold-search' is always bound to nil
-while processing the markup rules."
- :type '(repeat (choice
- (list :tag "Markup rule"
- integer
- (choice regexp symbol)
- integer
- (choice string function symbol))
- function))
- :group 'muse-publish)
-
-(defcustom muse-publish-markup-functions
- '((directive . muse-publish-markup-directive)
- (comment . muse-publish-markup-comment)
- (anchor . muse-publish-markup-anchor)
- (tag . muse-publish-markup-tag)
- (word . muse-publish-markup-word)
- (emdash . muse-publish-markup-emdash)
- (enddots . muse-publish-markup-enddots)
- (dots . muse-publish-markup-dots)
- (rule . muse-publish-markup-rule)
- (no-break-space . muse-publish-markup-no-break-space)
- (heading . muse-publish-markup-heading)
- (footnote . muse-publish-markup-footnote)
- (fn-sep . muse-publish-markup-fn-sep)
- (list . muse-publish-markup-list)
- (quote . muse-publish-markup-quote)
- (verse . muse-publish-markup-verse)
- (table . muse-publish-markup-table)
- (table-el . muse-publish-markup-table-el)
- (email . muse-publish-markup-email)
- (link . muse-publish-markup-link)
- (url . muse-publish-markup-url))
- "An alist of style types to custom functions for that kind of text.
-
-Each member of the list is of the form:
-
- (SYMBOL FUNCTION)
-
-SYMBOL describes the type of text to associate with this rule.
-`muse-publish-markup-regexps' maps regexps to these symbols.
-
-FUNCTION is the function to use to mark up this kind of rule if
-no suitable function is found through the :functions tag of the
-current style."
- :type '(alist :key-type symbol :value-type function)
- :group 'muse-publish)
-
-(defcustom muse-publish-markup-tags
- '(("contents" nil t nil muse-publish-contents-tag)
- ("verse" t nil nil muse-publish-verse-tag)
- ("example" t nil nil muse-publish-example-tag)
- ("src" t t nil muse-publish-src-tag)
- ("code" t nil nil muse-publish-code-tag)
- ("quote" t nil t muse-publish-quote-tag)
- ("literal" t t nil muse-publish-literal-tag)
- ("verbatim" t nil nil muse-publish-verbatim-tag)
- ("br" nil nil nil muse-publish-br-tag)
- ("lisp" t t nil muse-publish-lisp-tag)
- ("class" t t nil muse-publish-class-tag)
- ("div" t t nil muse-publish-div-tag)
- ("command" t t nil muse-publish-command-tag)
- ("perl" t t nil muse-publish-perl-tag)
- ("php" t t nil muse-publish-php-tag)
- ("python" t t nil muse-publish-python-tag)
- ("ruby" t t nil muse-publish-ruby-tag)
- ("comment" t nil nil muse-publish-comment-tag)
- ("include" nil t nil muse-publish-include-tag)
- ("markup" t t nil muse-publish-mark-up-tag)
- ("cite" t t nil muse-publish-cite-tag))
- "A list of tag specifications, for specially marking up text.
-XML-style tags are the best way to add custom markup to Muse.
-This is easily accomplished by customizing this list of markup tags.
-
-For each entry, the name of the tag is given, whether it expects
-a closing tag, whether it takes an optional set of attributes,
-whether it is nestable, and a function that performs whatever
-action is desired within the delimited region.
-
-The tags themselves are deleted during publishing, before the
-function is called. The function is called with three arguments,
-the beginning and end of the region surrounded by the tags. If
-properties are allowed, they are passed as a third argument in
-the form of an alist. The `end' argument to the function is
-always a marker.
-
-Point is always at the beginning of the region within the tags, when
-the function is called. Wherever point is when the function finishes
-is where tag markup will resume.
-
-These tag rules are processed once at the beginning of markup, and
-once at the end, to catch any tags which may have been inserted
-in-between."
- :type '(repeat (list (string :tag "Markup tag")
- (boolean :tag "Expect closing tag" :value t)
- (boolean :tag "Parse attributes" :value nil)
- (boolean :tag "Nestable" :value nil)
- function))
- :group 'muse-publish)
-
-(defcustom muse-publish-markup-header-footer-tags
- '(("lisp" t t nil muse-publish-lisp-tag)
- ("markup" t t nil muse-publish-mark-up-tag))
- "Tags used when publishing headers and footers.
-See `muse-publish-markup-tags' for details."
- :type '(repeat (list (string :tag "Markup tag")
- (boolean :tag "Expect closing tag" :value t)
- (boolean :tag "Parse attributes" :value nil)
- (boolean :tag "Nestable" :value nil)
- function))
- :group 'muse-publish)
-
-(defcustom muse-publish-markup-specials nil
- "A table of characters which must be represented specially."
- :type '(alist :key-type character :value-type string)
- :group 'muse-publish)
-
-(defcustom muse-publish-enable-local-variables nil
- "If non-nil, interpret local variables in a file when publishing."
- :type 'boolean
- :group 'muse-publish)
-
-(defcustom muse-publish-enable-dangerous-tags t
- "If non-nil, publish tags like <lisp> and <command> that can
-call external programs or expose sensitive information.
-Otherwise, ignore tags like this.
-
-This is useful to set to nil when the file to publish is coming
-from an untrusted source."
- :type 'boolean
- :group 'muse-publish)
-
-(defvar muse-publishing-p nil
- "This is set to t while a page is being published.")
-(defvar muse-batch-publishing-p nil
- "This is set to t while a page is being batch published.")
-(defvar muse-inhibit-before-publish-hook nil
- "This is set to t when publishing a file rather than just a buffer.
-It is used by `muse-publish-markup-buffer'.")
-(defvar muse-publishing-styles nil
- "The publishing styles that Muse recognizes.
-This is automatically generated when loading publishing styles.")
-(defvar muse-publishing-current-file nil
- "The file that is currently being published.")
-(defvar muse-publishing-current-output-path nil
- "The path where the current file will be published to.")
-(defvar muse-publishing-current-style nil
- "The style of the file that is currently being published.")
-(defvar muse-publishing-directives nil
- "An alist of publishing directives from the top of a file.")
-(defvar muse-publish-generate-contents nil
- "Non-nil if a table of contents should be generated.
-If non-nil, it is a cons cell specifying (MARKER . DEPTH), to
-tell where the <contents> was seen, and to what depth the
-contents were requested.")
-(defvar muse-publishing-last-position nil
- "Last position of the point when publishing.
-This is used to make sure that publishing doesn't get stalled.")
-
-(defvar muse-publish-inhibit-style-hooks nil
- "If non-nil, do not call the :before or :before-end hooks when publishing.")
-
-(defvar muse-publish-use-header-footer-tags nil
- "If non-nil, use `muse-publish-markup-header-footer-tags' for looking up
-tags. Otherwise, use `muse-publish-markup-tags'.")
-
-(defvar muse-inhibit-style-tags nil
- "If non-nil, do not search for style-specific tags.
-This is used when publishing headers and footers.")
-
-;; Functions for handling style information
-
-(defsubst muse-style (&optional style)
- "Resolve the given STYLE into a Muse style, if it is a string."
- (if (null style)
- muse-publishing-current-style
- (if (stringp style)
- (assoc style muse-publishing-styles)
- (muse-assert (consp style))
- style)))
-
-(defun muse-define-style (name &rest elements)
- (let ((entry (assoc name muse-publishing-styles)))
- (if entry
- (setcdr entry elements)
- (setq muse-publishing-styles
- (cons (append (list name) elements)
- muse-publishing-styles)))))
-
-(defun muse-derive-style (new-name base-name &rest elements)
- (apply 'muse-define-style new-name
- (append elements (list :base base-name))))
-
-(defsubst muse-get-keyword (keyword list &optional direct)
- (let ((value (cadr (memq keyword list))))
- (if (and (not direct) (symbolp value))
- (symbol-value value)
- value)))
-
-(defun muse-style-elements-list (elem &optional style)
- "Return a list all references to ELEM in STYLE, including base styles.
-If STYLE is not specified, use current style."
- (let (base elements)
- (while style
- (setq style (muse-style style))
- (setq elements (append elements
- (muse-get-keyword elem style)))
- (setq style (muse-get-keyword :base style)))
- elements))
-
-(defun muse-style-element (elem &optional style direct)
- "Search for ELEM in STYLE, including base styles.
-If STYLE is not specified, use current style."
- (setq style (muse-style style))
- (let ((value (muse-get-keyword elem style direct)))
- (if value
- value
- (let ((base (muse-get-keyword :base style)))
- (if base
- (muse-style-element elem base direct))))))
-
-(defun muse-style-derived-p-1 (base style)
- "Internal function used by `muse-style-derived-p'."
- (if (and (stringp style)
- (string= style base))
- t
- (setq style (muse-style style))
- (let ((value (muse-get-keyword :base style)))
- (when value
- (muse-style-derived-p base value)))))
-
-(defun muse-style-derived-p (base &optional style)
- "Return non-nil if STYLE is equal to or derived from BASE,
-non-nil otherwise.
-
-BASE should be a string."
- (unless style
- (setq style (muse-style)))
- (when (and (consp style)
- (stringp (car style)))
- (setq style (car style)))
- (muse-style-derived-p-1 base style))
-
-(defun muse-find-markup-element (keyword ident style)
- (let ((def (assq ident (muse-style-element keyword style))))
- (if def
- (cdr def)
- (let ((base (muse-style-element :base style)))
- (if base
- (muse-find-markup-element keyword ident base))))))
-
-(defun muse-markup-text (ident &rest args)
- "Insert ARGS into the text markup associated with IDENT.
-If the markup text has sections like %N%, this will be replaced
-with the N-1th argument in ARGS. After that, `format' is applied
-to the text with ARGS as parameters."
- (let ((text (muse-find-markup-element :strings ident (muse-style))))
- (if (and text args)
- (progn
- (let (start repl-text)
- (while (setq start (string-match "%\\([1-9][0-9]*\\)%" text start))
- ;; escape '%' in the argument text, since we will be
- ;; using format on it
- (setq repl-text (muse-replace-regexp-in-string
- "%" "%%"
- (nth (1- (string-to-number
- (match-string 1 text))) args)
- t t)
- start (+ start (length repl-text))
- text (replace-match repl-text t t text))))
- (apply 'format text args))
- (or text ""))))
-
-(defun muse-insert-markup (&rest args)
- (let ((beg (point)))
- (apply 'insert args)
- (muse-publish-mark-read-only beg (point))))
-
-(defun muse-find-markup-tag (keyword tagname style)
- (let ((def (assoc tagname (muse-style-element keyword style))))
- (or def
- (let ((base (muse-style-element :base style)))
- (if base
- (muse-find-markup-tag keyword tagname base))))))
-
-(defun muse-markup-tag-info (tagname &rest args)
- (let ((tag-info (and (not muse-inhibit-style-tags)
- (muse-find-markup-tag :tags tagname (muse-style)))))
- (or tag-info
- (assoc tagname
- (if muse-publish-use-header-footer-tags
- muse-publish-markup-header-footer-tags
- muse-publish-markup-tags)))))
-
-(defsubst muse-markup-function (category)
- (let ((func (muse-find-markup-element :functions category (muse-style))))
- (or func
- (cdr (assq category muse-publish-markup-functions)))))
-
-;; Publishing routines
-
-(defun muse-publish-markup (name rules)
- (let* ((case-fold-search nil)
- (inhibit-read-only t)
- (limit (* (length rules) (point-max)))
- (verbose (and muse-publish-report-threshhold
- (> (point-max) muse-publish-report-threshhold)))
- (base 0))
- (while rules
- (goto-char (point-min))
- (let ((regexp (nth 1 (car rules)))
- (group (nth 2 (car rules)))
- (repl (nth 3 (car rules)))
- pos)
- (setq muse-publishing-last-position nil)
- (if (symbolp regexp)
- (setq regexp (symbol-value regexp)))
- (if (and verbose (not muse-batch-publishing-p))
- (message "Publishing %s...%d%%" name
- (* (/ (float (+ (point) base)) limit) 100)))
- (while (and regexp (progn
- (when (and (get-text-property (point) 'read-only)
- (> (point) (point-min)))
- (goto-char (or (next-single-property-change
- (point) 'read-only)
- (point-max))))
- (setq pos (re-search-forward regexp nil t))))
- (if (and verbose (not muse-batch-publishing-p))
- (message "Publishing %s...%d%%" name
- (* (/ (float (+ (point) base)) limit) 100)))
- (unless (and (> (- (match-end 0) (match-beginning 0)) 0)
- (match-beginning group)
- (get-text-property (match-beginning group) 'read-only))
- (let* (func
- (text (cond
- ((and (symbolp repl)
- (setq func (muse-markup-function repl)))
- (funcall func))
- ((functionp repl)
- (funcall repl))
- ((symbolp repl)
- (symbol-value repl))
- (t repl))))
- (if (stringp text)
- (replace-match text t))))
- (if (and muse-publishing-last-position
- (= pos muse-publishing-last-position))
- (if (eobp)
- (setq regexp nil)
- (forward-char 1)))
- (setq muse-publishing-last-position pos)))
- (setq rules (cdr rules)
- base (+ base (point-max))))
- (if (and verbose (not muse-batch-publishing-p))
- (message "Publishing %s...done" name))))
-
-(defun muse-insert-file-or-string (file-or-string &optional title)
- (let ((beg (point)) end)
- (if (and (not (string-equal file-or-string ""))
- (not (string-match "\n" file-or-string))
- (file-readable-p file-or-string))
- (setq end (+ beg
- (cadr (muse-insert-file-contents file-or-string))))
- (insert file-or-string)
- (setq end (point)))
- (save-restriction
- (narrow-to-region beg end)
- (remove-text-properties (point-min) (point-max)
- '(read-only nil rear-nonsticky nil))
- (goto-char (point-min))
- (let ((muse-inhibit-style-tags t)
- (muse-publish-use-header-footer-tags t))
- (muse-publish-markup (or title "")
- '((100 muse-tag-regexp 0
- muse-publish-markup-tag)))))))
-
-(defun muse-style-run-hooks (keyword style &rest args)
- (catch 'handled
- (let ((cache nil))
- (while (and style
- (setq style (muse-style style)))
- (let ((func (muse-style-element keyword style t)))
- (when (and func
- (not (member func cache)))
- (setq cache (cons func cache))
- (when (apply func args)
- (throw 'handled t))))
- (setq style (muse-style-element :base style))))))
-
-(defun muse-publish-markup-region (beg end &optional title style)
- "Apply the given STYLE's markup rules to the given region.
-TITLE is used when indicating the publishing progress; it may be nil.
-
-The point is guaranteed to be at END if the routine terminates
-normally."
- (unless title (setq title ""))
- (unless style
- (or (setq style muse-publishing-current-style)
- (error "Cannot find any publishing styles to use")))
- (save-restriction
- (narrow-to-region beg end)
- (let ((muse-publish-generate-contents nil))
- (unless muse-publish-inhibit-style-hooks
- (muse-style-run-hooks :before style))
- (muse-publish-markup
- title
- (sort (copy-alist (append muse-publish-markup-regexps
- (muse-style-elements-list :regexps style)))
- (function
- (lambda (l r)
- (< (car l) (car r))))))
- (unless muse-publish-inhibit-style-hooks
- (muse-style-run-hooks :before-end style))
- (muse-publish-escape-specials (point-min) (point-max) nil 'document))
- (goto-char (point-max))))
-
-(defun muse-publish-markup-buffer (title style)
- "Apply the given STYLE's markup rules to the current buffer."
- (setq style (muse-style style))
- (let ((style-header (muse-style-element :header style))
- (style-footer (muse-style-element :footer style))
- (muse-publishing-current-style style)
- (muse-publishing-directives
- (list (cons "title" title)
- (cons "author" (user-full-name))
- (cons "date" (format-time-string
- muse-publish-date-format
- (if muse-publishing-current-file
- (nth 5 (file-attributes
- muse-publishing-current-file))
- (current-time))))))
- (muse-publishing-p t)
- (inhibit-read-only t))
- (run-hooks 'muse-update-values-hook)
- (unless muse-inhibit-before-publish-hook
- (run-hooks 'muse-before-publish-hook))
- (muse-publish-markup-region (point-min) (point-max) title style)
- (goto-char (point-min))
- (when style-header
- (muse-insert-file-or-string style-header title))
- (goto-char (point-max))
- (when style-footer
- (muse-insert-file-or-string style-footer title))
- (muse-style-run-hooks :after style)
- (run-hooks 'muse-after-publish-hook)))
-
-(defun muse-publish-markup-string (string &optional style)
- "Markup STRING using the given STYLE's markup rules."
- (setq style (muse-style style))
- (muse-with-temp-buffer
- (insert string)
- (let ((muse-publishing-current-style style)
- (muse-publishing-p t))
- (muse-publish-markup "*string*" (muse-style-element :rules style)))
- (buffer-string)))
-
-;; Commands for publishing files
-
-(defun muse-publish-get-style (&optional styles)
- (unless styles (setq styles muse-publishing-styles))
- (if (= 1 (length styles))
- (car styles)
- (when (catch 'different
- (let ((first (car (car styles))))
- (dolist (style (cdr styles))
- (unless (equal first (car style))
- (throw 'different t)))))
- (setq styles (muse-collect-alist
- styles
- (funcall muse-completing-read-function
- "Publish with style: " styles nil t))))
- (if (or (= 1 (length styles))
- (not (muse-get-keyword :path (car styles))))
- (car styles)
- (setq styles (mapcar (lambda (style)
- (cons (muse-get-keyword :path style)
- style))
- styles))
- (cdr (assoc (funcall muse-completing-read-function
- "Publish to directory: " styles nil t)
- styles)))))
-
-(defsubst muse-publish-get-output-dir (style)
- (let ((default-directory (or (muse-style-element :path style)
- default-directory)))
- (muse-read-directory-name "Publish to directory: " nil default-directory)))
-
-(defsubst muse-publish-get-info ()
- (let ((style (muse-publish-get-style)))
- (list style (muse-publish-get-output-dir style)
- current-prefix-arg)))
-
-(defsubst muse-publish-output-name (&optional file style)
- (setq style (muse-style style))
- (concat (muse-style-element :prefix style)
- (muse-page-name file)
- (muse-style-element :suffix style)))
-
-(defsubst muse-publish-output-file (file &optional output-dir style)
- (setq style (muse-style style))
- (if output-dir
- (expand-file-name (muse-publish-output-name file style) output-dir)
- (concat (file-name-directory file)
- (muse-publish-output-name file style))))
-
-(defsubst muse-publish-link-name (&optional file style)
- "Take FILE and add :prefix and either :link-suffix or :suffix from STYLE.
-We assume that FILE is a Muse file.
-
-We call `muse-page-name' on FILE to remove the directory part of
-FILE and any extensions that are in `muse-ignored-extensions'."
- (setq style (muse-style style))
- (concat (muse-style-element :prefix style)
- (muse-page-name file)
- (or (muse-style-element :link-suffix style)
- (muse-style-element :suffix style))))
-
-(defsubst muse-publish-link-file (file &optional style)
- "Turn FILE into a URL.
-
-If FILE exists on the system as-is, return it without
-modification. In the case of wanting to link to Muse files when
-`muse-file-extension' is nil, you should load muse-project.el.
-
-Otherwise, assume that it is a Muse file and call
-`muse-publish-link-name' to add :prefix, :link-suffix, :suffix,
-and removing ignored file extensions, but preserving the
-directory part of FILE."
- (setq style (muse-style style))
- (if (file-exists-p file)
- file
- (concat (file-name-directory file)
- (muse-publish-link-name file style))))
-
-(defsubst muse-publish-link-page (page)
- "Turn PAGE into a URL.
-
-This is called by `muse-publish-classify-url' to figure out what
-a link to another file or Muse page should look like.
-
-If muse-project.el is loaded, call `muse-project-link-page' for this.
-Otherwise, call `muse-publish-link-file'."
- (if (fboundp 'muse-project-link-page)
- (muse-project-link-page page)
- (muse-publish-link-file page)))
-
-(defmacro muse-publish-ensure-block (beg &optional end)
- "Ensure that block-level markup at BEG is published with at least one
-preceding blank line. BEG must be an unquoted symbol that contains a
-position or marker. BEG is modified to be the new position.
-The point is left at the new value of BEG.
-
-Additionally, make sure that BEG is placed on a blank line.
-
-If END is given, make sure that it is placed on a blank line. In
-order to achieve this, END must be an unquoted symbol that
-contains a marker. This is the case with Muse tag functions."
- `(progn
- (goto-char ,beg)
- (cond ((not (bolp)) (insert "\n\n"))
- ((eq (point) (point-min)) nil)
- ((prog2 (backward-char) (bolp) (forward-char)) nil)
- (t (insert "\n")))
- (unless (and (bolp) (eolp))
- (insert "\n")
- (backward-char))
- (setq ,beg (point))
- (when (markerp ,end)
- (goto-char ,end)
- (unless (and (bolp) (eolp))
- (insert-before-markers "\n")))
- (goto-char ,beg)))
-
-;;;###autoload
-(defun muse-publish-region (beg end &optional title style)
- "Apply the given STYLE's markup rules to the given region.
-The result is placed in a new buffer that includes TITLE in its name."
- (interactive "r")
- (when (called-interactively-p 'interactive)
- (unless title (setq title (read-string "Title: ")))
- (unless style (setq style (muse-publish-get-style))))
- (let ((text (buffer-substring beg end))
- (buf (generate-new-buffer (concat "*Muse: " title "*"))))
- (with-current-buffer buf
- (insert text)
- (muse-publish-markup-buffer title style)
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max)
- '(rear-nonsticky nil read-only nil))))
- (pop-to-buffer buf)))
-
-;;;###autoload
-(defun muse-publish-file (file style &optional output-dir force)
- "Publish the given FILE in a particular STYLE to OUTPUT-DIR.
-If the argument FORCE is nil, each file is only published if it is
-newer than the published version. If the argument FORCE is non-nil,
-the file is published no matter what."
- (interactive (cons (read-file-name "Publish file: ")
- (muse-publish-get-info)))
- (let ((style-name style))
- (setq style (muse-style style))
- (unless style
- (error "There is no style '%s' defined" style-name)))
- (let* ((output-path (muse-publish-output-file file output-dir style))
- (output-suffix (muse-style-element :osuffix style))
- (muse-publishing-current-file file)
- (muse-publishing-current-output-path output-path)
- (target (if output-suffix
- (concat (muse-path-sans-extension output-path)
- output-suffix)
- output-path))
- (threshhold (nth 7 (file-attributes file))))
- (if (not threshhold)
- (message "Please save %s before publishing" file)
- (when (or force (file-newer-than-file-p file target))
- (if (and muse-publish-report-threshhold
- (> threshhold
- muse-publish-report-threshhold))
- (message "Publishing %s ..." file))
- (muse-with-temp-buffer
- (muse-insert-file-contents file)
- (run-hooks 'muse-before-publish-hook)
- (when muse-publish-enable-local-variables
- (hack-local-variables))
- (let ((muse-inhibit-before-publish-hook t))
- (muse-publish-markup-buffer (muse-page-name file) style))
- (when (muse-write-file output-path)
- (muse-style-run-hooks :final style file output-path target)))
- t))))
-
-(defvar muse-current-output-style)
-
-;;;###autoload
-(defun muse-publish-this-file (style output-dir &optional force)
- "Publish the currently-visited file.
-Prompt for both the STYLE and OUTPUT-DIR if they are not
-supplied."
- (interactive (muse-publish-get-info))
- (setq style (muse-style style))
- (if buffer-file-name
- (let ((muse-current-output-style (list :base (car style)
- :path output-dir)))
- (unless (muse-publish-file buffer-file-name style output-dir force)
- (message (concat "The published version is up-to-date; use"
- " C-u C-c C-T to force an update."))))
- (message "This buffer is not associated with any file")))
-
-(defun muse-batch-publish-files ()
- "Publish Muse files in batch mode."
- (let ((muse-batch-publishing-p t)
- (font-lock-verbose nil)
- muse-current-output-style
- style output-dir)
- ;; don't activate VC when publishing files
- (setq vc-handled-backends nil)
- (setq style (car command-line-args-left)
- command-line-args-left (cdr command-line-args-left)
- output-dir (car command-line-args-left)
- output-dir
- (if (string-match "\\`--output-dir=" output-dir)
- (prog1
- (substring output-dir (match-end 0))
- (setq command-line-args-left (cdr command-line-args-left))))
- muse-current-output-style (list :base style :path output-dir))
- (setq auto-mode-alist
- (delete (cons (concat "\\." muse-file-extension "\\'")
- 'muse-mode-choose-mode)
- auto-mode-alist))
- (dolist (file command-line-args-left)
- (muse-publish-file file style output-dir t))))
-
-;; Default publishing rules
-
-(defun muse-publish-section-close (depth)
- "Seach forward for the closing tag of given DEPTH."
- (let (not-end)
- (save-excursion
- (while (and (setq not-end (re-search-forward
- (concat "^\\*\\{1," (number-to-string depth)
- "\\}\\s-+")
- nil t))
- (get-text-property (match-beginning 0) 'read-only)))
- (if not-end
- (forward-line 0)
- (goto-char (point-max)))
- (cond ((not (eq (char-before) ?\n))
- (insert "\n\n"))
- ((not (eq (char-before (1- (point))) ?\n))
- (insert "\n")))
- (muse-insert-markup (muse-markup-text 'section-close depth))
- (insert "\n"))))
-
-(defun muse-publish-markup-directive (&optional name value)
- (unless name (setq name (match-string 1)))
- (unless value (setq value (match-string 2)))
- (let ((elem (assoc name muse-publishing-directives)))
- (if elem
- (setcdr elem value)
- (setq muse-publishing-directives
- (cons (cons name value)
- muse-publishing-directives))))
- ;; Make sure we don't ever try to move the point forward (past the
- ;; beginning of buffer) while we're still searching for directives.
- (setq muse-publishing-last-position nil)
- (delete-region (match-beginning 0) (match-end 0)))
-
-(defsubst muse-publishing-directive (name)
- (cdr (assoc name muse-publishing-directives)))
-
-(defmacro muse-publish-get-and-delete-attr (attr attrs)
- "Delete attribute ATTR from ATTRS only once, destructively.
-
-This function returns the matching attribute value, if found."
- (let ((last (make-symbol "last"))
- (found (make-symbol "found"))
- (vals (make-symbol "vals")))
- `(let ((,vals ,attrs))
- (if (string= (caar ,vals) ,attr)
- (prog1 (cdar ,vals)
- (setq ,attrs (cdr ,vals)))
- (let ((,last ,vals)
- (,found nil))
- (while ,vals
- (setq ,vals (cdr ,vals))
- (when (string= (caar ,vals) ,attr)
- (setq ,found (cdar ,vals))
- (setcdr ,last (cdr ,vals))
- (setq ,vals nil))
- (setq ,last ,vals))
- ,found)))))
-
-(defun muse-publish-markup-anchor ()
- (unless (get-text-property (match-end 1) 'muse-link)
- (let ((text (muse-markup-text 'anchor (match-string 2))))
- (unless (string= text "")
- (save-match-data
- (skip-chars-forward (concat muse-regexp-blank "\n"))
- (muse-insert-markup text)))
- (match-string 1))))
-
-(defun muse-publish-markup-comment ()
- (if (null muse-publish-comments-p)
- ""
- (goto-char (match-end 0))
- (muse-insert-markup (muse-markup-text 'comment-end))
- (if (match-beginning 1)
- (progn
- (muse-publish-mark-read-only (match-beginning 1) (match-end 1))
- (delete-region (match-beginning 0) (match-beginning 1)))
- (delete-region (match-beginning 0) (match-end 0)))
- (goto-char (match-beginning 0))
- (muse-insert-markup (muse-markup-text 'comment-begin))))
-
-(defun muse-publish-markup-tag ()
- (let ((tag-info (muse-markup-tag-info (match-string 1))))
- (when (and tag-info
- (not (get-text-property (match-beginning 0) 'read-only))
- (nth 4 tag-info)
- (or muse-publish-enable-dangerous-tags
- (not (get (nth 4 tag-info) 'muse-dangerous-tag))))
- (let ((closed-tag (match-string 3))
- (start (match-beginning 0))
- (beg (point))
- end attrs)
- (when (nth 2 tag-info)
- (let ((attrstr (match-string 2)))
- (while (and attrstr
- (string-match (concat "\\([^"
- muse-regexp-blank
- "=\n]+\\)\\(=\"\\"
- "([^\"]+\\)\"\\)?")
- attrstr))
- (let ((attr (cons (downcase
- (muse-match-string-no-properties 1 attrstr))
- (muse-match-string-no-properties 3 attrstr))))
- (setq attrstr (replace-match "" t t attrstr))
- (if attrs
- (nconc attrs (list attr))
- (setq attrs (list attr)))))))
- (if (and (cadr tag-info) (not closed-tag))
- (if (muse-goto-tag-end (car tag-info) (nth 3 tag-info))
- (delete-region (match-beginning 0) (point))
- (setq tag-info nil)))
- (when tag-info
- (setq end (point-marker))
- (delete-region start beg)
- (goto-char start)
- (let ((args (list start end)))
- (if (nth 2 tag-info)
- (nconc args (list attrs)))
- (let ((muse-inhibit-style-tags nil))
- ;; remove the inhibition
- (apply (nth 4 tag-info) args)))
- (set-marker end nil)))))
- nil)
-
-(defun muse-publish-escape-specials (beg end &optional ignore-read-only
context)
- "Escape specials from BEG to END using style-specific :specials.
-If IGNORE-READ-ONLY is non-nil, ignore the read-only property.
-CONTEXT is used to figure out what kind of specials to escape.
-
-The following contexts exist in Muse.
-`underline' _underlined text_
-`literal' =monospaced text= or <code> region (monospaced, escaped)
-`emphasis' *emphasized text*
-`email' email@example.com
-`url' http://example.com
-`url-desc' [[...][description of an explicit link]]
-`image' [[image.png]]
-`example' <example> region (monospaced, block context, escaped)
-`verbatim' <verbatim> region (escaped)
-`footnote' footnote text
-`document' normal text"
- (let ((specials (muse-style-element :specials nil t)))
- (cond ((functionp specials)
- (setq specials (funcall specials context)))
- ((symbolp specials)
- (setq specials (symbol-value specials))))
- (if (functionp specials)
- (funcall specials beg end ignore-read-only)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (if (and (not ignore-read-only)
- (get-text-property (point) 'read-only))
- (goto-char (or (next-single-property-change (point) 'read-only)
- (point-max)))
- (let ((repl (or (assoc (char-after) specials)
- (assoc (char-after)
- muse-publish-markup-specials))))
- (if (null repl)
- (forward-char 1)
- (delete-char 1)
- (insert-before-markers (cdr repl)))))))))))
-
-(defun muse-publish-markup-word ()
- (let* ((beg (match-beginning 2))
- (end (1- (match-end 2)))
- (leader (buffer-substring-no-properties beg end))
- open-tag close-tag mark-read-only loc context)
- (cond
- ((string= leader "_")
- (setq context 'underline
- open-tag (muse-markup-text 'begin-underline)
- close-tag (muse-markup-text 'end-underline)))
- ((string= leader "=")
- (setq context 'literal
- open-tag (muse-markup-text 'begin-literal)
- close-tag (muse-markup-text 'end-literal))
- (setq mark-read-only t))
- (t
- (let ((l (length leader)))
- (setq context 'emphasis)
- (cond
- ((= l 1) (setq open-tag (muse-markup-text 'begin-emph)
- close-tag (muse-markup-text 'end-emph)))
- ((= l 2) (setq open-tag (muse-markup-text 'begin-more-emph)
- close-tag (muse-markup-text 'end-more-emph)))
- ((= l 3) (setq open-tag (muse-markup-text 'begin-most-emph)
- close-tag (muse-markup-text 'end-most-emph)))
- (t (setq context nil))))))
- (if (and context
- (not (get-text-property beg 'muse-link))
- (setq loc (search-forward leader nil t))
- (or (eobp) (not (eq (char-syntax (char-after loc)) ?w)))
- (not (eq (char-syntax (char-before (point))) ?\ ))
- (not (get-text-property (point) 'muse-link)))
- (progn
- (replace-match "")
- (delete-region beg end)
- (setq end (point-marker))
- (muse-insert-markup close-tag)
- (goto-char beg)
- (muse-insert-markup open-tag)
- (setq beg (point))
- (when mark-read-only
- (muse-publish-escape-specials beg end t context)
- (muse-publish-mark-read-only beg end))
- (set-marker end nil))
- (backward-char))
- nil))
-
-(defun muse-publish-markup-emdash ()
- (unless (get-text-property (match-beginning 0) 'muse-link)
- (let ((prespace (match-string 1))
- (postspace (match-string 2)))
- (delete-region (match-beginning 0) (match-end 0))
- (muse-insert-markup (muse-markup-text 'emdash prespace postspace))
- (when (eq (char-after) ?\<)
- (insert ?\n)))))
-
-(defun muse-publish-markup-enddots ()
- (unless (get-text-property (match-beginning 0) 'muse-link)
- (delete-region (match-beginning 0) (match-end 0))
- (muse-insert-markup (muse-markup-text 'enddots))))
-
-(defun muse-publish-markup-dots ()
- (unless (get-text-property (match-beginning 0) 'muse-link)
- (delete-region (match-beginning 0) (match-end 0))
- (muse-insert-markup (muse-markup-text 'dots))))
-
-(defun muse-publish-markup-rule ()
- (unless (get-text-property (match-beginning 0) 'muse-link)
- (delete-region (match-beginning 0) (match-end 0))
- (muse-insert-markup (muse-markup-text 'rule))))
-
-(defun muse-publish-markup-no-break-space ()
- (unless (get-text-property (match-beginning 0) 'muse-link)
- (delete-region (match-beginning 0) (match-end 0))
- (muse-insert-markup (muse-markup-text 'no-break-space))))
-
-(defun muse-publish-markup-heading ()
- (let* ((len (length (match-string 1)))
- (start (muse-markup-text
- (cond ((= len 1) 'section)
- ((= len 2) 'subsection)
- ((= len 3) 'subsubsection)
- (t 'section-other))
- len))
- (end (muse-markup-text
- (cond ((= len 1) 'section-end)
- ((= len 2) 'subsection-end)
- ((= len 3) 'subsubsection-end)
- (t 'section-other-end))
- len)))
- (delete-region (match-beginning 0) (match-end 0))
- (muse-insert-markup start)
- (end-of-line)
- (when end
- (muse-insert-markup end))
- (forward-line 1)
- (unless (eq (char-after) ?\n)
- (insert "\n"))
- (muse-publish-section-close len)))
-
-(defvar muse-publish-footnotes nil)
-
-(defun muse-publish-markup-footnote ()
- "Scan ahead and snarf up the footnote body."
- (cond
- ((get-text-property (match-beginning 0) 'muse-link)
- nil)
- ((= (muse-line-beginning-position) (match-beginning 0))
- "")
- (t
- (let ((footnote (save-match-data
- (string-to-number (match-string 1))))
- (oldtext (match-string 0))
- footnotemark)
- (delete-region (match-beginning 0) (match-end 0))
- (save-excursion
- (when (re-search-forward (format "^\\[%d\\]\\s-+" footnote) nil t)
- (let* ((start (match-beginning 0))
- (beg (goto-char (match-end 0)))
- (end (save-excursion
- (if (search-forward "\n\n" nil t)
- (copy-marker (match-beginning 0))
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (point-marker)))))
- (while (re-search-forward
- (concat "^[" muse-regexp-blank "]+\\([^\n]\\)")
- end t)
- (replace-match "\\1" t))
- (let ((footnotemark-cmd (muse-markup-text 'footnotemark))
- (footnotemark-end-cmd (muse-markup-text 'footnotemark-end)))
- (if (string= "" footnotemark-cmd)
- (setq footnotemark
- (concat (muse-markup-text 'footnote)
- (muse-publish-escape-specials-in-string
- (buffer-substring-no-properties beg end)
- 'footnote)
- (muse-markup-text 'footnote-end)))
- (setq footnotemark (format footnotemark-cmd footnote
- footnotemark-end-cmd))
- (unless muse-publish-footnotes
- (set (make-local-variable 'muse-publish-footnotes)
- (make-vector 256 nil)))
- (unless (aref muse-publish-footnotes footnote)
- (setq footnotemark
- (concat
- footnotemark
- (concat (format (muse-markup-text 'footnotetext)
- footnote)
- (buffer-substring-no-properties beg end)
- (muse-markup-text 'footnotetext-end))))
- (aset muse-publish-footnotes footnote footnotemark))))
- (goto-char end)
- (skip-chars-forward "\n")
- (delete-region start (point))
- (set-marker end nil))))
- (if footnotemark
- (muse-insert-markup footnotemark)
- (insert oldtext))))))
-
-(defun muse-publish-markup-fn-sep ()
- (delete-region (match-beginning 0) (match-end 0))
- (muse-insert-markup (muse-markup-text 'fn-sep)))
-
-(defun muse-insert-markup-end-list (&rest args)
- (let ((beg (point)))
- (apply 'insert args)
- (add-text-properties beg (point) '(muse-end-list t))
- (muse-publish-mark-read-only beg (point))))
-
-(defun muse-publish-determine-dl-indent (continue indent-sym determine-sym)
- ;; If the caller doesn't know how much indentation to use, figure it
- ;; out ourselves. It is assumed that `muse-forward-list-item' has
- ;; been called just before this to set the match data.
- (when (and continue
- (symbol-value determine-sym))
- (save-match-data
- ;; snarf all leading whitespace
- (let ((indent (and (match-beginning 2)
- (buffer-substring (match-beginning 1)
- (match-beginning 2)))))
- (when (and indent
- (not (string= indent "")))
- (set indent-sym indent)
- (set determine-sym nil))))))
-
-(defun muse-publish-surround-dl (indent post-indent)
- (let* ((beg-item (muse-markup-text 'begin-dl-item))
- (end-item (muse-markup-text 'end-dl-item))
- (beg-ddt (muse-markup-text 'begin-ddt)) ;; term
- (end-ddt (muse-markup-text 'end-ddt))
- (beg-dde (muse-markup-text 'begin-dde)) ;; definition
- (end-dde (muse-markup-text 'end-dde))
- (continue t)
- (no-terms t)
- beg)
- (while continue
- ;; envelope this as one term+definitions unit -- HTML does not
- ;; need this, but DocBook and Muse's custom XML format do
- (muse-insert-markup beg-item)
- (when (looking-at muse-dl-term-regexp)
- ;; find the term and wrap it with published markup
- (setq beg (point)
- no-terms nil)
- (goto-char (match-end 1))
- (delete-region (point) (match-end 0))
- (muse-insert-markup-end-list end-ddt)
- ;; if definition is immediately after term, move to next line
- (unless (eq (char-after) ?\n)
- (insert ?\n))
- (save-excursion
- (goto-char beg)
- (delete-region (point) (match-beginning 1))
- (muse-insert-markup beg-ddt)))
- ;; handle pathological edge case where there is no term -- I
- ;; would prefer to just disallow this, but people seem to want
- ;; this behavior
- (when (and no-terms
- (looking-at (concat "[" muse-regexp-blank "]*::"
- "[" muse-regexp-blank "]*")))
- (delete-region (point) (match-end 0))
- ;; but only do this once
- (setq no-terms nil))
- (setq beg (point)
- ;; move past current item
- continue (muse-forward-list-item 'dl-term indent))
- (save-restriction
- (narrow-to-region beg (point))
- (goto-char (point-min))
- ;; publish each definition that we find, defaulting to an
- ;; empty definition if none are found
- (muse-publish-surround-text beg-dde end-dde
- (lambda (indent)
- (muse-forward-list-item 'dl-entry indent))
- indent post-indent
- #'muse-publish-determine-dl-indent)
- (goto-char (point-max))
- (skip-chars-backward (concat muse-regexp-blank "\n"))
- (muse-insert-markup-end-list end-item)
- (when continue
- (goto-char (point-max)))))))
-
-(defun muse-publish-strip-list-indentation (list-item empty-line indent
post-indent)
- (let ((list-nested nil)
- (indent-found nil))
- (while (< (point) (point-max))
- (when (and (looking-at list-item)
- (not (or (get-text-property
- (muse-list-item-critical-point) 'read-only)
- (get-text-property
- (muse-list-item-critical-point) 'muse-link))))
- ;; if we encounter a list item, allow no post-indent space
- (setq list-nested t))
- (when (and (not (looking-at empty-line))
- (looking-at (concat indent "\\("
- (or (and list-nested "")
- post-indent)
- "\\)")))
- ;; if list is not nested, remove indentation
- (unless indent-found
- (setq post-indent (match-string 1)
- indent-found t))
- (replace-match ""))
- (forward-line 1))))
-
-(defun muse-publish-surround-text (beg-tag end-tag move-func &optional indent
post-indent determine-indent-func list-item)
- (unless list-item
- (setq list-item (format muse-list-item-regexp
- (concat "[" muse-regexp-blank "]*"))))
- (let ((continue t)
- (empty-line (concat "^[" muse-regexp-blank "]*\n"))
- (determine-indent (if determine-indent-func t nil))
- (new-indent indent)
- (first t)
- beg)
- (unless indent
- (setq indent (concat "[" muse-regexp-blank "]+")))
- (if post-indent
- (setq post-indent (concat " \\{0," (number-to-string post-indent)
- "\\}"))
- (setq post-indent ""))
- (while continue
- (if (or (not end-tag) (string= end-tag ""))
- ;; if no end of list item markup exists, treat the beginning
- ;; of list item markup as it if it were the end -- this
- ;; prevents multiple-level lists from being confused
- (muse-insert-markup-end-list beg-tag)
- (muse-insert-markup beg-tag))
- (setq beg (point)
- ;; move past current item; continue is non-nil if there
- ;; are more like items to be processed
- continue (if (and determine-indent-func first)
- (funcall move-func (concat indent post-indent))
- (funcall move-func indent)))
- (when determine-indent-func
- (funcall determine-indent-func continue 'new-indent 'determine-indent))
- (when continue
- ;; remove list markup if we encountered another item of the
- ;; same type
- (replace-match "" t t nil 1))
- (save-restriction
- ;; narrow to current item
- (narrow-to-region beg (point))
- (goto-char (point-min))
- (if (looking-at empty-line)
- ;; if initial line is blank, move to first non-blank line
- (while (progn (forward-line 1)
- (and (< (point) (point-max))
- (looking-at empty-line))))
- ;; otherwise, move to second line of text
- (forward-line 1))
- ;; strip list indentation
- (muse-publish-strip-list-indentation list-item empty-line
- indent post-indent)
- (skip-chars-backward (concat muse-regexp-blank "\n"))
- (muse-insert-markup-end-list end-tag)
- (when determine-indent-func
- (setq indent new-indent))
- (when first
- (setq first nil))
- (when continue
- (goto-char (point-max)))))))
-
-(defun muse-publish-ensure-blank-line ()
- "Make sure that a blank line exists on the line before point."
- (let ((pt (point-marker)))
- (beginning-of-line)
- (cond ((eq (point) (point-min)) nil)
- ((prog2 (backward-char) (bolp) (forward-char)) nil)
- (t (insert-before-markers "\n")))
- (goto-char pt)
- (set-marker pt nil)))
-
-(defun muse-publish-markup-list ()
- "Markup a list entry.
-This function works by marking up items of the same list level
-and type, respecting the end-of-list property."
- (let* ((str (match-string 1))
- (type (muse-list-item-type str))
- (indent (buffer-substring (muse-line-beginning-position)
- (match-beginning 1)))
- (post-indent (length str)))
- (cond
- ((or (get-text-property (muse-list-item-critical-point) 'read-only)
- (get-text-property (muse-list-item-critical-point) 'muse-link))
- nil)
- ((eq type 'ul)
- (unless (eq (char-after (match-end 1)) ?-)
- (delete-region (match-beginning 0) (match-end 0))
- (muse-publish-ensure-blank-line)
- (muse-insert-markup (muse-markup-text 'begin-uli))
- (save-excursion
- (muse-publish-surround-text
- (muse-markup-text 'begin-uli-item)
- (muse-markup-text 'end-uli-item)
- (lambda (indent)
- (muse-forward-list-item 'ul indent))
- indent post-indent)
- (muse-insert-markup-end-list (muse-markup-text 'end-uli)))
- (forward-line 1)))
- ((eq type 'ol)
- (delete-region (match-beginning 0) (match-end 0))
- (muse-publish-ensure-blank-line)
- (muse-insert-markup (muse-markup-text 'begin-oli))
- (save-excursion
- (muse-publish-surround-text
- (muse-markup-text 'begin-oli-item)
- (muse-markup-text 'end-oli-item)
- (lambda (indent)
- (muse-forward-list-item 'ol indent))
- indent post-indent)
- (muse-insert-markup-end-list (muse-markup-text 'end-oli)))
- (forward-line 1))
- (t
- (goto-char (match-beginning 0))
- (muse-publish-ensure-blank-line)
- (muse-insert-markup (muse-markup-text 'begin-dl))
- (save-excursion
- (muse-publish-surround-dl indent post-indent)
- (muse-insert-markup-end-list (muse-markup-text 'end-dl)))
- (forward-line 1))))
- nil)
-
-(defun muse-publish-markup-quote ()
- "Markup a quoted paragraph.
-The reason this function is so funky, is to prevent text properties
-like read-only from being inadvertently deleted."
- (let* ((ws (match-string 1))
- (centered (>= (string-width ws) 6))
- (begin-elem (if centered 'begin-center 'begin-quote-item))
- (end-elem (if centered 'end-center 'end-quote-item)))
- (replace-match "" t t nil 1)
- (unless centered
- (muse-insert-markup (muse-markup-text 'begin-quote)))
- (muse-publish-surround-text (muse-markup-text begin-elem)
- (muse-markup-text end-elem)
- (function (lambda (indent)
- (muse-forward-paragraph)
- nil)))
- (unless centered
- (muse-insert-markup (muse-markup-text 'end-quote)))))
-
-(defun muse-publish-markup-leading-space (markup-space multiple)
- (let (count)
- (when (and markup-space
- (>= (setq count (skip-chars-forward " ")) 0))
- (delete-region (muse-line-beginning-position) (point))
- (while (> count 0)
- (muse-insert-markup markup-space)
- (setq count (- count multiple))))))
-
-(defun muse-publish-markup-verse ()
- (let ((leader (match-string 0)))
- (goto-char (match-beginning 0))
- (muse-insert-markup (muse-markup-text 'begin-verse))
- (while (looking-at leader)
- (replace-match "")
- (muse-publish-markup-leading-space (muse-markup-text 'verse-space) 2)
- (let ((beg (point)))
- (end-of-line)
- (cond
- ((bolp)
- (let ((text (muse-markup-text 'empty-verse-line)))
- (when text (muse-insert-markup text))))
- ((save-excursion
- (save-match-data
- (forward-line 1)
- (or (looking-at (concat leader "["
- muse-regexp-blank
- "]*$"))
- (not (looking-at leader)))))
- (let ((begin-text (muse-markup-text 'begin-last-stanza-line))
- (end-text (muse-markup-text 'end-last-stanza-line)))
- (when end-text (muse-insert-markup end-text))
- (goto-char beg)
- (when begin-text (muse-insert-markup begin-text))
- (end-of-line)))
- (t
- (let ((begin-text (muse-markup-text 'begin-verse-line))
- (end-text (muse-markup-text 'end-verse-line)))
- (when end-text (muse-insert-markup end-text))
- (goto-char beg)
- (when begin-text (muse-insert-markup begin-text))
- (end-of-line))))
- (forward-line 1))))
- (muse-insert-markup (muse-markup-text 'end-verse))
- (insert ?\n))
-
-(defun muse-publish-trim-table (table)
- "Remove completely blank columns from table, if at start or end of row."
- ;; remove first
- (catch 'found
- (dolist (row (cdr table))
- (let ((el (cadr row)))
- (when (and (stringp el) (not (string= el "")))
- (throw 'found t))))
- (dolist (row (cdr table))
- (setcdr row (cddr row)))
- (setcar table (1- (car table))))
- ;; remove last
- (catch 'found
- (dolist (row (cdr table))
- (let ((el (car (last row))))
- (when (and (stringp el) (not (string= el "")))
- (throw 'found t))))
- (dolist (row (cdr table))
- (setcdr (last row 2) nil))
- (setcar table (1- (car table))))
- table)
-
-(defun muse-publish-table-fields (beg end)
- "Parse given region as a table, returning a cons cell.
-The car is the length of the longest row.
-
-The cdr is a list of the fields of the table, with the first
-element indicating the type of the row:
- 1: body, 2: header, 3: footer, hline: separator.
-
-The existing region will be removed, except for initial blank lines."
- (unless (muse-publishing-directive "disable-tables")
- (let ((longest 0)
- (left 0)
- (seen-hline nil)
- fields field-list)
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (looking-at (concat "^[" muse-regexp-blank "]*$"))
- (forward-line 1))
- (setq beg (point))
- (while (= left 0)
- (cond
- ((looking-at muse-table-hline-regexp)
- (when field-list ; skip if at the beginning of table
- (if seen-hline
- (setq field-list (cons (cons 'hline nil) field-list))
- (dolist (field field-list)
- ;; the preceding fields are header lines
- (setcar field 2))
- (setq seen-hline t))))
- ((looking-at muse-table-line-regexp)
- (setq fields (cons (length (match-string 1))
- (mapcar #'muse-trim-whitespace
- (split-string (match-string 0)
- muse-table-field-regexp)))
- field-list (cons fields field-list)
- longest (max (length fields) longest))
- ;; strip initial bars, if they exist
- (let ((first (cadr fields)))
- (when (and first (string-match "\\`|+\\s-*" first))
- (setcar (cdr fields) (replace-match "" t t first))))))
- (setq left (forward-line 1))))
- (delete-region beg end)
- (if (= longest 0)
- (cons 0 nil)
- ;; if the last line was an hline, remove it
- (when (eq (caar field-list) 'hline)
- (setq field-list (cdr field-list)))
- (muse-publish-trim-table (cons (1- longest) (nreverse field-list)))))))
-
-(defun muse-publish-markup-table ()
- "Style does not support tables.\n")
-
-(defun muse-publish-table-el-table (variant)
- "Publish table.el-style tables in the format given by VARIANT."
- (when (condition-case nil
- (progn (require 'table)
- t)
- (error nil))
- (let ((muse-buf (current-buffer)))
- (save-restriction
- (narrow-to-region (match-beginning 0) (match-end 0))
- (goto-char (point-min))
- (forward-line 1)
- (when (search-forward "|" nil t)
- (with-temp-buffer
- (let ((temp-buf (current-buffer)))
- (with-current-buffer muse-buf
- (table-generate-source variant temp-buf))
- (with-current-buffer muse-buf
- (delete-region (point-min) (point-max))
- (insert-buffer-substring temp-buf)
- (muse-publish-mark-read-only (point-min) (point-max))))))))))
-
-(defun muse-publish-markup-table-el ()
- "Mark up table.el-style tables."
- (cond ((muse-style-derived-p 'html)
- (muse-publish-table-el-table 'html))
- ((muse-style-derived-p 'latex)
- (muse-publish-table-el-table 'latex))
- ((muse-style-derived-p 'docbook)
- (muse-publish-table-el-table 'cals))
- (t "Style does not support table.el tables.\n")))
-
-(defun muse-publish-escape-specials-in-string (string &optional context)
- "Escape specials in STRING using style-specific :specials.
-CONTEXT is used to figure out what kind of specials to escape.
-
-See the documentation of the `muse-publish-escape-specials'
-function for the list of available contexts."
- (unless string
- (setq string ""))
- (let ((specials (muse-style-element :specials nil t)))
- (cond ((functionp specials)
- (setq specials (funcall specials context)))
- ((symbolp specials)
- (setq specials (symbol-value specials))))
- (if (functionp specials)
- (funcall specials string)
- (apply (function concat)
- (mapcar
- (lambda (ch)
- (let ((repl (or (assoc ch specials)
- (assoc ch muse-publish-markup-specials))))
- (if (null repl)
- (char-to-string ch)
- (cdr repl))))
- (append string nil))))))
-
-(defun muse-publish-markup-email ()
- (let* ((beg (match-end 1))
- (addr (buffer-substring-no-properties beg (match-end 0))))
- (setq addr (muse-publish-escape-specials-in-string addr 'email))
- (goto-char beg)
- (delete-region beg (match-end 0))
- (if (or (eq (char-before (match-beginning 0)) ?\")
- (eq (char-after (match-end 0)) ?\"))
- (insert addr)
- (insert (format (muse-markup-text 'email-addr) addr addr)))
- (muse-publish-mark-read-only beg (point))))
-
-(defun muse-publish-classify-url (target)
- "Transform anchors and get published name, if TARGET is a page.
-The return value is two linked cons cells. The car is the type
-of link, the cadr is the page name, and the cddr is the anchor."
- (save-match-data
- (cond ((or (null target) (string= target ""))
- nil)
- ((string-match "\\`[uU][rR][lL]:\\(.+\\)\\'" target)
- (cons 'url (cons (match-string 1 target) nil)))
- ((string-match muse-image-regexp target)
- (cons 'image (cons target nil)))
- ((string-match muse-url-regexp target)
- (cons 'url (cons target nil)))
- ((string-match muse-file-regexp target)
- (cons 'file (cons target nil)))
- ((string-match "#" target)
- (if (eq (aref target 0) ?\#)
- (cons 'anchor-ref (cons nil (substring target 1)))
- (cons 'link-and-anchor
- ;; match-data is changed by
- ;; `muse-publish-link-page' or descendants.
- (cons (save-match-data
- (muse-publish-link-page
- (substring target 0 (match-beginning 0))))
- (substring target (match-end 0))))))
- (t
- (cons 'link (cons (muse-publish-link-page target) nil))))))
-
-(defun muse-publish-url-desc (desc explicit)
- (when desc
- (dolist (transform muse-publish-desc-transforms)
- (setq desc (save-match-data
- (when desc (funcall transform desc explicit)))))
- (setq desc (muse-link-unescape desc))
- (muse-publish-escape-specials-in-string desc 'url-desc)))
-
-(defun muse-publish-url (url &optional desc orig-url explicit)
- "Resolve a URL into its final <a href> form."
- (let ((unesc-url url)
- (unesc-orig-url orig-url)
- (unesc-desc desc)
- type anchor)
- ;; Transform URL
- (dolist (transform muse-publish-url-transforms)
- (setq url (save-match-data (when url (funcall transform url explicit)))))
- ;; Classify URL
- (let ((target (muse-publish-classify-url url)))
- (setq type (car target)
- url (if (eq type 'image)
- (muse-publish-escape-specials-in-string (cadr target)
- 'image)
- (muse-publish-escape-specials-in-string (cadr target) 'url))
- anchor (muse-publish-escape-specials-in-string
- (cddr target) 'url)))
- ;; Transform description
- (if desc
- (setq desc (muse-publish-url-desc desc explicit))
- (when orig-url
- (setq orig-url (muse-publish-url-desc orig-url explicit))))
- ;; Act on URL classification
- (cond ((eq type 'anchor-ref)
- (muse-markup-text 'anchor-ref anchor (or desc orig-url)))
- ((and unesc-desc (string-match muse-image-regexp unesc-desc))
- (let ((ext (or (file-name-extension desc) "")))
- (setq desc (muse-publish-escape-specials-in-string unesc-desc
- 'image))
- (setq desc (muse-path-sans-extension desc))
- (muse-markup-text 'image-link url desc ext)))
- ((string= url "")
- desc)
- ((eq type 'image)
- (let ((ext (or (file-name-extension url) "")))
- (setq url (muse-path-sans-extension url))
- (if desc
- (muse-markup-text 'image-with-desc url ext desc)
- (muse-markup-text 'image url ext))))
- ((eq type 'link-and-anchor)
- (muse-markup-text 'link-and-anchor url anchor
- (or desc orig-url)
- (muse-path-sans-extension url)))
- ((eq type 'link)
- (muse-markup-text 'link url (or desc orig-url)))
- (t
- (or (and (or desc
- ;; compare the not-escaped versions of url and
- ;; orig-url
- (not (string= unesc-url unesc-orig-url)))
- (let ((text (muse-markup-text 'url-and-desc url
- (or desc orig-url))))
- (and (not (string= text ""))
- text)))
- (muse-markup-text 'url url (or desc orig-url)))))))
-
-(defun muse-publish-insert-url (url &optional desc orig-url explicit)
- "Resolve a URL into its final <a href> form."
- (delete-region (match-beginning 0) (match-end 0))
- (let ((text (muse-publish-url url desc orig-url explicit)))
- (when text
- (muse-insert-markup text))))
-
-(defun muse-publish-markup-link ()
- (let (desc explicit orig-link link)
- (setq explicit (save-match-data
- (if (string-match muse-explicit-link-regexp
- (match-string 0))
- t nil)))
- (setq orig-link (if explicit (match-string 1) (match-string 0)))
- (setq desc (when explicit (match-string 2)))
- (setq link (if explicit
- (muse-handle-explicit-link orig-link)
- (muse-handle-implicit-link orig-link)))
- (when (and link
- (or explicit
- (not (or (eq (char-before (match-beginning 0)) ?\")
- (eq (char-after (match-end 0)) ?\")))))
- ;; if explicit link has no user-provided description, treat it
- ;; as if it were an implicit link
- (when (and explicit (not desc))
- (setq explicit nil))
- (muse-publish-insert-url link desc orig-link explicit))))
-
-(defun muse-publish-markup-url ()
- (unless (or (eq (char-before (match-beginning 0)) ?\")
- (eq (char-after (match-end 0)) ?\"))
- (let ((url (match-string 0)))
- (muse-publish-insert-url url nil url))))
-
-;; Default publishing tags
-
-(defcustom muse-publish-contents-depth 2
- "The number of heading levels to include with <contents> tags."
- :type 'integer
- :group 'muse-publish)
-
-(defun muse-publish-contents-tag (beg end attrs)
- (set (make-local-variable 'muse-publish-generate-contents)
- (cons (copy-marker (point) t)
- (let ((depth (cdr (assoc "depth" attrs))))
- (or (and depth (string-to-number depth))
- muse-publish-contents-depth)))))
-
-(defun muse-publish-verse-tag (beg end)
- (muse-publish-ensure-block beg end)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (delete-char 1)
- (while (< (point) (point-max))
- (insert "> ")
- (forward-line))
- (if (eq ?\ (char-syntax (char-before)))
- (delete-char -1)))))
-
-(defun muse-publish-mark-read-only (beg end)
- "Add read-only properties to the given region."
- (add-text-properties beg end '(rear-nonsticky (read-only) read-only t))
- nil)
-
-(defun muse-publish-mark-link (&optional beg end)
- "Indicate that the given region is a Muse link, so that other
-markup elements respect it. If a region is not specified, use
-the 0th match data to determine it.
-
-This is usually applied to explicit links."
- (unless beg (setq beg (match-beginning 0)))
- (unless end (setq end (match-end 0)))
- (add-text-properties beg end '(muse-link t))
- nil)
-
-(defun muse-publish-quote-tag (beg end)
- (muse-publish-ensure-block beg)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (let ((quote-regexp "^\\(<\\(/?\\)quote>\\)"))
- (muse-insert-markup (muse-markup-text 'begin-quote))
- (while (progn
- (unless (looking-at (concat "[" muse-regexp-blank "\n]*"
- "<quote>"))
- (muse-publish-surround-text
- (muse-markup-text 'begin-quote-item)
- (muse-markup-text 'end-quote-item)
- (function
- (lambda (indent)
- (muse-forward-paragraph)
- (goto-char (match-end 0))
- (and (< (point) (point-max))
- (not (looking-at quote-regexp)))))
- nil nil nil
- quote-regexp))
- (if (>= (point) (point-max))
- t
- (and (search-forward "<quote>" nil t)
- (muse-goto-tag-end "quote" t)
- (progn (forward-line 1) t)
- (< (point) (point-max))))))
- (goto-char (point-max))
- (muse-insert-markup (muse-markup-text 'end-quote))))))
-
-(defun muse-publish-code-tag (beg end)
- (muse-publish-escape-specials beg end nil 'literal)
- (goto-char beg)
- (insert (muse-markup-text 'begin-literal))
- (goto-char end)
- (insert (muse-markup-text 'end-literal))
- (muse-publish-mark-read-only beg (point)))
-
-(defun muse-publish-cite-tag (beg end attrs)
- (let* ((type (muse-publish-get-and-delete-attr "type" attrs))
- (citetag (cond ((string-equal type "author")
- 'begin-cite-author)
- ((string-equal type "year")
- 'begin-cite-year)
- (t
- 'begin-cite))))
- (goto-char beg)
- (insert (muse-markup-text citetag (muse-publishing-directive "bibsource")))
- (goto-char end)
- (insert (muse-markup-text 'end-cite))
- (muse-publish-mark-read-only beg (point))))
-
-(defun muse-publish-src-tag (beg end attrs)
- (muse-publish-example-tag beg end))
-
-(defun muse-publish-example-tag (beg end)
- (muse-publish-ensure-block beg end)
- (muse-publish-escape-specials beg end nil 'example)
- (goto-char beg)
- (insert (muse-markup-text 'begin-example))
- (goto-char end)
- (insert (muse-markup-text 'end-example))
- (muse-publish-mark-read-only beg (point)))
-
-(defun muse-publish-literal-tag (beg end attrs)
- "Ensure that the text between BEG and END is not interpreted later on.
-
-ATTRS is an alist of attributes.
-
-If it contains a \"style\" element, delete the region if the
-current style is neither derived from nor equal to this style.
-
-If it contains both a \"style\" element and an \"exact\" element
-with the value \"t\", delete the region only if the current style
-is exactly this style."
- (let* ((style (cdr (assoc "style" attrs)))
- (exact (cdr (assoc "exact" attrs)))
- (exactp (and (stringp exact) (string= exact "t"))))
- (if (or (not style)
- (and exactp (equal (muse-style style)
- muse-publishing-current-style))
- (and (not exactp) (muse-style-derived-p style)))
- (muse-publish-mark-read-only beg end)
- (delete-region beg end)
- (when (and (bolp) (eolp) (not (eobp)))
- (delete-char 1)))))
-
-(put 'muse-publish-literal-tag 'muse-dangerous-tag t)
-
-(defun muse-publish-verbatim-tag (beg end)
- (muse-publish-escape-specials beg end nil 'verbatim)
- (muse-publish-mark-read-only beg end))
-
-(defun muse-publish-br-tag (beg end)
- "Insert a line break."
- (delete-region beg end)
- (muse-insert-markup (muse-markup-text 'line-break)))
-
-(defalias 'muse-publish-class-tag 'ignore)
-(defalias 'muse-publish-div-tag 'ignore)
-
-(defun muse-publish-call-tag-on-buffer (tag &optional attrs)
- "Transform the current buffer as if it were surrounded by the tag TAG.
-If attributes ATTRS are given, pass them to the tag function."
- (let ((tag-info (muse-markup-tag-info tag)))
- (when tag-info
- (let* ((end (progn (goto-char (point-max)) (point-marker)))
- (args (list (point-min) end))
- (muse-inhibit-style-tags nil))
- (when (nth 2 tag-info)
- (nconc args (list attrs)))
- (apply (nth 4 tag-info) args)
- (set-marker end nil)))))
-
-(defun muse-publish-examplify-buffer (&optional attrs)
- "Transform the current buffer as if it were an <example> region."
- (muse-publish-call-tag-on-buffer "example" attrs))
-
-(defun muse-publish-srcify-buffer (&optional attrs)
- "Transform the current buffer as if it were a <src> region."
- (muse-publish-call-tag-on-buffer "src" attrs))
-
-(defun muse-publish-versify-buffer (&optional attrs)
- "Transform the current buffer as if it were a <verse> region."
- (muse-publish-call-tag-on-buffer "verse" attrs)
- (muse-publish-markup ""
- `((100 ,(concat "^[" muse-regexp-blank "]*> ") 0
- muse-publish-markup-verse)))
- (goto-char (point-min)))
-
-(defmacro muse-publish-markup-attribute (beg end attrs reinterp &rest body)
- "Evaluate BODY within the bounds of BEG and END.
-ATTRS is an alist. Only the \"markup\" element of ATTRS is acted
-on.
-
-If it is omitted, publish the region with the normal Muse rules.
-If RE-INTERP is specified, this is done immediately in a new
-publishing process. Currently, RE-INTERP is specified only by
-the <include> tag.
-
-If \"nil\", do not mark up the region at all, but prevent it from
-being further interpreted by Muse.
-
-If \"example\", treat the region as if it was surrounded by the
-<example> tag.
-
-If \"src\", treat the region as if it was surrounded by the
-<src> tag.
-
-If \"verse\", treat the region as if it was surrounded by the
-<verse> tag, to preserve newlines.
-
-Otherwise, it should be the name of a function to call in the
-narrowed region after evaluating BODY. The function should
-take the ATTRS parameter.
-
-BEG is modified to be the start of the published markup."
- (let ((attrs-sym (make-symbol "attrs"))
- (markup (make-symbol "markup"))
- (markup-function (make-symbol "markup-function")))
- `(let* ((,attrs-sym ,attrs)
- (,markup (muse-publish-get-and-delete-attr "markup" ,attrs-sym)))
- (save-restriction
- (narrow-to-region ,beg ,end)
- (goto-char (point-min))
- ,@body
- (if (not ,markup)
- (when ,reinterp
- (muse-publish-markup-region (point-min) (point-max))
- (muse-publish-mark-read-only (point-min) (point-max))
- (goto-char (point-max)))
- (let ((,markup-function (read ,markup)))
- (cond ((eq ,markup-function 'example)
- (setq ,markup-function #'muse-publish-examplify-buffer))
- ((eq ,markup-function 'src)
- (setq ,markup-function #'muse-publish-srcify-buffer))
- ((eq ,markup-function 'verse)
- (setq ,markup-function #'muse-publish-versify-buffer))
- ((and ,markup-function (not (functionp ,markup-function)))
- (error "Invalid markup function `%s'" ,markup))
- (t nil))
- (if ,markup-function
- (funcall ,markup-function ,attrs-sym)
- (muse-publish-mark-read-only (point-min) (point-max))
- (goto-char (point-max)))))))))
-
-(put 'muse-publish-markup-attribute 'lisp-indent-function 4)
-(put 'muse-publish-markup-attribute 'edebug-form-spec
- '(sexp sexp sexp sexp body))
-
-(defun muse-publish-lisp-tag (beg end attrs)
- (muse-publish-markup-attribute beg end attrs nil
- (save-excursion
- (save-restriction
- (let ((str (muse-eval-lisp
- (prog1
- (concat "(progn "
- (buffer-substring-no-properties (point-min)
- (point-max))
- ")")
- (delete-region (point-min) (point-max))
- (widen)))))
- (set-text-properties 0 (length str) nil str)
- (insert str))))))
-
-(put 'muse-publish-lisp-tag 'muse-dangerous-tag t)
-
-(defun muse-publish-command-tag (beg end attrs)
- (muse-publish-markup-attribute beg end attrs nil
- (while (looking-at "\\s-*$")
- (forward-line))
- (let ((interp (muse-publish-get-and-delete-attr "interp" attrs)))
- (if interp
- (shell-command-on-region (point) (point-max) interp t t)
- (shell-command
- (prog1
- (buffer-substring-no-properties (point) (point-max))
- (delete-region (point-min) (point-max)))
- t)))
- ;; make sure there is a newline at end
- (goto-char (point-max))
- (forward-line 0)
- (unless (looking-at "\\s-*$")
- (goto-char (point-max))
- (insert ?\n))
- (goto-char (point-min))))
-
-(put 'muse-publish-command-tag 'muse-dangerous-tag t)
-
-(defun muse-publish-perl-tag (beg end attrs)
- (muse-publish-command-tag beg end
- (cons (cons "interp" (executable-find "perl"))
- attrs)))
-
-(put 'muse-publish-perl-tag 'muse-dangerous-tag t)
-
-(defun muse-publish-php-tag (beg end attrs)
- (muse-publish-command-tag beg end
- (cons (cons "interp" (executable-find "php"))
- attrs)))
-
-(put 'muse-publish-php-tag 'muse-dangerous-tag t)
-
-(defun muse-publish-python-tag (beg end attrs)
- (muse-publish-command-tag beg end
- (cons (cons "interp" (executable-find "python"))
- attrs)))
-
-(put 'muse-publish-python-tag 'muse-dangerous-tag t)
-
-(defun muse-publish-ruby-tag (beg end attrs)
- (muse-publish-command-tag beg end
- (cons (cons "interp" (executable-find "ruby"))
- attrs)))
-
-(put 'muse-publish-ruby-tag 'muse-dangerous-tag t)
-
-(defun muse-publish-comment-tag (beg end)
- (if (null muse-publish-comments-p)
- (delete-region beg end)
- (goto-char end)
- (muse-insert-markup (muse-markup-text 'comment-end))
- (muse-publish-mark-read-only beg end)
- (goto-char beg)
- (muse-insert-markup (muse-markup-text 'comment-begin))))
-
-(defun muse-publish-include-tag (beg end attrs)
- "Include the named file at the current location during publishing.
-
-<include file=\"...\" markup=\"...\">
-
-The `markup' attribute controls how this file is marked up after
-being inserted. See `muse-publish-markup-attribute' for an
-explanation of how it works."
- (let ((filename (muse-publish-get-and-delete-attr "file" attrs))
- (muse-publishing-directives (copy-alist muse-publishing-directives)))
- (if filename
- (setq filename (expand-file-name
- filename
- (file-name-directory muse-publishing-current-file)))
- (error "No file attribute specified in <include> tag"))
- (muse-publish-markup-attribute beg end attrs t
- (muse-insert-file-contents filename))))
-
-(put 'muse-publish-include-tag 'muse-dangerous-tag t)
-
-(defun muse-publish-mark-up-tag (beg end attrs)
- "Run an Emacs Lisp function on the region delimted by this tag.
-
-<markup function=\"...\" style=\"...\" exact=\"...\">
-
-The optional \"function\" attribute controls how this section is
-marked up. If used, it should be the name of a function to call
-with the buffer narrowed to the delimited region. Note that no
-further marking-up will be performed on this region.
-
-If \"function\" is omitted, use the standard Muse markup function.
-This is useful for marking up content in headers and footers.
-
-The optional \"style\" attribute causes the region to be deleted
-if the current style is neither derived from nor equal to this
-style.
-
-If both a \"style\" attribute and an \"exact\" attribute are
-provided, and \"exact\" is \"t\", delete the region only if the
-current style is exactly this style."
- (let* ((style (cdr (assoc "style" attrs)))
- (exact (cdr (assoc "exact" attrs)))
- (exactp (and (stringp exact) (string= exact "t"))))
- (if (or (not style)
- (and exactp (equal (muse-style style)
- muse-publishing-current-style))
- (and (not exactp) (muse-style-derived-p style)))
- (let* ((function (cdr (assoc "function" attrs)))
- (muse-publish-use-header-footer-tags nil)
- (markup-function (and function (intern-soft function))))
- (if (and markup-function (functionp markup-function))
- (save-restriction
- (narrow-to-region beg end)
- (funcall markup-function)
- (goto-char (point-max)))
- (let ((muse-publish-inhibit-style-hooks t))
- (muse-publish-markup-region beg end)))
- (muse-publish-mark-read-only beg (point)))
- (delete-region beg end))))
-
-(put 'muse-publish-mark-up-tag 'muse-dangerous-tag t)
-
-;; Miscellaneous helper functions
-
-(defun muse-publish-strip-URL (string &rest ignored)
- "If the text \"URL:\" exists at the beginning of STRING, remove it.
-The text is removed regardless of whether and part of it is uppercase."
- (save-match-data
- (if (string-match "\\`[uU][rR][lL]:\\(.+\\)\\'" string)
- (match-string 1 string)
- string)))
-
-(defun muse-publish-markup-type (category default-func)
- (let ((rule (muse-find-markup-element :overrides category (muse-style))))
- (funcall (or rule default-func))))
-
-(defun muse-published-buffer-contents (buffer)
- (with-current-buffer buffer
- (goto-char (point-min))
- (let ((beg (and (search-forward "Emacs Muse begins here")
- (muse-line-end-position)))
- (end (and (search-forward "Emacs Muse ends here")
- (muse-line-beginning-position))))
- (buffer-substring-no-properties beg end))))
-
-(defun muse-published-contents (file)
- (when (file-readable-p file)
- (muse-with-temp-buffer
- (muse-insert-file-contents file)
- (muse-published-buffer-contents (current-buffer)))))
-
-(defun muse-publish-transform-output
- (file temp-file output-path name gen-func &rest cleanup-exts)
- "Transform the given TEMP-FILE into the OUTPUT-PATH, using GEN-FUNC."
- (setq file (muse-page-name file))
- (message "Generating %s output for %s..." name file)
- (if (not (funcall gen-func temp-file output-path))
- (message "Generating %s from %s...failed" name file)
- (message "Generating %s output for %s...done" name file)
- (muse-delete-file-if-exists temp-file)
- (dolist (ext cleanup-exts)
- (muse-delete-file-if-exists
- (expand-file-name (concat file ext)
- (file-name-directory output-path))))
- (message "Wrote %s" output-path)))
-
-(defun muse-publish-read-only (string)
- (let ((end (1- (length string))))
- (add-text-properties 0 end
- '(rear-nonsticky (read-only) read-only t)
- string)
- string))
-
-;;; muse-publish.el ends here
diff --git a/packages/muse/muse-regexps.el b/packages/muse/muse-regexps.el
deleted file mode 100644
index 900b0cd..0000000
--- a/packages/muse/muse-regexps.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-texinfo.el b/packages/muse/muse-texinfo.el
deleted file mode 100644
index 4ad0092..0000000
--- a/packages/muse/muse-texinfo.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-wiki.el b/packages/muse/muse-wiki.el
deleted file mode 100644
index e2cd3a2..0000000
--- a/packages/muse/muse-wiki.el
+++ /dev/null
@@ -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
diff --git a/packages/muse/muse-xml-common.el b/packages/muse/muse-xml-common.el
deleted file mode 100644
index 75869ca..0000000
--- a/packages/muse/muse-xml-common.el
+++ /dev/null
@@ -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
- '((?\" . """)
- (?\< . "<")
- (?\> . ">")
- (?\& . "&"))
- "A table of characters which must be represented specially."
- :type '(alist :key-type character :value-type string)
- :group 'muse-xml)
-
-(defcustom muse-xml-markup-specials-url-extra
- '((?\" . """)
- (?\< . "<")
- (?\> . ">")
- (?\& . "&")
- (?\ . "%20")
- (?\n . "%0D%0A"))
- "A table of characters which must be represented specially.
-These are extra characters that are escaped within URLs."
- :type '(alist :key-type character :value-type string)
- :group 'muse-xml)
-
-(defun muse-xml-decide-specials (context)
- "Determine the specials to escape, depending on CONTEXT."
- (cond ((memq context '(email url image))
- 'muse-xml-escape-url)
- ((eq context 'url-extra)
- muse-xml-markup-specials-url-extra)
- (t muse-xml-markup-specials)))
-
-(defun muse-xml-escape-url (str)
- "Convert to character entities any non-alphanumeric characters
-outside a few punctuation symbols, that risk being misinterpreted
-if not escaped."
- (when str
- (setq str (muse-publish-escape-specials-in-string str 'url-extra))
- (let (pos code len ch)
- (save-match-data
- (while (setq pos (string-match (concat "[^-"
- muse-regexp-alnum
- "/:._=@\\?~#%\"\\+<>()&;]")
- str pos))
- (setq ch (aref str pos)
- code (concat "&#" (int-to-string
- (cond ((fboundp 'char-to-ucs)
- (char-to-ucs ch))
- ((fboundp 'char-to-int)
- (char-to-int ch))
- (t ch)))
- ";")
- len (length code)
- str (concat (substring str 0 pos)
- code
- (when (< pos (length str))
- (substring str (1+ pos) nil)))
- pos (+ len pos)))
- str))))
-
-(defun muse-xml-markup-anchor ()
- (unless (get-text-property (match-end 1) 'muse-link)
- (let ((text (muse-markup-text 'anchor (match-string 2))))
- (save-match-data
- (skip-chars-forward (concat muse-regexp-blank "\n"))
- (when (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>"))
- (goto-char (match-end 0)))
- (muse-insert-markup text)))
- (match-string 1)))
-
-(defun muse-xml-sort-table (table)
- "Sort the given table structure so that it validates properly."
- ;; Note that the decision matrix must have a nil diagonal, or else
- ;; elements with the same type will be reversed with respect to each
- ;; other.
- (let ((decisions '((nil nil nil) ; body < header, body < footer
- (t nil t) ; header stays where it is
- (t nil nil)))) ; footer < header
- (sort table #'(lambda (l r)
- (and (integerp (car l)) (integerp (car r))
- (nth (1- (car r))
- (nth (1- (car l)) decisions)))))))
-
-(defun muse-xml-markup-table (&optional attributes)
- "Publish the matched region into a table.
-If a string ATTRIBUTES is given, pass it to the markup string begin-table."
- (let* ((table-info (muse-publish-table-fields (match-beginning 0)
- (match-end 0)))
- (row-len (car table-info))
- (supports-group (not (string= (muse-markup-text 'begin-table-group
- row-len)
- "")))
- (field-list (muse-xml-sort-table (cdr table-info)))
- last-part)
- (when table-info
- (let ((beg (point)))
- (muse-publish-ensure-block beg))
- (muse-insert-markup (muse-markup-text 'begin-table (or attributes "")))
- (muse-insert-markup (muse-markup-text 'begin-table-group row-len))
- (dolist (fields field-list)
- (let* ((type (car fields))
- (part (cond ((eq type 'hline) nil)
- ((= type 1) "tbody")
- ((= type 2) "thead")
- ((= type 3) "tfoot")))
- (col (cond ((eq type 'hline) nil)
- ((= type 1) "td")
- ((= type 2) "th")
- ((= type 3) "td"))))
- (setq fields (cdr fields))
- (unless (and part last-part (string= part last-part))
- (when last-part
- (muse-insert-markup " </" last-part ">\n")
- (when (eq type 'hline)
- ;; horizontal separators are represented by closing
- ;; the current table group and opening a new one
- (muse-insert-markup (muse-markup-text 'end-table-group))
- (muse-insert-markup (muse-markup-text 'begin-table-group
- row-len))))
- (when part
- (muse-insert-markup " <" part ">\n"))
- (setq last-part part))
- (unless (eq type 'hline)
- (muse-insert-markup (muse-markup-text 'begin-table-row))
- (dolist (field fields)
- (muse-insert-markup (muse-markup-text 'begin-table-entry col))
- (insert field)
- (muse-insert-markup (muse-markup-text 'end-table-entry col)))
- (muse-insert-markup (muse-markup-text 'end-table-row)))))
- (when last-part
- (muse-insert-markup " </" last-part ">\n"))
- (muse-insert-markup (muse-markup-text 'end-table-group))
- (muse-insert-markup (muse-markup-text 'end-table))
- (insert ?\n))))
-
-(defun muse-xml-prepare-buffer ()
- (set (make-local-variable 'muse-publish-url-transforms)
- (cons 'muse-xml-escape-string muse-publish-url-transforms)))
-
-(provide 'muse-xml-common)
-
-;;; muse-xml-common.el ends here
diff --git a/packages/muse/muse-xml.el b/packages/muse/muse-xml.el
deleted file mode 100644
index 9f26ade..0000000
--- a/packages/muse/muse-xml.el
+++ /dev/null
@@ -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 . " ")
- (line-break . "<br>")
- (enddots . "....")
- (dots . "...")
- (section . "<section level=\"1\"><title>")
- (section-end . "</title>")
- (subsection . "<section level=\"2\"><title>")
- (subsection-end . "</title>")
- (subsubsection . "<section level=\"3\"><title>")
- (subsubsection-end . "</title>")
- (section-other . "<section level=\"%s\"><title>")
- (section-other-end . "</title>")
- (section-close . "</section>")
- (footnote . "<footnote>")
- (footnote-end . "</footnote>")
- (begin-underline . "<format type=\"underline\">")
- (end-underline . "</format>")
- (begin-literal . "<code>")
- (end-literal . "</code>")
- (begin-emph . "<format type=\"emphasis\" level=\"1\">")
- (end-emph . "</format>")
- (begin-more-emph . "<format type=\"emphasis\" level=\"2\">")
- (end-more-emph . "</format>")
- (begin-most-emph . "<format type=\"emphasis\" level=\"3\">")
- (end-most-emph . "</format>")
- (begin-verse . "<verse>\n")
- (begin-verse-line . "<line>")
- (end-verse-line . "</line>")
- (empty-verse-line . "<line />")
- (begin-last-stanza-line . "<line>")
- (end-last-stanza-line . "</line>")
- (end-verse . "</verse>")
- (begin-example . "<example>")
- (end-example . "</example>")
- (begin-center . "<p><format type=\"center\">\n")
- (end-center . "\n</format></p>")
- (begin-quote . "<blockquote>\n")
- (end-quote . "\n</blockquote>")
- (begin-cite . "<cite>")
- (begin-cite-author . "<cite type=\"author\">")
- (begin-cite-year . "<cite type=\"year\">")
- (end-cite . "</cite>")
- (begin-quote-item . "<p>")
- (end-quote-item . "</p>")
- (begin-uli . "<list type=\"unordered\">\n")
- (end-uli . "\n</list>")
- (begin-uli-item . "<item>")
- (end-uli-item . "</item>")
- (begin-oli . "<list type=\"ordered\">\n")
- (end-oli . "\n</list>")
- (begin-oli-item . "<item>")
- (end-oli-item . "</item>")
- (begin-dl . "<list type=\"definition\">\n")
- (end-dl . "\n</list>")
- (begin-dl-item . "<item>\n")
- (end-dl-item . "\n</item>")
- (begin-ddt . "<term>")
- (end-ddt . "</term>")
- (begin-dde . "<definition>")
- (end-dde . "</definition>")
- (begin-table . "<table%s>\n")
- (end-table . "</table>")
- (begin-table-row . " <tr>\n")
- (end-table-row . " </tr>\n")
- (begin-table-entry . " <%s>")
- (end-table-entry . "</%s>\n"))
- "Strings used for marking up text.
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles."
- :type '(alist :key-type symbol :value-type string)
- :group 'muse-xml)
-
-(defcustom muse-xml-encoding-default 'utf-8
- "The default Emacs buffer encoding to use in published files.
-This will be used if no special characters are found."
- :type 'symbol
- :group 'muse-xml)
-
-(defcustom muse-xml-charset-default "utf-8"
- "The default XML charset to use if no translation is
-found in `muse-xml-encoding-map'."
- :type 'string
- :group 'muse-xml)
-
-(defun muse-xml-encoding ()
- (muse-xml-transform-content-type
- (or (and (boundp 'buffer-file-coding-system)
- buffer-file-coding-system)
- muse-xml-encoding-default)
- muse-xml-charset-default))
-
-(defun muse-xml-markup-paragraph ()
- (let ((end (copy-marker (match-end 0) t)))
- (goto-char (match-beginning 0))
- (when (save-excursion
- (save-match-data
- (and (not (get-text-property (max (point-min) (1- (point)))
- 'muse-no-paragraph))
- (re-search-backward "<\\(/?\\)p[ >]" nil t)
- (not (string-equal (match-string 1) "/")))))
- (when (get-text-property (1- (point)) 'muse-end-list)
- (goto-char (previous-single-property-change (1- (point))
- 'muse-end-list)))
- (muse-insert-markup "</p>"))
- (goto-char end))
- (cond
- ((eobp)
- (unless (bolp)
- (insert "\n")))
- ((get-text-property (point) 'muse-no-paragraph)
- (forward-char 1)
- nil)
- ((eq (char-after) ?\<)
- (when (looking-at (concat "<\\(format\\|code\\|link\\|image"
- "\\|anchor\\|footnote\\)[ >]"))
- (muse-insert-markup "<p>")))
- (t
- (muse-insert-markup "<p>"))))
-
-(defun muse-xml-finalize-buffer ()
- (when (boundp 'buffer-file-coding-system)
- (when (memq buffer-file-coding-system '(no-conversion undecided-unix))
- ;; make it agree with the default charset
- (setq buffer-file-coding-system muse-xml-encoding-default))))
-
-;;; Register the Muse XML Publisher
-
-(muse-define-style "xml"
- :suffix 'muse-xml-extension
- :regexps 'muse-xml-markup-regexps
- :functions 'muse-xml-markup-functions
- :strings 'muse-xml-markup-strings
- :specials 'muse-xml-decide-specials
- :after 'muse-xml-finalize-buffer
- :header 'muse-xml-header
- :footer 'muse-xml-footer
- :browser 'find-file)
-
-(provide 'muse-xml)
-
-;;; muse-xml.el ends here
diff --git a/packages/muse/muse.el b/packages/muse/muse.el
deleted file mode 100644
index ec02427..0000000
--- a/packages/muse/muse.el
+++ /dev/null
@@ -1,881 +0,0 @@
-;;; muse.el --- 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.2
-;; 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, (muse-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
diff --git a/packages/muse/muse.info b/packages/muse/muse.info
deleted file mode 100644
index 86fdb8e..0000000
--- a/packages/muse/muse.info
+++ /dev/null
@@ -1,4656 +0,0 @@
-This is muse.info, produced by makeinfo version 4.13 from muse.texi.
-
-INFO-DIR-SECTION Emacs
-START-INFO-DIR-ENTRY
-* Muse: (muse). Authoring and publishing environment for Emacs.
-END-INFO-DIR-ENTRY
-
- This manual is for Emacs Muse version 3.20.
-
- Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free
-Software Foundation, Inc.
-
- Permission is granted to copy, distribute and/or modify this
- document under the terms of the GNU Free Documentation License,
- Version 1.2 or any later version published by the Free Software
- Foundation; with no Invariant Sections, with the Front-Cover texts
- being "A GNU Manual", and with the Back-Cover Texts as in (a)
- below. A copy of the license is included in the section entitled
- "GNU Free Documentation License" in this manual.
-
- (a) The FSF's Back-Cover Text is: "You have freedom to copy and
- modify this GNU Manual, like GNU software. Copies published by
- the Free Software Foundation raise funds for GNU development."
-
- This document is part of a collection distributed under the GNU
- Free Documentation License. If you want to distribute this
- document separately from the collection, you can do so by adding a
- copy of the license to the document, as described in section 6 of
- the license.
-
- All Emacs Lisp code contained in this document may be used,
- distributed, and modified without restriction.
-
-
-File: muse.info, Node: Top, Next: Preface, Prev: (dir), Up: (dir)
-
-Muse
-****
-
-This manual is for Emacs Muse version 3.20.
-
- Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free
-Software Foundation, Inc.
-
- Permission is granted to copy, distribute and/or modify this
- document under the terms of the GNU Free Documentation License,
- Version 1.2 or any later version published by the Free Software
- Foundation; with no Invariant Sections, with the Front-Cover texts
- being "A GNU Manual", and with the Back-Cover Texts as in (a)
- below. A copy of the license is included in the section entitled
- "GNU Free Documentation License" in this manual.
-
- (a) The FSF's Back-Cover Text is: "You have freedom to copy and
- modify this GNU Manual, like GNU software. Copies published by
- the Free Software Foundation raise funds for GNU development."
-
- This document is part of a collection distributed under the GNU
- Free Documentation License. If you want to distribute this
- document separately from the collection, you can do so by adding a
- copy of the license to the document, as described in section 6 of
- the license.
-
- All Emacs Lisp code contained in this document may be used,
- distributed, and modified without restriction.
-
-* Menu:
-
-* Preface:: About the documentation.
-* Introduction:: What is Muse?
-* Obtaining Muse:: How to get Muse releases and development
- changes.
-* Installation:: Compiling and installing Muse.
-* Getting Started:: Setting up Muse and editing files.
-* Projects:: Creating and managing Muse projects.
-* Keystroke Summary:: Keys used in Muse mode.
-* Markup Rules:: Rules for using markup.
-* Publishing Styles:: Publishing various types of documents.
-* Extending Muse:: Making your own publishing styles.
-* Miscellaneous:: Miscellaneous add-ons, like a minor mode.
-* Getting Help and Reporting Bugs::
-* History:: History of this document.
-* Contributors:: Contributors to this documentation.
-* GNU Free Documentation License:: The license for this documentation.
-* Concept Index:: Search for terms.
-
- --- The Detailed Node Listing ---
-
-How to Get Muse Releases and Development Changes
-
-* Releases:: Released versions of Muse.
-* Development:: Latest unreleased development changes.
-
-Getting Started
-
-* Loading Muse:: How to load Muse.
-* Using Muse Mode:: How to edit files in Muse.
-* Publishing Files Overview:: Publishing a single file or project.
-* File Extensions:: Using a different file extension.
-
-Creating and Managing Muse Projects
-
-* Single Project:: A single-project example.
-* Multiple Projects:: A multiple-project example.
-* Projects and Subdirectories:: Publishing subdirectories in projects.
-* Options for Projects:: Listing of available options for projects.
-
-Rules for Using Markup
-
-* Paragraphs:: Paragraphs: centering and quoting.
-* Headings:: Levels of headings.
-* Directives:: Directives at the beginning of a
- document.
-* Emphasizing Text:: Bold, italicized, and underlined text.
-* Footnotes:: Making notes to be shown at the end.
-* Verse:: Indicating poetic stanzas.
-* Lists:: Lists of items.
-* Tables:: Generation of data tables.
-* Explicit Links:: Hyperlinks and email addresses with
- descriptions.
-* Implicit Links:: Bare URLs, WikiNames, and InterWiki
- links.
-* Images:: Publishing and displaying images.
-* Horizontal Rules and Anchors:: Inserting a horizontal line or anchor.
-* Embedded Lisp:: Evaluating Emacs Lisp code in documents
- for extensibility.
-* Citations:: Support for citing other resources.
-* Comments:: Lines to omit from published output.
-* Tag Summary:: Tags that Muse recognizes.
-
-Publishing Various Types of Documents
-
-* Blosxom:: Integrating Muse and pyblosxom.cgi.
-* Book:: Publishing entries into a compilation.
-* ConTeXt:: Publishing ConTeXt documents.
-* DocBook:: Publishing in DocBook XML form.
-* HTML:: Publishing in HTML or XHTML form.
-* Ikiwiki:: Integrating with ikiwiki.
-* Journal:: Keeping a journal or blog.
-* LaTeX:: Publishing LaTeX documents.
-* Poem:: Publish a poem to LaTeX or PDF.
-* Texinfo:: Publish entries to Texinfo format or PDF.
-* XML:: Publish entries to XML.
-
-Integrating Muse and pyblosxom.cgi
-
-* Blosxom Requirements:: Other tools needed for the Blosxom style.
-* Blosxom Entries:: Format of a Blosxom entry and automation.
-* Blosxom Options:: Blosxom styles and options provided.
-
-Making your own publishing styles
-
-* Markup Functions:: Specifying functions to mark up text.
-* Markup Regexps:: Markup rules for publishing.
-* Markup Strings:: Strings specific to a publishing style.
-* Markup Tags:: Tag specifications for special markup.
-* Style Elements:: Parameters used for defining styles.
-* Deriving Styles:: Deriving a new style from an existing
- one.
-
-Miscellaneous add-ons, like a minor mode
-
-* Muse List Edit Minor Mode:: Edit lists easily in other major modes.
-
-
-File: muse.info, Node: Preface, Next: Introduction, Prev: Top, Up: Top
-
-1 About the documentation
-*************************
-
-This document describes Muse, which was written by John Wiegley and is
-now maintained by Michael Olson. Several versions of this manual are
-available on-line.
-
- * PDF: http://mwolson.org/static/doc/muse.pdf
-
- * HTML (single file): http://mwolson.org/static/doc/muse.html
-
- * HTML (multiple files): http://mwolson.org/static/doc/muse/
-
-
-File: muse.info, Node: Introduction, Next: Obtaining Muse, Prev: Preface,
Up: Top
-
-2 What is Muse?
-***************
-
-Emacs Muse (also known as "Muse" or "Emacs-Muse") is an authoring and
-publishing environment for Emacs. It simplifies the process of writing
-documents and publishing them to various output formats.
-
- Muse consists of two main parts: an enhanced text-mode for authoring
-documents and navigating within Muse projects, and a set of publishing
-styles for generating different kinds of output.
-
- What makes Muse distinct from other text-publishing systems is a
-modular environment, with a rather simple core, in which "styles" are
-derived from to create new styles. Much of Muse's overall
-functionality is optional. For example, you can use the publisher
-without the major-mode, or the mode without doing any publishing; or if
-you don't load the Texinfo or LaTeX modules, those styles won't be
-available.
-
- The Muse codebase is a departure from emacs-wiki.el version 2.44. The
-code has been restructured and rewritten, especially its publishing
-functions. The focus in this revision is on the authoring and
-publishing aspects, and the "wikiness" has been removed as a default
-behavior (available in the optional `muse-wiki' module). CamelCase
-words are no longer special by default.
-
- One of the principal aims in the development of Muse is to make it
-very easy to produce good-looking, standards-compliant documents.
-
-
-File: muse.info, Node: Obtaining Muse, Next: Installation, Prev:
Introduction, Up: Top
-
-3 How to Get Muse Releases and Development Changes
-**************************************************
-
-* Menu:
-
-* Releases:: Released versions of Muse.
-* Development:: Latest unreleased development changes.
-
-
-File: muse.info, Node: Releases, Next: Development, Prev: Obtaining Muse,
Up: Obtaining Muse
-
-3.1 Released versions of Muse
-=============================
-
-Choose to install a release if you want to minimize risk.
-
- Errors are corrected in development first. User-visible changes
-will be announced on the <muse-el-discuss@gna.org> mailing list. *Note
-Getting Help and Reporting Bugs::.
-
- Debian users can get Muse via apt-get. The `muse-el' package is
-available both at Michael Olson's APT repository and the official Debian
-repository. To make use of the former, add the following line to your
-`/etc/apt/sources.list' file and run `apt-get install muse'.
-
- deb http://mwolson.org/debian/ ./
-
- Ubuntu users can also get Muse via apt-get. The `muse-el' package
-is available both at Michael Olson's APT repository and the official
-Ubuntu repository. To make use of the former, add the following line to
-your `/etc/apt/sources.list' file and run `apt-get install muse'.
-
- deb http://mwolson.org/ubuntu/ ./
-
- The reason for making separate Debian and Ubuntu packages is that
-this manual is under the GFDL, and Debian will not allow it to be
-distributed in its main repository. Ubuntu, on the other hand, permits
-this manual to be included with the `muse-el' package.
-
- Alternatively, you can download the latest release from
-`http://download.gna.org/muse-el/' .
-
-
-File: muse.info, Node: Development, Prev: Releases, Up: Obtaining Muse
-
-3.2 Latest unreleased development changes
-=========================================
-
-Choose the development version if you want to live on the bleeding edge
-of Muse development or try out new features before release.
-
- The git version control system allows you to keep up-to-date with the
-latest changes to the development version of Muse. It also allows you
-to contribute changes (via commits, if you are have developer access to
-the repository, or via patches, otherwise). If you would like to
-contribute to Muse development, it is highly recommended that you use
-git.
-
- If you are new to git, you might find this tutorial helpful:
-`http://www.kernel.org/pub/software/scm/git/docs/tutorial.html'.
-
- Downloading the Muse module with git and staying up-to-date involves
-the following steps.
-
- 1. Install git.
-
- * Debian and Ubuntu: `apt-get install git-core'.
-
- * Windows: `http://git.or.cz/gitwiki/WindowsInstall'.
-
- * Other operating systems: download, compile, and install the
- source from `http://www.kernel.org/pub/software/scm/git/', or
- find a git package for your operating system.
-
- 2. Download the Muse development branch.
-
- If you have developer access to Muse, do:
-
- git clone ssh://repo.or.cz/srv/git/muse-el.git muse
-
- otherwise, do:
-
- git clone git://repo.or.cz/muse-el.git muse
-
- If you are behind a restrictive firewall, and do not have developer
- access, then do the following instead:
-
- git clone http://repo.or.cz/r/muse-el.git muse
-
- 3. List upstream changes that are missing from your local copy. Do
- this whenever you want to see whether new changes have been
- committed to Muse. If you wish, you may skip this step and
- proceed directly to the "update" step.
-
- # Change to the source directory you are interested in.
- cd muse
-
- # Fetch new changes from the repository, but don't apply them yet
- git fetch origin
-
- # Display log messages for the new changes
- git log HEAD..origin
-
- "origin" is git's name for the location where you originally got
- Muse from. You can change this location at any time by editing the
- `.git/config' file in the directory where the Muse source was
- placed.
-
- 4. Update to the latest version by pulling in any missing changes.
-
- cd muse
- git pull origin
-
- git will show how many files changed, and will provide a visual
- display for how many lines were changed in each file.
-
-
- There are other ways to interact with the Muse repository.
-
- * Browse git repo: `http://repo.or.cz/w/muse-el.git'
-
- * Latest development snapshot:
- `http://mwolson.org/static/dist/muse-latest.tar.gz'
-
- * Latest development snapshot (zip file):
- `http://mwolson.org/static/dist/muse-latest.zip'
-
- The latest development snapshot can lag behind the git repo by as
-much as 20 minutes, but never more than that.
-
-Becoming a Muse developer
--------------------------
-
-If you want commit access to the shared Muse repository, then register
-an account at `http://repo.or.cz' (be sure to add an SSH key), and
-contact the current maintainer at <mwolson@gnu.org>. It would be best
-to send some patches to the <muse-el-discuss@gna.org> mailing list
-first, so that he knows that you know what you are doing. *Note
-Getting Help and Reporting Bugs::, for instructions on subscribing to
-the mailing list.
-
- You must also be willing to sign a copyright assignment for your
-changes to Muse, since Muse is a GNU project. The current maintainer
-will assist you in this process if you contact him.
-
- For information on committing changes to Muse and performing
-development, please consult
-`http://emacswiki.org/cgi-bin/wiki/MuseDevelopment'.
-
-
-File: muse.info, Node: Installation, Next: Getting Started, Prev: Obtaining
Muse, Up: Top
-
-4 Compiling and Installing Muse
-*******************************
-
-Muse may be compiled and installed on your machine.
-
-Compilation
------------
-
-This is an optional step, since Emacs Lisp source code does not
-necessarily have to be byte-compiled. Byte-compilation may yield a very
-slight speed increase.
-
- A working copy of Emacs or XEmacs is needed in order to compile Emacs
-Muse. By default, the program that is installed with the name `emacs'
-will be used.
-
- If you want to use the `xemacs' binary to perform the compilation,
-you must copy `Makefile.defs.default' to `Makefile.defs' in the
-top-level directory, and then edit `Makefile.defs' as follows. You can
-put either a full path to an Emacs or XEmacs binary or just the command
-name, as long as it is in the `PATH'.
-
- EMACS = xemacs
- SITEFLAG = -no-site-file
- # Edit the section as necessary
- install_info = install-info --section "XEmacs 21.4" $(1).info \
- $(INFODIR)/dir || :
-
- Running `make' in the top-level directory should compile the Muse
-source files in the `lisp' directory, and generate an autoloads file in
-`lisp/muse-autoloads.el'.
-
-Installation
-------------
-
-Muse may be installed into your file hierarchy by doing the following.
-
- Copy `Makefile.defs.default' to `Makefile.defs' in the top-level
-directory, if you haven't done so already. Then edit the
-`Makefile.defs' file so that `ELISPDIR' points to where you want the
-source and compiled Muse files to be installed and `INFODIR' indicates
-where to put the Muse manual. You may use a combination of `DESTDIR'
-and `PREFIX' to further determine where the installed files should be
-placed. As mentioned earlier, you will want to edit `EMACS' and
-`SITEFLAG' as shown in the Compilation section if you are using XEmacs.
-
- If you are installing Muse on a Debian or Ubuntu system, you might
-want to change the value of `INSTALLINFO' as specified in
-`Makefile.defs'.
-
- If you wish to install Muse to different locations than the defaults
-specify, edit `Makefile.defs' accordingly.
-
- Run `make' as a normal user, if you haven't done so already.
-
- Run `make install' as the root user if you have chosen installation
-locations that require root permissions.
-
-ELPA
-----
-
-For those used to installing software packages, there will be a `muse'
-package available in the Emacs Lisp Package Archive (abbreviated
-"ELPA") as of the 3.10 release of Muse. This package will be compiled
-and installed automatically in a user-specific location. For more
-information on ELPA, see `http://tromey.com/elpa/'.
-
-
-File: muse.info, Node: Getting Started, Next: Projects, Prev: Installation,
Up: Top
-
-5 Getting Started
-*****************
-
-* Menu:
-
-* Loading Muse:: How to load Muse.
-* Using Muse Mode:: How to edit files in Muse.
-* Publishing Files Overview:: Publishing a single file or project.
-* File Extensions:: Using a different file extension.
-
-
-File: muse.info, Node: Loading Muse, Next: Using Muse Mode, Prev: Getting
Started, Up: Getting Started
-
-5.1 How to Load Muse
-====================
-
-To use Muse, add the directory containing its files to your `load-path'
-variable, in your `.emacs' file. Then, load in the authoring mode, and
-the styles you wish to publish to. An example follows.
-
- (add-to-list 'load-path "<path to Muse>")
-
- (require 'muse-mode) ; load authoring mode
-
- (require 'muse-html) ; load publishing styles I use
- (require 'muse-latex)
- (require 'muse-texinfo)
- (require 'muse-docbook)
-
- (require 'muse-project) ; publish files in projects
-
- An easy way of seeing which settings are available and changing
-settings is to use the Muse customization interface. To do this, type
-`M-x customize-group muse RET'. Each of the options has its own
-documentation. Options are grouped logically according to what effect
-they have.
-
-
-File: muse.info, Node: Using Muse Mode, Next: Publishing Files Overview,
Prev: Loading Muse, Up: Getting Started
-
-5.2 How to Edit Files in Muse
-=============================
-
-Muse Mode should automatically be activated when you visit a file with a
-".muse" extension. One such file is `QuickStart.muse', which is
-available in the `examples' directory of the Muse distribution. You
-can tell that Muse Mode has been activated by checking for the text
-"Muse" in your mode line. If Muse Mode has not been activated, you may
-activate it by type `M-x muse-mode RET'.
-
- You will notice that Muse files are highlighted very simply. Links
-are colored blue, headings are large and bold text, and <example> tags
-are colored in grey.
-
- There are several different ways to edit things like links, which
-hide the underlying Muse markup. One way is to toggle font-locking off
-by hitting `C-c C-l', which is also `M-x font-lock-mode', make changes,
-and then hit `C-c C-l' again to toggle font-locking back on. Another
-way is just to move into the text and edit it. Markup can also be
-removed by normal deletion methods, though some side effects might
-require a second deletion.
-
- For the particular case of editing links, it is easiest to move to
-the link and do `C-c C-e', which is also `M-x muse-edit-link-at-point'.
-This prompts you for the link and its description, using the previous
-contents of the link as initial values. A link to another Muse file
-may be created by hitting `C-c TAB l'. A link to a URL may be created
-by hitting `C-c TAB u'. Links may be followed by hitting `RET' on them.
-
- If you want to add a new list item, this may by accomplished by
-hitting `M-RET'. This will put a dash and some spaces on the screen.
-The dash is the Muse markup that indicates a list item. It is also
-possible to created "nested" lists with this command, by adjusting the
-number of spaces in front of the dashes. If you have lists with long
-lines, you can move to a list item and hit `M-q' to wrap it onto
-multiple lines.
-
-
-File: muse.info, Node: Publishing Files Overview, Next: File Extensions,
Prev: Using Muse Mode, Up: Getting Started
-
-5.3 Publishing a Single File or Project
-=======================================
-
-The command `M-x muse-project-publish-this-file' will publish the
-current document to any available publishing style (a publishing style
-is an output format, like HTML or Docbook), placing the output in the
-current directory. If you are in Muse Mode, this command will be bound
-to `C-c C-t'. If the file has been published recently, and its
-contents have not changed, running `C-c C-t' again will not publish the
-file. To force publishing in this case, do `C-u C-c C-t'.
-
- If you have set up projects and are visiting a file that is part of a
-project, then `C-c C-t' will restrict the output formats to those which
-are used by the project, and will automatically publish to the output
-directory defined by the project. If you want to publish to a
-different directory or use a different format, then use `C-c M-C-t',
-which is also `M-x muse-publish-this-file'.
-
- If the currently opened file is part of a defined project in
-`muse-project-alist', it (and the rest of the changed files in a
-project) may be published using `C-c C-p'.
-
-
-File: muse.info, Node: File Extensions, Prev: Publishing Files Overview,
Up: Getting Started
-
-5.4 Using a Different File Extension
-====================================
-
-By default, Muse expects all project files to have the file extension
-`.muse'. Files without this extension will not be associated with Muse
-mode and will not be considered part of any project, even if they are
-within a project directory.
-
- If you don't want to use `.muse', you can customize the extension by
-setting the value of `muse-file-extension'.
-
- If you don't want to use any extension at all, and want Muse to
-autodetect project files based on their location, then add the following
-to your Muse settings file.
-
- (setq muse-file-extension nil
- muse-mode-auto-p t)
-
- Note that if you chose to have `muse-file-extension' set to `nil',
-you may have trouble if your `.emacs' file or other init scripts
-attempt to visit a Muse file. (A very common example of this is if you
-use Planner with Muse and run `(plan)' from your `.emacs'.) If you
-wish to visit Muse files from your `.emacs', be sure to also add the
-following additional code before any such visits happen:
-
- (add-hook 'find-file-hook 'muse-mode-maybe)
-
-
-File: muse.info, Node: Projects, Next: Keystroke Summary, Prev: Getting
Started, Up: Top
-
-6 Creating and Managing Muse Projects
-*************************************
-
-Often you will want to publish all the files within a directory to a
-particular set of output styles automatically. To support, Muse allows
-for the creation of "projects".
-
-* Menu:
-
-* Single Project:: A single-project example.
-* Multiple Projects:: A multiple-project example.
-* Projects and Subdirectories:: Publishing subdirectories in projects.
-* Options for Projects:: Listing of available options for projects.
-
-
-File: muse.info, Node: Single Project, Next: Multiple Projects, Prev:
Projects, Up: Projects
-
-6.1 A Single-Project Example
-============================
-
-Here is a sample project, which may be defined in your `.emacs' file.
-
- (setq muse-project-alist
- '(("Website" ("~/Pages" :default "index")
- (:base "html" :path "~/public_html")
- (:base "pdf" :path "~/public_html/pdf"))))
-
- The above defines a project named "website", whose files are located
-in the directory `~/Pages'. The default page to visit is `index'.
-When this project is published, each page will be output as HTML to the
-directory `~/public_html', and as PDF to the directory
-`~/public_html/pdf'. Within any project page, you may create a link to
-other pages using the syntax `[[pagename]]'.
-
- If you would like to include only some files from a directory in a
-Muse project, you may use a regexp in place of `~/Pages' in the example.
-
-
-File: muse.info, Node: Multiple Projects, Next: Projects and Subdirectories,
Prev: Single Project, Up: Projects
-
-6.2 A Multiple-Project Example
-==============================
-
-It is possible to specify multiple projects. Here is an example of
-three projects: a generic website, a projects area, and a day-planner
-(the day-planner part requires Planner Mode--see
-`http://wjsullivan.net/PlannerMode.html' to get it).
-
- (setq muse-project-alist
- '(("Website" ("~/Pages" :default "index")
- (:base "html" :path "~/public_html"))
- (("Projects" ("~/Projects" :default "index")
- (:base "xhtml"
- :path "~/public_html/projects"
- :exclude "/TopSecret")
- (:base "pdf"
- :path "~/public_html/projects/pdf"
- :exclude "/TopSecret")))
- ("Plans" ("~/Plans"
- :default "TaskPool"
- :major-mode planner-mode
- :visit-link planner-visit-link)
- (:base "planner-xhtml"
- :path "~/public_html/plans"))))
-
- The `:major-mode' attribute specifies which major to use when
-visiting files in this directory.
-
- The `:visit-link' attribute specifies the function to call when
-visiting links.
-
- The `:exclude' attribute has a regexp that matches files to never
-publish.
-
-
-File: muse.info, Node: Projects and Subdirectories, Next: Options for
Projects, Prev: Multiple Projects, Up: Projects
-
-6.3 Publishing Subdirectories in Projects
-=========================================
-
-If you want to publish a directory and all of its subdirectories, Muse
-provides two convenience functions that together generate the proper
-rules for you. Note that we use the backtick to begin this
-muse-project-alist definition, rather than a single quote.
-
- (setq muse-project-alist
- `(("Website" ("~/Pages" :default "index")
- (:base "html" :path "~/public_html"))
- ("Blog" (,@(muse-project-alist-dirs "~/Blog")
- :default "index")
- ;; Publish this directory and its subdirectories. Arguments
- ;; are as follows. The above `muse-project-alist-dirs' part
- ;; is also needed.
- ;; 1. Source directory
- ;; 2. Output directory
- ;; 3. Publishing style
- ;; remainder: Other things to put in every generated style
- ,@(muse-project-alist-styles "~/Blog"
- "~/public_html/blog"
- "blosxom"))))
-
- The `muse-project-alist-dirs' function takes a directory and returns
-it and all of its subdirectories in a list.
-
- The `muse-project-alist-styles' function is explained by the
-comments above.
-
- The "blosxom" text is the name of another publishing style, much like
-"html". *Note Blosxom::, for further information about it. You can
-use any publishing style you like for the third argument to
-`muse-project-alist-styles'.
-
-
-File: muse.info, Node: Options for Projects, Prev: Projects and
Subdirectories, Up: Projects
-
-6.4 Listing of Available Options for Projects
-=============================================
-
-This is a listing of all of the various options (or, more accurately:
-attributes) that may be specified in `muse-project-alist'.
-
- Each muse-project-alist entry looks like this:
-
- (PROJECT-NAME (SOURCES)
- OUTPUTS)
-
- We refer to these names below.
-
- "Attributes", which compose SOURCES and OUTPUTS, are a pair of
-values. The first value is a keyword, like `:default'. The second part
-is the value associated with that keyword, such as the text "index".
-If you are familiar with Emacs Lisp property lists, the concept is
-similar to that, except that in the SOURCES section, single directories
-can be interspersed with two-value attributes.
-
-Project Name
-------------
-
-This is a string that indicates the name of the project. It is
-primarily used for publishing interwiki links with the `muse-wiki.el'
-module.
-
-Sources
--------
-
-This part of a muse-project-alist entry consists of two-value
-attributes, and also directory names. If you are publishing a book, the
-order of directories and attributes is significant.
-
- The minimal content for the sources section is a list of directories.
-
-`:book-chapter'
- Indicates a new chapter of a book. The text of the title of the
- chapter comes immediately after this keyword.
-
-`:book-end'
- Indicates the end of a book. Directories listed after this one are
- ignored when publishing a book. The value "t" (without quotes)
- should come immediately after this keyword.
-
-`:book-funcall'
- A function to call while publishing a book. This is useful for
- doing something just after a particular chapter.
-
-`:book-part'
- Indicates the beginning of a new part of the book. The text of the
- title should come immediately after this keyword.
-
-`:book-style'
- Indicate a particular publishing style to use for this part of the
- book. If this is specified, it should come just after a `:part'
- attribute.
-
-`:default'
- The default page to visit when browsing a project. Also, if you
- are using the `muse-wiki.el' module, publishing a link to just a
- project's name will cause it to link to this default file.
-
-`:force-publish'
- This specifies a list of pages which should be published every
- time a project is published (by using `C-c C-p', for example),
- regardless of whether their contents have changed. This is useful
- for updating Index pages, pages that use the <include> tag, and
- other pages that have dynamically-generated content.
-
-`:major-mode'
- This specifies the major mode to use when visiting files in this
- project. The default is `muse-mode'.
-
-`:nochapters'
- This indicates that while publishing a book, do not automatically
- create chapters. Values which may follow this are nil (the
- default, which means that we automatically create chapters), or
- non-nil, which means that we manually specify chapters with the
- `:book-chapter' attribute,
-
-`:publish-project'
- Indicates which function we should call when publishing a project.
-
-`:set'
- This specifies a list of variables and values to set when
- publishing a project. The list should be a property list, which
- is in the form:
-
- (VAR1 VALUE1 VAR2 VALUE2 ...)
-
-`:visit-link'
- Specifies the function to call when visiting a link. The default
- is `muse-visit-link-default'. The arguments for that function
- should be (1) the link and (2) whether to visit the link in a new
- window.
-
-
-Outputs
--------
-
-This part of a muse-project-alist entry is composed of lists of
-attributes. Each list is called an "output style".
-
- The minimal content for an output style is a `:base' attribute and a
-`:path' attribute.
-
-`:base'
- Publishing style to use, such as "html", "docbook", or "pdf".
-
-`:base-url'
- An external URL which can be used to access published files. This
- is mainly used by the `muse-wiki' module when publishing links
- between two separate projects, if the projects are served on
- different domains.
-
- It is also used by the `muse-journal' module to create the RSS or
- RDF output.
-
-`:exclude'
- Exclude items matching a regexp from being published. The regexp
- should usually begin with "/".
-
-`:include'
- Only include items matching a regexp when publishing. The regexp
- should usually begin with "/".
-
-`:path'
- The directory in which to store published files.
-
-`:timestamps'
- A file containing the timestamps (that is, time of creation) for
- files in this project. It might eventually used by the
- `muse-blosxom' module, but this option is not currently in use by
- any Muse code.
-
-
-
-File: muse.info, Node: Keystroke Summary, Next: Markup Rules, Prev:
Projects, Up: Top
-
-7 Keys Used in Muse Mode
-************************
-
-This is a summary of keystrokes available in every Muse buffer.
-
-`C-c C-a (`muse-index')'
- Display an index of all known Muse pages.
-
-`C-c C-b (`muse-find-backlinks')'
- Find all pages that link to this page.
-
-`C-c C-e (`muse-edit-link-at-point')'
- Edit link at point.
-
-`C-c C-f (`muse-project-find-file')'
- Open another Muse page. Prompt for the name.
-
-`C-c C-i l, C-c TAB l (`muse-insert-relative-link-to-file')'
- Insert a link to a file interactively.
-
-`C-c C-i t, C-c TAB t (`muse-insert-tag')'
- Insert a tag interactively.
-
-`C-c C-i u, C-c TAB u (`muse-insert-url')'
- Insert a URL interactively.
-
-`C-c C-l (`font-lock-mode')'
- Toggle font lock / highlighting for the current buffer.
-
-`C-c C-p (`muse-project-publish')'
- Publish any Muse pages that have changed.
-
-`C-c C-s (`muse-search')'
- Find text in all files of the current project.
-
-`C-c C-t (`muse-project-publish-this-file')'
- Publish the currently-visited file. Prompt for the style if the
- current file can be published using more than one style.
-
-`C-c C-S-t, or C-c C-M-t (`muse-publish-this-file')'
- Publish the currently-visited file. Prompt for both the style and
- output directory.
-
-`C-c C-v (`muse-browse-result')'
- Show the published result of this page.
-
-`C-c = (`muse-what-changed')'
- Diff this page against the last backup version.
-
-`TAB'
- Move to the next Wiki reference.
-
-`S-TAB'
- Move to the previous Wiki reference.
-
-`M-TAB'
- Complete the name of a page from the current project at point.
-
-`M-RET'
- Insert a new list item at point, indenting properly.
-
-`C-<'
- Decrease the indentation of the list item at point.
-
-`C->'
- Increase the indentation of the list item at point.
-
-`M-x muse-colors-toggle-inline-images RET'
- Toggle display of inlined images on/off.
-
-`M-x muse-update-values RET'
- Update various values that are automatically generated.
-
- Call this after changing `muse-project-alist'.
-
-
-File: muse.info, Node: Markup Rules, Next: Publishing Styles, Prev:
Keystroke Summary, Up: Top
-
-8 Rules for Using Markup
-************************
-
-A Muse document uses special, contextual markup rules to determine how
-to format the output result. For example, if a paragraph is indented,
-Muse assumes it should be quoted.
-
- There are not too many markup rules, and all of them strive to be as
-simple as possible so that you can focus on document creation, rather
-than formatting.
-
-* Menu:
-
-* Paragraphs:: Paragraphs: centering and quoting.
-* Headings:: Levels of headings.
-* Directives:: Directives at the beginning of a
- document.
-* Emphasizing Text:: Bold, italicized, and underlined text.
-* Footnotes:: Making notes to be shown at the end.
-* Verse:: Indicating poetic stanzas.
-* Lists:: Lists of items.
-* Tables:: Generation of data tables.
-* Explicit Links:: Hyperlinks and email addresses with
- descriptions.
-* Implicit Links:: Bare URLs, WikiNames, and InterWiki
- links.
-* Images:: Publishing and displaying images.
-* Horizontal Rules and Anchors:: Inserting a horizontal line or anchor.
-* Embedded Lisp:: Evaluating Emacs Lisp code in documents
- for extensibility.
-* Citations:: Support for citing other resources.
-* Comments:: Lines to omit from published output.
-* Tag Summary:: Tags that Muse recognizes.
-
-
-File: muse.info, Node: Paragraphs, Next: Headings, Prev: Markup Rules, Up:
Markup Rules
-
-8.1 Paragraphs: centering and quoting
-=====================================
-
-Paragraphs in Muse must be separated by a blank line.
-
-Centered paragraphs and quotations
-----------------------------------
-
-A line that begins with six or more columns of whitespace (either tabs
-or spaces) indicates a centered paragraph. Alternatively, you can use
-the <center> tag to surround regions that are to be published as
-centered paragraphs.
-
- But if a line begins with whitespace, though less than six columns,
-it indicates a quoted paragraph. Alternatively, you can use the
-<quote> tag to surround regions that are to be published as quoted
-paragraphs.
-
-Literal paragraphs
-------------------
-
-The <example> tag is used for examples, where whitespace should be
-preserved, the text rendered in monospace, and any characters special
-to the output style escaped.
-
- There is also the <literal> tag, which causes a marked block to be
-entirely left alone. This can be used for inserting a hand-coded HTML
-blocks into HTML output, for example.
-
- If you want some text to only be inserted when publishing to a
-particular publishing style, use the `style' attribute for the
-<literal> tag. An example follows.
-
- <literal style="latex">
- A LaTeX-based style was used in the publishing of this document.
- </literal>
-
- This will leave the region alone if the current publishing style is
-"latex" or based on "latex", such as "pdf", and delete the region
-otherwise. It is also possible to leave the text alone only for one
-particular style, rather than its derivations, by adding `exact="t"' to
-the tag.
-
-Line breaks
------------
-
-If you need a line break, then use the `<br>' tag. Most of the time
-this tag is unnecessary, because Muse will automatically detect
-paragraphs by means of blank lines. If you want to preserve newlines in
-several lines of text, then use verse markup instead (*note Verse::).
-
-
-File: muse.info, Node: Headings, Next: Directives, Prev: Paragraphs, Up:
Markup Rules
-
-8.2 Levels of headings
-======================
-
-A heading becomes a chapter or section in printed output - depending on
-the style. To indicate a heading, start a new paragraph with one or
-more asterices, followed by a space and the heading title. Then begin
-another paragraph to enter the text for that section.
-
- All levels of headings will be published. Most publishing styles
-only distinguish the between the first 4 levels, however.
-
- * First level
-
- ** Second level
-
- *** Third level
-
- **** Fourth level
-
-
-File: muse.info, Node: Directives, Next: Emphasizing Text, Prev: Headings,
Up: Markup Rules
-
-8.3 Directives at the beginning of a document
-=============================================
-
-Directives are lines beginning with the `#' character that come before
-any paragraphs or sections in the document. Directives are of the form
-"#directive content of directive". You can use any combination of
-uppercase and lowercase letters for directives, even if the directive
-is not in the list below.
-
- The `muse-publishing-directive' function may be used in header and
-footer text to access directives. For example, to access the `#title'
-directive, use `(muse-publishing-directive "title")'.
-
- The following is a list of directives that Muse uses.
-
-`#author'
- The author of this document.
-
- If this is not specified, Muse will attempt to figure it out from
- the `user-full-name' variable.
-
-`#date'
- The date that the document was last modified.
-
- This is used by publishing styles that are able to embed the date
- information.
-
-`#desc'
- A short description of this document.
-
- This is used by the `journal' publishing style to embed information
- inside of an RSS/RDF feed.
-
-`#title'
- The title of this document.
-
- If this is not specified, the name of the file is used.
-
-
-
-File: muse.info, Node: Emphasizing Text, Next: Footnotes, Prev: Directives,
Up: Markup Rules
-
-8.4 Bold, italicized, and underlined text
-=========================================
-
-To emphasize text, surround it with certain specially recognized
-characters.
-
- *emphasis*
- **strong emphasis**
- ***very strong emphasis***
- _underlined_
- =verbatim and monospace=
-
- While editing a Muse document in Muse mode, these forms of emphasis
-will be highlighted in a WYSIWYG manner. Each of these forms may span
-multiple lines.
-
- Verbatim text will be colored as gray by default. To change this,
-customize `muse-verbatim-face'.
-
- You can also use the <code> tag to indicate verbatim and monospace
-text. This is handy for regions that have an "=" in them.
-
-
-File: muse.info, Node: Footnotes, Next: Verse, Prev: Emphasizing Text, Up:
Markup Rules
-
-8.5 Making notes to be shown at the end
-=======================================
-
-A footnote reference is simply a number in square brackets. To define
-the footnote, place this definition at the bottom of your file.
-`footnote-mode' can be used to greatly facilitate the creation of these
-kinds of footnotes.
-
- Footnotes are defined by the same number in brackets occurring at the
-beginning of a line. Use footnote-mode's `C-c ! a' command, to very
-easily insert footnotes while typing. Use `C-x C-x' to return to the
-point of insertion.
-
-
-File: muse.info, Node: Verse, Next: Lists, Prev: Footnotes, Up: Markup
Rules
-
-8.6 Indicating poetic stanzas
-=============================
-
-Poetry requires that whitespace be preserved, but without resorting to
-monospace. To indicate this, use the following markup, reminiscent of
-email quotations.
-
- > A line of Emacs verse;
- > forgive its being so terse.
-
- You can also use the <verse> tag, if you prefer.
-
- <verse>
- A line of Emacs verse;
- forgive its being so terse.
- </verse>
-
- Multiple stanzas may be included in one set of <verse> tags, as
-follows.
-
- <verse>
- A line of Emacs verse;
- forgive its being so terse.
-
- In terms of terse verse,
- you could do worse.
- </verse>
-
-
-File: muse.info, Node: Lists, Next: Tables, Prev: Verse, Up: Markup Rules
-
-8.7 Lists of items
-==================
-
-Lists are given using special characters at the beginning of a line.
-Whitespace must occur before bullets or numbered items, to distinguish
-from the possibility of those characters occurring in a real sentence.
-
- These are rendered as a bullet list.
-
- Normal text.
-
- - bullet item one
- - bullet item two
-
- An enumerated list follows.
-
- Normal text.
-
- 1. Enum item one
- 2. Enum item two
-
- Here is a definition list.
-
- Term1 ::
- This is a first definition
- And it has two lines;
- no, make that three.
-
- Term2 :: This is a second definition
-
-Nested lists
-------------
-
-It is possible to nest lists of the same or different kinds. The
-"level" of the list is determined by the amount of initial whitespace.
-
- Normal text.
-
- - Level 1, bullet item one
- 1. Level 2, enum item one
- 2. Level 2, enum item two
- - Level 1, bullet item two
- 1. Level 2, enum item three
- 2. Level 2, enum item four
- term :: definition
-
-Breaking list items
--------------------
-
-If you want to break up a line within any list type, just put one blank
-line between the end of the previous line and the beginning of the next
-line, using the same amount of initial indentation.
-
- - bullet item 1, line 1
-
- bullet item 1, line 2
-
- 1. Enum line 1
-
- Enum line 2
-
- - bullet item 2, line 1
-
- bullet item 2, line 2
-
-
-File: muse.info, Node: Tables, Next: Explicit Links, Prev: Lists, Up:
Markup Rules
-
-8.8 Generation of data tables
-=============================
-
-Only very simple tables are supported. The syntax is as follows.
-
- Double bars || Separate header fields
-
- Single bars | Separate body fields
- Here are more | body fields
-
- Triple bars ||| Separate footer fields
-
- Some publishing styles require header fields to come first, then
-footer fields, and then the body fields. You can use any order for
-these sections that you like, and Muse will re-order them for you at
-publish-time.
-
- If you wish to disable table generation for one Muse file, add the
-directive `#disable-tables t' to the top of the file.
-
-Other table formats
--------------------
-
-It is possible to publish very basic Orgtbl-mode style tables.
-
- | org | style | table |
- |------+-------+-------|
- | one | | one |
- | two | two | |
- | | three | three |
- |------+-------+-------|
- | more | stuff | |
-
- If you are used to the way that Org Mode publishes these tables, then
-customize `muse-html-table-attributes' to the following, in order to get
-a similar kind of output.
-
- border="2" cellspacing="0" cellpadding="6" rules="groups" frame="hsides"
-
- `table.el' style tables are also supported, as long as `table.el'
-itself supports outputting tables for a particular publishing style.
-At the time of this writing, the "html", "latex", and "docbook" styles
-are supported by `table.el'. Styles derived from these styles will
-also work.
-
- +---+-----+---+
- | | one | 1 |
- +---+-----+---+
- | b | two | |
- +---+-----+---+
- | c | | 3 |
- +---+-----+---+
-
-
-File: muse.info, Node: Explicit Links, Next: Implicit Links, Prev: Tables,
Up: Markup Rules
-
-8.9 Hyperlinks and email addresses with descriptions
-====================================================
-
-A hyperlink can reference a URL, or another page within a Muse project.
-In addition, descriptive text can be specified, which should be
-displayed rather than the link text in output styles that supports link
-descriptions. The syntax is as follows.
-
- [[link target][link description]]
- [[link target without description]]
-
- Thus, the current maintainer's homepage for Muse can be found
-`[[http://mwolson.org/projects/EmacsMuse.html][here]]', or at
-`[[http://mwolson.org/projects/EmacsMuse.html]]'.
-
-
-File: muse.info, Node: Implicit Links, Next: Images, Prev: Explicit Links,
Up: Markup Rules
-
-8.10 Bare URLs, WikiNames, and InterWiki links
-==============================================
-
-A URL or email address encountered in the input text is published as a
-hyperlink. These kind of links are called "implicit links" because
-they are not separated from the rest of the Muse document in any way.
-
- Some characters in URLs will prevent Muse from recognizing them as
-implicit links. If you want to link to a URL containing spaces or any of
-the characters "][,"'`()<>^", you will have to make the link explicit.
-The punctuation characters ".,;:" are also not recognized as part of a
-URL when they appear at its end. For information on how to make an
-explicit link, see *note Hyperlinks and email addresses with
-descriptions: Explicit Links.
-
- If the `muse-wiki' module is loaded, another form of implicit link
-will be made available. WikiNames, which are typed in CamelCase, are
-highlighted and published as links, provided that the file they refer
-to exists.
-
- Customization of WikiName recognition may be accomplished by editing
-the `muse-wiki-wikiword-regexp' option and subsequently running
-`(muse-configure-highlighting 'muse-colors-markupmuse-colors-markup)'.
-If you use the Customize interface, the latter will be done
-automatically.
-
- The `muse-wiki' module also allows for InterWiki links. These are
-similar to WikiWords, but they specify both the project and page of a
-file. The names of your project entries in `muse-project-alist' will
-be used as InterWiki names by default. Several examples follow.
-
- Blog::DocumentingMuse
- Projects#EmacsMuse
- Website
-
- In the first case, the interwiki delimiter is `::', `Blog' is the
-project name, and `DocumentingMuse' is the page name. In the second
-example, `#' is the interwiki delimiter. If the name of a project
-occurs by itself in text, like the third case, it will be colorized and
-published as a link to the default page of the given project.
-
- Customization of interwiki links may be accomplished by editing the
-`muse-wiki-interwiki-alist' option.
-
- It is also possible to link to an anchor in an interwiki document.
-This is called a "three-part link". Examples of this follow.
-
- Blog::DocumentingMuse#anchor1
- Projects#EmacsMuse#anchor2
-
-
-File: muse.info, Node: Images, Next: Horizontal Rules and Anchors, Prev:
Implicit Links, Up: Markup Rules
-
-8.11 Publishing and displaying images
-=====================================
-
-Image links
------------
-
-Links to images may be used in either the target or the description, or
-both. Thus, the following code will publish as a clickable image that
-points to `http://mwolson.org/'.
-
- [[http://mwolson.org/][/static/logos/site-logo.png]]
-
- Normally, images in the link part will be inlined.
-
- If you want these images to be published as links instead, place the
-text "URL:" immediately in front of the link text. An example follows.
-
- [[URL:http://mwolson.org/static/logos/site-logo.png]]
-
-Displaying images in Muse mode
-------------------------------
-
-If a link to a locally-available image is encountered in the link
-description, Muse mode will attempt to display it if your version of
-Emacs permits this.
-
- This behavior may be toggled with `C-c C-i', or disabled permanently
-by setting the `muse-colors-inline-images' option to `nil'.
-
- The method for finding images may be altered by customizing the
-`muse-colors-inline-image-method' option. One useful value for this
-option is `muse-colors-use-publishing-directory', which tells Muse mode
-to look in the directory where the current file will be published. The
-default is to look in the current directory. Relative paths like
-`../pics/' should work for either setting.
-
- Eventually, it is hoped that Muse will be able to copy images from
-the a "source" directory to a publishing directory by customizing
-`muse-project-alist', but this has not been implemented yet.
-
-Publishing simple images
-------------------------
-
-The following example will display correctly and publish correctly if a
-PNG file called `TestLogo.png' exists in the `../pics/' directory. If
-text is on the same line as the picture, it will remain so in the
-output.
-
- [[../myimage.png]]
-
-Publishing images with captions
--------------------------------
-
-If you want to add a caption to an image, use the following syntax.
-This will center the image (if the output format supports it) and add a
-centered caption below the picture. Formats that do not support
-centering the image will instead leave it against the left margin.
-
- [[../pics/mycat.png][My cat Dexter]]
-
- Images with captions may only occur in their own paragraphs, with no
-text on the same line. Otherwise, the published output will not be
-syntactically correct.
-
-
-File: muse.info, Node: Horizontal Rules and Anchors, Next: Embedded Lisp,
Prev: Images, Up: Markup Rules
-
-8.12 Inserting a horizontal line or anchor
-==========================================
-
-Horizontal Rules
-----------------
-
-Four or more dashes indicate a horizontal rule. Be sure to put blank
-lines around it, or it will be considered part of the proceeding or
-following paragraph!
-
-Anchors
--------
-
-If you begin a line with "#anchor" - where "anchor" can be any word
-that doesn't contain whitespace - it defines an anchor at that point
-into the document. This point can be referenced using "page#anchor" as
-the target in a Muse link.
-
-
-File: muse.info, Node: Embedded Lisp, Next: Citations, Prev: Horizontal
Rules and Anchors, Up: Markup Rules
-
-8.13 Evaluating Emacs Lisp code in documents for extensibility
-==============================================================
-
-Arbitrary kinds of markup can be achieved using the <lisp> tag. With
-the <lisp> tag, you may generate whatever output text you wish. The
-inserted output will get marked up if the <lisp> tag appears within the
-main text of the document.
-
- <lisp>(concat "This form gets " "inserted")</lisp>
-
- Note that you should not use the `insert' command within a set of
-<lisp> tags, since the return value from the <lisp> tags will be
-automatically inserted into the document.
-
- It is also possible to treat the output as if it were surrounded by
-the <example>, <src>, or <verse> tags, by specifying "example", "src",
-or "verse" as the `markup' attribute of the <lisp> tag.
-
- <lisp markup="example">
- (concat "Insert" " me")
- </lisp>
-
- Other languages also have tags that cause source code to be
-evaluated. *Note Tag Summary::, for details.
-
-
-File: muse.info, Node: Citations, Next: Comments, Prev: Embedded Lisp, Up:
Markup Rules
-
-8.14 Support for citing other resources
-=======================================
-
-Example
--------
-
-Here is an example of what citations look like in a Muse document.
-
- #bibsource REFDB
-
- * Title
- ** Subtitle
-
- Some text before <cite>Miller1999</cite> and after the citation.
-
- This is an author-only citation <cite type="author">Miller1999</cite>.
-
- And this is a year-only citation <cite type="year">Miller1999</cite>.
-
- Finally, this is a multi-head citation
- <cite>Miller1999,Andrews2005</cite>.
-
-Overview
---------
-
-The `#bibsource' directive defines the source of the bibliographies.
-The following sources are possible.
-
- * DocBook + RefDB: the string "REFDB"
-
- * LaTeX + bibtex: the name of an appropriate bibtex file
-
- * LaTeX + RefDB: if the input file is called "foo.muse", then set
- this to "foo.bib"
-
- Citations are encoded as <cite> elements which enclose the citation
-keys as they are defined in the bibliography file or database. In
-multi-head citations, the citation keys have to be separated by colons
-or semicolons. The `latex' and `docbook' styles translate these to the
-proper separator automatically.
-
- The <cite> elements take an optional "type" attribute that defines
-how the citation is rendered. If the attribute is missing, you'll get
-a regular citation according to the bibliography style, e.g." (Miller
-et al., 1999)". If the attribute is set to "author", only the name of
-the author(s) will be rendered. Accordingly, "year" will cause the
-year to be printed. This is useful to create citations like this:
-
- Miller et al. had already shown in a previous publication (1999) that
- this is not going to work.
-
- Remember that refdb-mode (the Emacs interface to RefDB) can retrieve
-references by simply marking the citation key and running the
-`refdb-getref-by-field-on-region' command. Later versions of
-`refdb-mode' will also allow to insert references as Muse citations
-(which is already implemented for DocBook, TEI, and LaTeX documents).
-
- You may have noticed that there is no element to indicate the
-position of the bibliography. The latter is always created at a valid
-position close to the end of the document. The functions
-`muse-docbook-bibliography' and `muse-latex-bibliography' are called in
-the header or footer to generate this content, so it is possible to
-change the exact position.
-
-
-File: muse.info, Node: Comments, Next: Tag Summary, Prev: Citations, Up:
Markup Rules
-
-8.15 Lines to omit from published output
-========================================
-
-Use the following syntax to indicate a comment. Comments will not be
-published.
-
- ; Comment text goes here.
-
- That is, only a semi-colon at the beginning of a line, followed by a
-literal space, will cause that line to be treated as a comment.
-
- You can alternatively surround the region with the <comment> tag.
-
- If you wish the comment to be published, but just commented out using
-the comment syntax of the output format, then set
-`muse-publish-comments-p' to non-nil.
-
-
-File: muse.info, Node: Tag Summary, Prev: Comments, Up: Markup Rules
-
-8.16 Tags that Muse recognizes
-==============================
-
-Muse has several built-in tags that may prove useful during publishing.
-*Note muse-publish-markup-tags::, to see how to customize the tags that
-Muse uses, as well as make your own tags.
-
- Only a small subset of these tags are available in header and footer
-text. The `muse-publish-markup-header-footer-tags' option lists the
-tags that are allowed in headers and footers.
-
-Syntax
-------
-
-If a tag takes arguments, it will look like this, where "tagname" is
-the name of the tag.
-
- <tagname arg1="string1" arg2="string2">
-
- If you want the tag to look like it came straight from an XHTML
-document, you can alternatively do the following.
-
- <tagname arg1="string1" arg2="string2" />
-
- If a tag surrounds some text, it will look like this.
-
- <tagname>Some text</tagname>
-
- If a tag surrounds a large region, it will look like this.
-
- <tagname>
- Some text.
- Some more text.
- </tagname>
-
-Tag listing
------------
-
-This is the complete list of tags that Muse accepts, including those
-that were mentioned in previous sections.
-
-`<br>'
- Insert a line break.
-
- Muse will automatically detect paragraphs when publishing by means
- of blank lines, so this tag is usually unnecessary.
-
-`<cite>'
- Insert a citation to another source.
-
- This takes the argument `type', which indicates the type of
- citation. The valid types are "author" and "year". If this
- argument is omitted, include both author and year in the citation.
-
- The bibliography to use for the citation may be specified by the
- `#bibsource' directive.
-
- *Note Citations::, for additional information.
-
-`<class>'
- If publishing to HTML, surround the given text with a <span> tag.
- It takes one argument called "name" that specifies the "class"
- attribute of the <span> tag.
-
- If publishing to a different format, do nothing extra to the text.
-
-`<code>'
- Treat the text surrounded by the tag as if they were enclosed in
- equal signs, that is, make it monospace.
-
-`<command>'
- Run a command on the region, replacing the region with the result
- of the command. The command is specified with the "interp"
- argument. If no value for "interp" is given, pass the entire
- region to the shell.
-
- The "markup" argument controls how this section is marked up.
-
- If it is omitted, publish the region with the normal Muse rules.
-
- If "nil", do not mark up the region at all, but prevent Muse from
- further interpreting it.
-
- If "example", treat the region as if it was surrounded by the
- <example> tag.
-
- If "src", treat the included text as if it was surrounded by the
- <src> tag. You should also specify the "lang" attribute if doing
- this.
-
- If "verse", treat the region as if it was surrounded by the
- <verse> tag, to preserve newlines.
-
- Otherwise, it should be the name of a function to call, with the
- buffer narrowed to the region.
-
-`<comment>'
- Treat the entire region as a comment. If the option
- MUSE-PUBLISH-COMMENTS-P is nil, delete the region, otherwise
- publish it using the comment syntax of the current publishing
- style.
-
-`<contents>'
- Publish a Table of Contents. This will either be inserted
- in-place or at the beginning of the document, depending on your
- publishing style. It does not have a delimiting tag.
-
- By default, only 2 levels of headings will be included in the
- generated Table of Contents. To change this globally, customize
- the MUSE-PUBLISH-CONTENTS-DEPTH option. To change this only for
- the current tag, use the "depth" argument.
-
-`<div>'
- Insert a <div> tag into HTML documents, and do not insert anything
- special for other non-HTML publishing formats.
-
- If the "style" argument is provided, include it with the published
- <div> tag. Likewise for the "id" argument.
-
-`<example>'
- Publish the region in monospace, preserving the newlines in the
- region. This is useful for snippets of code.
-
-`<include>'
- Insert the given file at the current location during publishing.
- The basic use of this tag is as follows, replacing "included_file"
- with the name of the file that you want to include.
-
- <include file="included_file">
-
- The "markup" argument controls how this section is marked up.
-
- If it is omitted, publish the included text with the normal Muse
- rules.
-
- If "nil", do not mark up the included text at all.
-
- If "example", treat the included text as if it was surrounded by
- the <example> tag.
-
- If "src", treat the included text as if it was surrounded by the
- <src> tag. You should also specify the "lang" attribute if doing
- this.
-
- If "verse", treat the included text as if it was surrounded by the
- <verse> tag, to preserve newlines.
-
- Otherwise, it should be the name of a function to call after
- inserting the file with the buffer narrowed to the section
- inserted.
-
-`<lisp>'
- Evaluate the Emacs Lisp expressions between the initial and ending
- tags. The result is then inserted into the document, so you do
- not need to explicitly call `insert'. All text properties are
- removed from the resulting text.
-
- This tag takes the "markup" argument. See the description of
- <command> for details.
-
-`<literal>'
- Make sure that the text enclosed by this tag is published without
- escaping it in any way. This is useful for inserting markup
- directly into the published document, when Muse does not provide
- the desired functionality.
-
-`<markup>'
- Mark up the text between the initial and ending tags. The markup
- command to use may be specified by the "function" argument. The
- standard Muse markup routines are used by default if no "function"
- argument is provided.
-
- This is useful for marking up regions in headers and footers. One
- example that comes to mind is generating a published index of all
- of the files in the current project by doing the following.
-
- <markup><lisp>(muse-index-as-string t t)</lisp></markup>
-
-`<perl>'
- Run the `perl' language interpreter on the region, replacing the
- region with the result of the command.
-
- This tag takes the "markup" argument. See the description of
- <command> for details.
-
-`<python>'
- Run the `python' language interpreter on the region, replacing the
- region with the result of the command.
-
- This tag takes the "markup" argument. See the description of
- <command> for details.
-
-`<quote>'
- Publish the region as a blockquote. This will either be inserted
- in-place or at the beginning of the document, depending on your
- publishing style. It does not have a delimiting tag.
-
-`<ruby>'
- Run the `ruby' language interpreter on the region, replacing the
- region with the result of the command.
-
- This tag takes the "markup" argument. See the description of
- <command> for details.
-
-`<src>'
- 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 this
- is not satisfied, or the current publishing style is not
- HTML-based, Muse will publish the region like an <example> tag.
-
-`<verbatim>'
- This is used when you want to prevent Muse from trying to
- interpret some markup. Surround the markup in <verbatim> and
- </verbatim>, and it will not be interpreted.
-
- This tag was used often in previous versions of Muse because they
- did not support whole-document escaping of specials. Now, it will
- only be needed for other tags, and perhaps footnotes as well.
-
-`<verse>'
- Preserve the newlines in the region. In formats like HTML,
- newlines are removed by default, hence the need for this tag. In
- other publishing styles, this tag may cause the text to be
- indented slightly in a way that looks nice for poetry and prose.
-
-
-
-File: muse.info, Node: Publishing Styles, Next: Extending Muse, Prev:
Markup Rules, Up: Top
-
-9 Publishing Various Types of Documents
-***************************************
-
-One of the principle features of Muse is the ability to publish a simple
-input text to a variety of different output styles. Muse also makes it
-easy to create new styles, or derive from an existing style.
-
-* Menu:
-
-* Blosxom:: Integrating Muse and pyblosxom.cgi.
-* Book:: Publishing entries into a compilation.
-* ConTeXt:: Publishing ConTeXt documents.
-* DocBook:: Publishing in DocBook XML form.
-* HTML:: Publishing in HTML or XHTML form.
-* Ikiwiki:: Integrating with ikiwiki.
-* Journal:: Keeping a journal or blog.
-* LaTeX:: Publishing LaTeX documents.
-* Poem:: Publish a poem to LaTeX or PDF.
-* Texinfo:: Publish entries to Texinfo format or PDF.
-* XML:: Publish entries to XML.
-
-
-File: muse.info, Node: Blosxom, Next: Book, Prev: Publishing Styles, Up:
Publishing Styles
-
-9.1 Integrating Muse and pyblosxom.cgi
-======================================
-
-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.
-In other words, each blog entry corresponds with one file.
-
-* Menu:
-
-* Blosxom Requirements:: Other tools needed for the Blosxom style.
-* Blosxom Entries:: Format of a Blosxom entry and automation.
-* Blosxom Options:: Blosxom styles and options provided.
-
-
-File: muse.info, Node: Blosxom Requirements, Next: Blosxom Entries, Prev:
Blosxom, Up: Blosxom
-
-9.1.1 Other tools needed for the Blosxom style
-----------------------------------------------
-
-You will need to have `pyblosxom.cgi' or `blosxom.cgi' installed on a
-machine that you have upload access to.
-
- The major difficulty in both of these programs is specifying the
-date of the entries. Both programs rely on the file modification time
-rather than any data contained in the entries themselves. A plugin is
-needed in order for these programs to be able to get the correct date.
-
-PyBlosxom
----------
-
-There are two different ways of accomplishing this in pyblosxom. The
-first way involves gathering the timestamps (as specified by the
-`#date' directive) into one file and then sending that file along with
-published entries to the webserver.
-
- The second will read each file at render time and parse the
-`#postdate' directive. Muse will translate the `#date' directive into
-`#postdate' at publish time, so you don't have to do any extra work.
-
-Placing timestamps in one file
-..............................
-
-The following additional components are required in order to make the
-date of blog entries display as something sensible.
-
- 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.cgi' in the
-`contrib/pyblosxom' subdirectory. `getstamps.py' provides the former
-service, while `hardcodedates.py' provides the latter service.
-
- Here is a sample listing from my `timestamps' file, which maps each
-file to a date. This can really be in any format, as long as your
-date-gathering script and your plugin can both understand it.
-
- 2005-04-01-14-16 personal/paper_cranes
- 2005-03-21 personal/spring_break_over
- 2004-10-24 personal/finished_free_culture
-
- The script `contrib/pyblosxom/make-blog' demonstrates how to call
-`getstamps.py'. Note that you will need to set the current directory
-to where your Muse files are, execute `getstamps.py', and then move the
-generated timestamps file to your publishing directory.
-
-Getting timestamp from entry while rendering
-............................................
-
-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'.
-
-Blosxom
--------
-
-It is also possible to use Blosxom, which is written in Perl, to serve
-blog entries that were published with Muse. The steps are as follows.
-
- 1. Download and install blosxom from
- `http://blosxom.sourceforge.net/'.
-
- 2. Install the metadate plugin. It is available in
- `contrib/blosxom/metadate_0_0_3'.
-
- 3. Every time you make a new blog entry, change to the blosxom data
- directory and execute the `contrib/blosxom/getstamps.pl' script.
- This script has only recently been made, and may still have some
- bugs, so use with caution.
-
-
-
-File: muse.info, Node: Blosxom Entries, Next: Blosxom Options, Prev:
Blosxom Requirements, Up: Blosxom
-
-9.1.2 Format of a Blosxom entry and automation
-----------------------------------------------
-
-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 `pyblosxom.cgi' or this
-program. You need to have the two additional items from the former
-section to make use of this feature.
-
- 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.
-
-
-File: muse.info, Node: Blosxom Options, Prev: Blosxom Entries, Up: Blosxom
-
-9.1.3 Blosxom styles and options provided
------------------------------------------
-
-The following styles and options are available in the Blosxom publishing
-style.
-
-Styles provided
----------------
-
-`blosxom-html'
- Publish Blosxom entries in HTML form.
-
-`blosxom-xhtml'
- Publish Blosxom entries in XHTML form.
-
-
-Options provided
-----------------
-
-`muse-blosxom-extension'
- Default file extension for publishing Blosxom files.
-
-`muse-blosxom-header'
- Header used for publishing Blosxom files.
-
- This may be text or a filename.
-
-`muse-blosxom-footer'
- Footer used for publishing Blosxom files.
-
- This may be text or a filename.
-
-`muse-blosxom-base-directory'
- Base directory of blog entries, used by `muse-blosxom-new-entry'.
-
- This is the top-level directory where your blog entries may be
- found locally.
-
-
-
-File: muse.info, Node: Book, Next: ConTeXt, Prev: Blosxom, Up: Publishing
Styles
-
-9.2 Publishing entries into a compilation
-=========================================
-
-This publishing style is used to output "books" in LaTeX or PDF format.
-
- 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.
-
- One way of publishing a book is to make a project for it, add the
-project to `muse-project-alist', and use the `book-pdf' style with a
-very specific `:include' value to specify some page whose contents will
-be checked for the values of `#title' and `#date', and whose name will
-be used in the output file. Then to publish the book, visit the
-aforementioned page and use `C-c C-t' or `C-c C-p' to trigger the
-publishing process. An example `muse-project-alist' for this method
-follows.
-
- (setq muse-project-alist
- '(("MyNotes" (:nochapters t ; do automatically add chapters
- :book-chapter "Computer Science"
- "~/Notes/cs"
- :book-chapter "Mathematics"
- "~/Notes/math"
- :book-chapter "Emacs"
- "~/Notes/emacs"
- :book-end t ; the rest will not be placed in the book
- "~/Notes" ; so we can find the notes-anthology page
- "~/Notes/private"
- :force-publish ("index")
- :default "index")
- (:base "book-pdf"
- :include "/notes-anthology[^/]*$"
- :path "~/public_html/notes")
- ;; other publishing styles for each directory go here,
- ;; if desired
- )))
-
- In this example, there would be a file called
-`~/Notes/notes-anthology.muse', which would contain just the following.
-The resulting book would be published to
-`~/public_html/notes/notes-anthology.pdf'.
-
- #title My Technology Ramblings
-
- Another way is to call the `muse-book-publish-project' function
-manually, with a custom project entry. An example of this may be found
-in John Wiegley's configuration file at `examples/johnw/muse-init.el',
-in the `muse-publish-my-books' function.
-
-Styles provided
----------------
-
-`book-latex'
- Publish a book in LaTeX form. The header and footer are different
- than the normal LaTeX publishing mode.
-
-`book-pdf'
- Publish a book in PDF form. The header and footer are different
- than the normal PDF publishing mode.
-
-
-Options provided
-----------------
-
-`muse-book-before-publish-hook'
- A hook run in the book buffer before it is marked up.
-
-`muse-book-after-publish-hook'
- A hook run in the book buffer after it is marked up.
-
-`muse-book-latex-header'
- Header used for publishing books to LaTeX.
-
- This may be text or a filename.
-
-`muse-book-latex-footer'
- Footer used for publishing books to LaTeX.
-
- This may be text or a filename.
-
-
-
-File: muse.info, Node: ConTeXt, Next: DocBook, Prev: Book, Up: Publishing
Styles
-
-9.3 Publishing ConTeXt documents
-================================
-
-This publishing style is capable of producing ConTeXt or PDF documents.
-
- If you wish to publish PDF documents based on ConTeXt, you will need
-to have it installed. For Debian and Ubuntu, this can be accomplished
-by installing the "texlive" package.
-
-Styles provided
----------------
-
-`context'
- Publish a ConTeXt document.
-
-`context-pdf'
- Publish a PDF document, using an external ConTeXt document
- conversion tool.
-
-`context-slides'
- Produce slides from a ConTeXt document.
-
- Here is an example of a slide.
-
- * First Slide
-
- [[Some-sort-of-cute-image.png]]
-
- ** A subheading
-
- - A bullet point.
- - Another bullet point.
-
- * Second Slide
-
- ... and so on
-
-`context-slides-pdf'
- Publish a PDF document of ConTeXt slides.
-
-
-Options provided
-----------------
-
-`muse-context-extension'
- Default file extension for publishing ConTeXt files.
-
-`muse-context-pdf-extension'
- Default file extension for publishing ConTeXt files to PDF.
-
-`muse-context-pdf-program'
- The program that is called to generate PDF content from ConTeXt
- content.
-
-`muse-context-pdf-cruft'
- Extensions of files to remove after generating PDF output
- successfully.
-
-`muse-context-header'
- Header used for publishing ConTeXt files.
-
- This may be text or a filename.
-
-`muse-context-footer'
- Footer used for publishing ConTeXt files.
-
- This may be text or a filename.
-
-`muse-context-markup-regexps'
- List of markup regexps for identifying regions in a Muse page.
-
- For more on the structure of this list, *Note
- muse-publish-markup-regexps::.
-
-`muse-context-markup-functions'
- An alist of style types to custom functions for that kind of text.
-
- For more on the structure of this list, *Note
- muse-publish-markup-functions::.
-
-`muse-context-markup-strings'
- Strings used for marking up text.
-
- These cover the most basic kinds of markup, the handling of which
- differs little between the various styles.
-
-`muse-context-slides-header'
- 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.
-
-`muse-context-slides-markup-strings'
- Strings used for marking up text in ConTeXt slides.
-
-`muse-context-markup-specials-document'
- A table of characters which must be represented specially. These
- are applied to the entire document, sans already-escaped regions.
-
-`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.
-
-`muse-context-markup-specials-literal'
- A table of characters which must be represented specially. This
- applies to =monospaced text= and <code> regions.
-
-`muse-context-markup-specials-url'
- A table of characters which must be represented specially. These
- are applied to URLs.
-
-`muse-context-markup-specials-image'
- A table of characters which must be represented specially. These
- are applied to image filenames.
-
-`muse-context-permit-contents-tag'
- 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.
-
-
-
-File: muse.info, Node: DocBook, Next: HTML, Prev: ConTeXt, Up: Publishing
Styles
-
-9.4 Publishing in DocBook XML form
-==================================
-
-This publishing style is used to generate DocBook XML files.
-
-Styles provided
----------------
-
-`docbook'
- Publish a file in Docbook form.
-
-
-Options provided
-----------------
-
-This publishing style uses the same options for markup up special
-characters as the "xml" publishing style. *Note XML::, for details.
-
-`muse-docbook-extension'
- Default file extension for publishing DocBook XML files.
-
-`muse-docbook-header'
- Header used for publishing DocBook XML files.
-
- This may be text or a filename.
-
-`muse-docbook-footer'
- Footer used for publishing DocBook XML files.
-
- This may be text or a filename.
-
-`muse-docbook-markup-regexps'
- List of markup rules for publishing a Muse page to DocBook XML.
-
-`muse-docbook-markup-functions'
- An alist of style types to custom functions for that kind of text.
-
-`muse-docbook-markup-strings'
- Strings used for marking up text.
-
- These cover the most basic kinds of markup, the handling of which
- differs little between the various styles.
-
-`muse-docbook-encoding-default'
- The default Emacs buffer encoding to use in published files. This
- will be used if no special characters are found.
-
-`muse-docbook-charset-default'
- The default DocBook XML charset to use if no translation is found
- in `muse-xml-encoding-map'.
-
-
-
-File: muse.info, Node: HTML, Next: Ikiwiki, Prev: DocBook, Up: Publishing
Styles
-
-9.5 Publishing in HTML or XHTML form
-====================================
-
-This publishing style is capable of producing HTML or XHTML documents.
-
-Styles provided
----------------
-
-`html'
- Supports publishing to HTML 4.0 and HTML 4.01, Strict or
- Transitional.
-
-`xhtml'
- Supports publishing to XHTML 1.0 and XHTML 1.1, Strict or
- Transitional.
-
-
-Options provided
-----------------
-
-If an HTML option does not have a corresponding XHTML option, it will
-be used for both of these publishing styles.
-
- These publishing styles use the same options for markup up special
-characters as the "xml" publishing style. *Note XML::, for details.
-
-`muse-html-extension'
- Default file extension for publishing HTML files.
-
-`muse-xhtml-extension'
- Default file extension for publishing XHTML files.
-
-`muse-html-style-sheet'
- 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.
-
- If you are publishing to XHTML, then customize the
- `muse-xhtml-style-sheet' option instead.
-
-`muse-xhtml-style-sheet'
- 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.
-
-`muse-html-header'
- Header used for publishing HTML files.
-
- This may be text or a filename.
-
-`muse-html-footer'
- Footer used for publishing HTML files.
-
- This may be text or a filename.
-
-`muse-xhtml-header'
- Header used for publishing XHTML files.
-
- This may be text or a filename.
-
-`muse-xhtml-footer'
- Footer used for publishing XHTML files.
-
- This may be text or a filename.
-
-`muse-html-anchor-on-word'
- 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.
-
-`muse-html-table-attributes'
- The attribute to be used with HTML <table> tags.
-
- If you want to make more-complicated tables in HTML, surround the
- HTML with the literal tag, so that it does not get escaped.
-
-`muse-html-markup-regexps'
- List of markup rules for publishing a Muse page to HTML.
-
-`muse-html-markup-functions'
- An alist of style types to custom functions for that kind of text.
-
-`muse-html-markup-strings'
- 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.
-
-`muse-xhtml-markup-strings'
- 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.
-
-`muse-html-markup-tags'
- A list of tag specifications, for specially marking up HTML.
- *Note muse-publish-markup-tags::, for more information.
-
-`muse-html-meta-http-equiv'
- The http-equiv attribute used for the HTML <meta> tag.
-
-`muse-html-meta-content-type'
- 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".
-
-`muse-html-meta-content-encoding'
- The charset to append to the HTML <meta> tag.
-
- If set to the symbol 'detect, use `muse-xml-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.
-
-`muse-html-charset-default'
- The default HTML meta charset to use if no translation is found in
- `muse-xml-encoding-map'.
-
-`muse-html-encoding-default'
- The default Emacs buffer encoding to use in published files. This
- will be used if no special characters are found.
-
-
-
-File: muse.info, Node: Ikiwiki, Next: Journal, Prev: HTML, Up: Publishing
Styles
-
-9.6 Integrating with ikiwiki
-============================
-
-Note: Support for Ikiwiki is not yet complete. Use at your own risk.
-
- Ikiwiki is a wiki compiler (`http://ikiwiki.info/'). Emacs Muse can
-(not yet) be used as a source format for Ikiwiki pages with the plugin
-`IkiWiki::Plugin::muse'.
-
- The `lisp/muse-ikiwiki.el' file provides publishing functions and
-styles for Ikiwiki. The plugin for Ikiwiki to recognize Muse files is
-provided by the `contrib/ikiwiki/IkiWiki/Plugin/muse.pm' file. Two
-sample init files are available in the `examples/ikiwiki' directory.
-Configure your `ikiwiki.setup' file so that the `muse_init' variable
-has the location of your Muse init file.
-
- If you are using CGI, The directory `contrib/ikiwiki/IkiWiki' must
-be copied to the same directory as the CGI script that Ikiwiki
-generates. When publishing your wiki, the PERL5LIB environment
-variable must contain the path to the `contrib/ikiwiki/IkiWiki'
-directory.
-
-Styles provided
----------------
-
-`ikiwiki'
- Supports publishing XHTML output that Ikiwiki can understand.
-
-
-Options provided
-----------------
-
-`muse-ikiwiki-header'
- Header used for publishing Ikiwiki output files.
-
- This may be text or a filename.
-
-`muse-ikiwiki-footer'
- Footer used for publishing Ikiwiki output files.
-
- This may be text or a filename.
-
-
-Other relevant options
-----------------------
-
-`muse-colors-evaluate-lisp-tags'
- Specify whether to evaluate the contents of <lisp> tags at display
- time. If nil, don't evaluate them. If non-nil, evaluate them.
-
- The actual contents of the buffer are not changed, only the
- displayed text.
-
-`muse-html-src-allowed-modes'
- 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.
-
-`muse-publish-enable-dangerous-tags'
- If non-nil, publish tags like <lisp> and <command> that can call
- external programs or expose sensitive information. Otherwise,
- ignore tags like this.
-
- This is useful to set to `nil' when the file to publish is coming
- from an untrusted source.
-
-
-
-File: muse.info, Node: Journal, Next: LaTeX, Prev: Ikiwiki, Up: Publishing
Styles
-
-9.7 Keeping a journal or blog
-=============================
-
-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 the following.
-
- <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 auto-generates tags
-for linking to the various entries.
-
-muse-project-alist considerations
----------------------------------
-
-If you wish to publish an RDF or RSS feed, it is important to include
-the `:base-url' attribute in your `muse-project-alist' entry for your
-Journal projects. An example follows.
-
- (setq muse-project-alist
- '(("Journal" ("~/Journal/"
- :default "journal")
- (:base "journal-rss"
- :base-url "http://example.org/journal/";
- :path "~/public_html/journal"))))
-
-Styles provided
----------------
-
-`journal-html'
- Publish journal entries as an HTML document.
-
-`journal-xhtml'
- Publish journal entries as an XHTML document.
-
-`journal-latex'
- Publish journal entries as a LaTeX document.
-
-`journal-pdf'
- Publish journal entries as a PDF document.
-
-`journal-book-latex'
- Publish journal entries as a LaTeX book.
-
-`journal-book-pdf'
- Publish journal entries as a PDF book.
-
-`journal-rdf'
- Publish journal entries as an RDF file (RSS 1.0).
-
-`journal-rss'
- Publish journal entries as an RSS file (RSS 2.0).
-
-`journal-rss-entry'
- Used internally by `journal-rss' and `journal-rdf' for publishing
- individual entries.
-
-
-Options provided
-----------------
-
-`muse-journal-heading-regexp'
- 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.
-
-`muse-journal-date-format'
- Date format to use for journal entries.
-
-`muse-journal-html-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.
-
-`muse-journal-html-entry-template'
- Template used to publish individual journal entries as HTML.
-
- This may be text or a filename.
-
-`muse-journal-latex-section'
- Template used to publish a LaTeX section.
-
-`muse-journal-latex-subsection'
- Template used to publish a LaTeX subsection.
-
-`muse-journal-markup-tags'
- A list of tag specifications, for specially marking up Journal
- entries.
-
- *Note muse-publish-markup-tags::, for more information.
-
- 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.
-
-`muse-journal-rdf-extension'
- Default file extension for publishing RDF (RSS 1.0) files.
-
-`muse-journal-rdf-base-url'
- The base URL of the website referenced by the RDF file.
-
-`muse-journal-rdf-header'
- Header used for publishing RDF (RSS 1.0) files.
-
- This may be text or a filename.
-
-`muse-journal-rdf-footer'
- Footer used for publishing RDF (RSS 1.0) files.
-
- This may be text or a filename.
-
-`muse-journal-rdf-date-format'
- Date format to use for RDF entries.
-
-`muse-journal-rdf-entry-template'
- Template used to publish individual journal entries as RDF.
-
- This may be text or a filename.
-
-`muse-journal-rdf-summarize-entries'
- If non-nil, include only summaries in the RDF file, not the full
- data.
-
- The default is nil, because this annoys some subscribers.
-
-`muse-journal-rss-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.
-
-`muse-journal-rss-extension'
- Default file extension for publishing RSS 2.0 files.
-
-`muse-journal-rss-base-url'
- The base URL of the website referenced by the RSS file.
-
-`muse-journal-rss-header'
- Header used for publishing RSS 2.0 files.
-
- This may be text or a filename.
-
-`muse-journal-rss-footer'
- Footer used for publishing RSS 2.0 files.
-
- This may be text or a filename.
-
-`muse-journal-rss-date-format'
- Date format to use for RSS 2.0 entries.
-
-`muse-journal-rss-entry-template'
- Template used to publish individual journal entries as RSS 2.0.
-
- This may be text or a filename.
-
-`muse-journal-rss-enclosure-types-alist'
- File types that are accepted as RSS enclosures.
-
- This is an alist that maps file extension to content type.
-
- Useful for podcasting.
-
-`muse-journal-rss-summarize-entries'
- If non-nil, include only summaries in the RSS file, not the full
- data.
-
- The default is nil, because this annoys some subscribers.
-
-`muse-journal-rss-markup-regexps'
- List of markup rules for publishing a Muse journal page to RSS.
-
- For more information on the structure of this list, *Note
- muse-publish-markup-regexps::.
-
-`muse-journal-rss-markup-functions'
- An alist of style types to custom functions for that kind of text.
-
- For more on the structure of this list, *Note
- muse-publish-markup-functions::.
-
-
-
-File: muse.info, Node: LaTeX, Next: Poem, Prev: Journal, Up: Publishing
Styles
-
-9.8 Publishing LaTeX documents
-==============================
-
-This publishing style is capable of producing LaTeX or PDF documents.
-
- If you wish to publish PDF documents, you will need to have a good
-LaTeX installation. For Debian and Ubuntu, this can be accomplished by
-installing the "tetex-bin" and "tetex-extra" packages. TeX fonts are
-also a must.
-
- If your LaTeX installation has the file `grffile.sty', which may be
-found in the `texlive-latex-recommended' package for Debian and Ubuntu,
-then consider using it by adding the following to your header file.
-This allows spaces in filenames to work.
-
- \usepackage{grffile}
-
-Styles provided
----------------
-
-`latex'
- Publish a LaTeX document.
-
-`pdf'
- Publish a PDF document, using an external LaTeX document conversion
- tool.
-
-`latexcjk'
- Publish a LaTeX document with CJK (Chinese) encodings.
-
-`pdfcjk'
- Publish a PDF document with CJK (Chinese) encodings, using an
- external LaTeX document conversion tool.
-
-`slides'
- Publish a LaTeX document that uses the Beamer extension. This is
- suitable for producing slides.
-
- Here is an example of a slide.
-
- <slide title="First Slide">
- Everything between the slide tags composes this slide.
-
- [[Some-sort-of-cute-image.png]]
-
- - A bullet point.
- - Another bullet point.
- </slide>
-
-`slides-pdf'
- Publish a PDF document of slides, using the Beamer extension.
-
-`lecture-notes'
- Publish a LaTeX document that uses the Beamer extension. This is
- suitable for producing lecture notes.
-
- This can also use the <slide> tag.
-
-`lecture-notes-pdf'
- Publish a PDF document of lecture notes, using the Beamer
- extension.
-
-
-Options provided
-----------------
-
-`muse-latex-extension'
- Default file extension for publishing LaTeX files.
-
-`muse-latex-pdf-extension'
- Default file extension for publishing LaTeX files to PDF.
-
-`muse-latex-pdf-browser'
- The program to use when browsing a published PDF file.
-
- This should be a format string.
-
-`muse-latex-pdf-program'
- The program that is called to generate PDF content from LaTeX
- content.
-
-`muse-latex-pdf-cruft'
- Extensions of files to remove after generating PDF output
- successfully.
-
-`muse-latex-header'
- Header used for publishing LaTeX files.
-
- This may be text or a filename.
-
-`muse-latex-footer'
- Footer used for publishing LaTeX files.
-
- This may be text or a filename.
-
-`muse-latexcjk-header'
- Header used for publishing LaTeX files (CJK).
-
- This may be text or a filename.
-
-`muse-latexcjk-footer'
- Footer used for publishing LaTeX files (CJK).
-
- This may be text or a filename.
-
-`muse-latex-slides-header'
- 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.
-
-`muse-latex-lecture-notes-header'
- Header 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.
-
-`muse-latex-markup-regexps'
- List of markup regexps for identifying regions in a Muse page.
-
- For more on the structure of this list, *Note
- muse-publish-markup-regexps::.
-
-`muse-latex-markup-functions'
- An alist of style types to custom functions for that kind of text.
-
- For more on the structure of this list, *Note
- muse-publish-markup-functions::.
-
-`muse-latex-markup-strings'
- Strings used for marking up text.
-
- These cover the most basic kinds of markup, the handling of which
- differs little between the various styles.
-
-`muse-latex-slides-markup-tags'
- A list of tag specifications, for specially marking up LaTeX
- slides.
-
-`muse-latexcjk-encoding-map'
- An alist mapping emacs coding systems to appropriate CJK codings.
- Use the base name of the coding system (ie, without the -unix).
-
-`muse-latexcjk-encoding-default'
- The default Emacs buffer encoding to use in published files.
-
- This will be used if no special characters are found.
-
-`muse-latex-markup-specials-document'
- A table of characters which must be represented specially. These
- are applied to the entire document, sans already-escaped regions.
-
-`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.
-
-`muse-latex-markup-specials-literal'
- A table of characters which must be represented specially. This
- applies to =monospaced text= and <code> regions.
-
-`muse-latex-markup-specials-url'
- A table of characters which must be represented specially. These
- are applied to URLs.
-
-`muse-latex-markup-specials-image'
- A table of characters which must be represented specially. These
- are applied to image filenames.
-
-`muse-latex-permit-contents-tag'
- 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.
-
-
-
-File: muse.info, Node: Poem, Next: Texinfo, Prev: LaTeX, Up: Publishing
Styles
-
-9.9 Publish a poem to LaTeX or PDF
-==================================
-
-The `muse-poem' module makes it easy to attractively publish and
-reference poems in the following format, using the "memoir" module for
-LaTeX publishing. It will also markup poems for every other output
-style, though none are nearly as pretty.
-
- Title
-
-
- Body of poem
-
-
- Annotations, history, notes, etc.
-
- 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
-
- John Wiegley uses this module for publishing all of the poems on his
-website, which are at `http://www.newartisans.com/johnw/poems.html'.
-
-Styles provided
----------------
-
-`poem-latex'
- Publish a poem in LaTeX form.
-
-`poem-pdf'
- Publish a poem to a PDF document.
-
-`chapbook-latex'
- Publish a book of poems in LaTeX form.
-
-`chapbook-pdf'
- Publish a book of poems to a PDF document.
-
-
-Options provided
-----------------
-
-`muse-poem-latex-header'
- Header used for publishing LaTeX poems.
-
- This may be text or a filename.
-
-`muse-poem-latex-footer'
- Footer used for publishing LaTeX files.
-
- This may be text or a filename.
-
-`muse-poem-markup-strings'
- Strings used for marking up poems.
-
- These cover the most basic kinds of markup, the handling of which
- differs little between the various styles.
-
-`muse-chapbook-latex-header'
- Header used for publishing a book of poems in LaTeX form.
-
- This may be text or a filename.
-
-`muse-chapbook-latex-footer'
- Footer used for publishing a book of poems in LaTeX form.
-
- This may be text or a filename.
-
-`muse-poem-chapbook-strings'
- 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.
-
-
-
-File: muse.info, Node: Texinfo, Next: XML, Prev: Poem, Up: Publishing
Styles
-
-9.10 Publish entries to Texinfo format or PDF
-=============================================
-
-Rules for publishing a Muse file as a Texinfo article.
-
-Styles provided
----------------
-
-`texi'
- Publish a file in Texinfo form.
-
-`info'
- Generate an Info file from a Muse file.
-
-`info-pdf'
- Publish a file in PDF form.
-
-
-Options provided
-----------------
-
-`muse-texinfo-process-natively'
- If non-nil, use the Emacs `texinfmt' module to make Info files.
-
-`muse-texinfo-extension'
- Default file extension for publishing Texinfo files.
-
-`muse-texinfo-info-extension'
- Default file extension for publishing Info files.
-
-`muse-texinfo-pdf-extension'
- Default file extension for publishing PDF files.
-
-`muse-texinfo-header'
- Text to prepend to a Muse page being published as Texinfo.
-
- This may be text or a filename. It may contain <lisp> markup tags.
-
-`muse-texinfo-footer'
- Text to append to a Muse page being published as Texinfo.
-
- This may be text or a filename. It may contain <lisp> markup tags.
-
-`muse-texinfo-markup-regexps'
- List of markup rules for publishing a Muse page to Texinfo.
-
- For more on the structure of this list, *Note
- muse-publish-markup-regexps::.
-
-`muse-texinfo-markup-functions'
- An alist of style types to custom functions for that kind of text.
-
- For more on the structure of this list, *Note
- muse-publish-markup-functions::.
-
-`muse-texinfo-markup-strings'
- Strings used for marking up text.
-
- These cover the most basic kinds of markup, the handling of which
- differs little between the various styles.
-
-`muse-texinfo-markup-specials'
- A table of characters which must be represented specially.
-
-`muse-texinfo-markup-specials'
- A table of characters which must be represented specially. These
- are applied to URLs.
-
-
-
-File: muse.info, Node: XML, Prev: Texinfo, Up: Publishing Styles
-
-9.11 Publish entries to XML
-===========================
-
-Muse is capable of publishing XML documents, with the help of the
-`muse-xml.el' module.
-
- A RelaxNG schema is available as part of the Muse distribution in the
-`etc/muse.rnc' file.
-
-Styles provided
----------------
-
-`xml'
- Publish a file in XML form.
-
-
-Options provided
-----------------
-
-`muse-xml-encoding-map'
- An alist mapping Emacs coding systems to appropriate XML charsets.
- Use the base name of the coding system (i.e. without the -unix).
-
-`muse-xml-markup-specials'
- A table of characters which must be represented specially in all
- XML-like markup formats.
-
-`muse-xml-markup-specials-url-extra'
- A table of characters which must be represented specially in all
- XML-like markup formats.
-
- These are extra characters that are escaped within URLs.
-
-`muse-xml-extension'
- Default file extension used for publishing XML files.
-
-`muse-xml-header'
- Header used for publishing XML files.
-
- This may be text or a filename.
-
-`muse-xml-footer'
- Footer used for publishing XML files.
-
- This may be text or a filename.
-
-`muse-xml-markup-regexps'
- List of markup rules for publishing a Muse page to XML.
-
- For more on the structure of this list, *Note
- muse-publish-markup-regexps::.
-
-`muse-xml-markup-functions'
- An alist of style types to custom functions for that kind of text.
-
- For more on the structure of this list, *Note
- muse-publish-markup-functions::.
-
-`muse-xml-markup-strings'
- Strings used for marking up text.
-
- These cover the most basic kinds of markup, the handling of which
- differs little between the various styles.
-
-`muse-xml-encoding-default'
- The default Emacs buffer encoding to use in published files.
-
- This will be used if no special characters are found.
-
-`muse-xml-charset-default'
- The default XML charset to use if no translation is found in
- `muse-xml-encoding-map'.
-
-
-
-File: muse.info, Node: Extending Muse, Next: Miscellaneous, Prev:
Publishing Styles, Up: Top
-
-10 Making your own publishing styles
-************************************
-
-* Menu:
-
-* Markup Functions:: Specifying functions to mark up text.
-* Markup Regexps:: Markup rules for publishing.
-* Markup Strings:: Strings specific to a publishing style.
-* Markup Tags:: Tag specifications for special markup.
-* Style Elements:: Parameters used for defining styles.
-* Deriving Styles:: Deriving a new style from an existing
- one.
-
-
-File: muse.info, Node: Markup Functions, Next: Markup Regexps, Up:
Extending Muse
-
-10.1 Specifying functions to mark up text
-=========================================
-
-`muse-publish-markup-functions'
-
- An alist of style types to custom functions for that kind of text.
-
- This is used by publishing styles to attempt to minimize the amount
-of custom regexps that each has to define. `muse-publish' provides
-rules for the most common types of markup.
-
- Each member of the list is of the following form.
-
- (SYMBOL FUNCTION)
-
- * SYMBOL Describes the type of text to associate with this rule.
- `muse-publish-markup-regexps' maps regexps to these symbols.
-
- * FUNCTION Function to use to mark up this kind of rule if no
- suitable function is found through the `:functions' tag of the
- current style.
-
-
-File: muse.info, Node: Markup Regexps, Next: Markup Strings, Prev: Markup
Functions, Up: Extending Muse
-
-10.2 Markup rules for publishing
-================================
-
-`muse-publish-markup-regexps'
-
- List of markup rules for publishing a page with Muse.
-
- The rules given in this variable are invoked first, followed by
-whatever rules are specified by the current style.
-
- Each member of the list is either a function, or a list of the
-following form.
-
- (REGEXP/SYMBOL TEXT-BEGIN-GROUP REPLACEMENT-TEXT/FUNCTION/SYMBOL)
-
- * REGEXP A regular expression, or symbol whose value is a regular
- expression, which is searched for using `re-search-forward'.
-
- * TEXT-BEGIN-GROUP The matching group within that regexp which
- denotes the beginning of the actual text to be marked up.
-
- * REPLACEMENT-TEXT A string that will be passed to `replace-match'.
-
- If it is not a string, but a function, it will be called to
- determine what the replacement text should be (it must return a
- string). If it is a symbol, the value of that symbol should be a
- string.
-
- The replacements are done in order, one rule at a time. Writing the
-regular expressions can be a tricky business. Note that case is never
-ignored. `case-fold-search' is always bound to nil while processing
-the markup rules.
-
-Publishing order
-----------------
-
-This is the order that the publishing rules are consulted, by default.
-This may be changed by customizing `muse-publish-markup-regexps'.
-
-`trailing and leading whitespace'
- Remove trailing and leading whitespace from a file.
-
-`directive'
- `#directive'
-
- This is only recognized at the beginning of a file.
-
-`comment'
- `; a commented line'
-
-`tag'
- `<tag>'
-
-`comment'
- `; comment'
-
-`explicit links'
- Prevent emphasis characters in explicit links from being marked up.
-
- Don't actually publish them here, just add a special no-emphasis
- text property.
-
-`word'
- Whitespace-delimited word, possibly with emphasis characters
-
- This function is responsible for marking up emphasis and escaping
- some specials.
-
-`heading'
- `** Heading'
-
- Outline-mode style headings.
-
-`enddots'
- `....'
-
- These are ellipses with a dot at end.
-
-`dots'
- `...'
-
- Ellipses.
-
-`rule'
- `----'
-
- Horizontal rule or section separator.
-
-`no-break-space'
- `~~'
-
- Prevent lines from being split before or after these characters.
-
-`line-break'
- `<br>'
-
- Break a line at point.
-
-`fn-sep'
- `Footnotes:'
-
- Beginning of footnotes section.
-
-`footnote'
- `[1]'
-
- Footnote definition or reference. If at beginning of line, it is a
- definition.
-
-`list'
- * ` 1. '
-
- * ` - '
-
- * `term :: '
-
- Numbered list, item list, or term definition list.
-
-`table-el'
- `table.el' style tables
-
-`table'
- `table | cells'
-
- Muse tables or orgtbl-mode style tables.
-
-`quote'
- spaces before beginning of text
-
- Blockquotes.
-
-`emdash'
- `--'
-
- 2-wide dash
-
-`verse'
- `> verse text'
-
-`anchor'
- `#anchor'
-
-`link'
- `[[explicit][links]]'
-
-`url'
- `http://example.com/'
-
-`email'
- `bare-email@example.com'
-
-
-
-File: muse.info, Node: Markup Strings, Next: Markup Tags, Prev: Markup
Regexps, Up: Extending Muse
-
-10.3 Strings specific to a publishing style
-===========================================
-
-"Markup strings" are strings used for marking up text for a particular
-style.
-
- These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-Available markup strings
-------------------------
-
-`image-with-desc'
- An image and a description.
-
- Argument 1: image without extension. Argument 2: image extension.
- Argument 3: description.
-
-`image'
- An inlined image.
-
- Argument 1: image without extension. Argument 2: image extension.
-
-`image-link'
- An image with a link around it.
-
- Argument 1: link. Argument 2: image without extension. Argument
- 3: image extension.
-
-`anchor-ref'
- A reference to an anchor on the current page.
-
- Argument 1: anchor name. Argument 2: description if one exists,
- or the original link otherwise.
-
-`url'
- A URL without a description.
-
- Argument 1: URL.
-
-`link'
- A link to a Muse page with a description.
-
- Argument 1: link. Argument 2: description if one exists, or the
- original link otherwise.
-
-`link-and-anchor'
- A link to a Muse page with an anchor, and a description.
-
- Argument 1: link. Argument 2: anchor name. Argument 3:
- description if one exists, or the original link otherwise.
- Argument 4: link without an extension.
-
-`email-addr'
- A link to an email address.
-
- Argument 1: email address. Argument 2: email address.
-
-`anchor'
- An anchor.
-
- Argument 1: name of anchor.
-
-`emdash'
- A 2-length dash.
-
- Argument 1: Initial whitespace. Argument 2: Terminating
- whitespace.
-
-`comment-begin'
- Beginning of a comment.
-
-`comment-end'
- End of a comment.
-
-`rule'
- A horizontal line or space.
-
-`no-break-space'
- A space that separates two words which are not to be separated.
-
-`footnote'
- Beginning of footnote.
-
-`footnote-end'
- End of footnote.
-
-`footnotemark'
- Mark a reference for the current footnote.
-
- Argument 1: number of this footnote.
-
-`footnotemark-end'
- End of a reference for the current footnote.
-
-`footnotetext'
- Indicate the text of the current footnote.
-
- Argument 1: number of this footnote.
-
-`footnotetext-end'
- End of a footnote text line.
-
-`fn-sep'
- Text used to replace "Footnotes:" line.
-
-`dots'
- 3 dots.
-
-`enddots'
- 4 dots.
-
-`part'
- Beginning of a part indicator line. This is used by book
- publishing.
-
-`part-end'
- End of a part indicator line. This is used by book publishing.
-
-`chapter'
- Beginning of a chapter indicator line. This is used by book
- publishing.
-
-`chapter-end'
- End of a chapter indicator line. This is used by book publishing.
-
-`section'
- Beginning of level 1 section indicator line.
-
- Argument 1: level of section; always 1.
-
-`section-end'
- End of level 1 section indicator line.
-
- Argument 1: level of section; always 1.
-
-`subsection'
- Beginning of level 2 section indicator line.
-
- Argument 1: level of section; always 2.
-
-`subsection-end'
- End of level 2 section indicator line.
-
- Argument 1: level of section; always 2.
-
-`subsubsection'
- Beginning of level 3 section indicator line.
-
- Argument 1: level of section; always 3.
-
-`subsubsection-end'
- End of level 3 section indicator line.
-
- Argument 1: level of section; always 3.
-
-`section-other'
- Beginning of section indicator line, where level is greater than 3.
-
- Argument 1: level of section.
-
-`section-other-end'
- End of section indicator line, where level is greater than 3.
-
- Argument 1: level of section.
-
-`begin-underline'
- Beginning of underlined text.
-
-`end-underline'
- End of underlined text.
-
-`begin-literal'
- Beginning of verbatim text. This includes <code> tags and
- =teletype text=.
-
-`end-literal'
- End of verbatim text. This includes <code> tags and =teletype
- text=.
-
-`begin-emph'
- Beginning of the first level of emphasized text.
-
-`end-emph'
- End of the first level of emphasized text.
-
-`begin-more-emph'
- Beginning of the second level of emphasized text.
-
-`end-more-emph'
- End of the second level of emphasized text.
-
-`begin-most-emph'
- Beginning of the third (and final) level of emphasized text.
-
-`end-most-emph'
- End of the third (and final) level of emphasized text.
-
-`begin-verse'
- Beginning of verse text.
-
-`verse-space'
- String used to each space that is further indented than the
- beginning of the verse.
-
-`begin-verse-line'
- Beginning of a line of verse.
-
-`empty-verse-line'
- End of a line of verse.
-
-`begin-last-stanza-line'
- Beginning of the last line of a verse stanza.
-
-`end-last-stanza-line'
- End of the last line of a verse stanza.
-
-`end-verse'
- End of verse text.
-
-`begin-example'
- Beginning of an example region. To make use of this, an
- `<example>' tag is needed.
-
-`end-example'
- End of an example region. To make use of this, an `</example>' tag
- is needed.
-
-`begin-center'
- Begin a centered line.
-
-`end-center'
- End a centered line.
-
-`begin-quote'
- Begin a quoted region.
-
-`end-quote'
- End a quoted region.
-
-`begin-quote-item'
- Begin a quote paragraph.
-
-`end-quote-item'
- End a quote paragraph.
-
-`begin-uli'
- Begin an unordered list.
-
-`end-uli'
- End an unordered list.
-
-`begin-uli-item'
- Begin an unordered list item.
-
-`end-uli-item'
- End an unordered list item.
-
-`begin-oli'
- Begin an ordered list.
-
-`end-oli'
- End an ordered list.
-
-`begin-oli-item'
- Begin an ordered list item.
-
-`end-oli-item'
- End an ordered list item.
-
-`begin-dl'
- Begin a definition list.
-
-`end-dl'
- End a definition list.
-
-`begin-dl-item'
- Begin a definition list item.
-
-`end-dl-item'
- End a definition list item.
-
-`begin-ddt'
- Begin a definition list term.
-
-`end-ddt'
- End a definition list term.
-
-`begin-dde'
- Begin a definition list entry.
-
-`end-dde'
- End a definition list entry.
-
-`begin-table'
- Begin a table.
-
-`end-table'
- End a table.
-
-`begin-table-group'
- Begin a table grouping.
-
-`end-table-group'
- End a table grouping.
-
-`begin-table-row'
- Begin a table row.
-
-`end-table-row'
- End a table row.
-
-`begin-table-entry'
- Begin a table entry.
-
-`end-table-entry'
- End a table entry.
-
-
-
-File: muse.info, Node: Markup Tags, Next: Style Elements, Prev: Markup
Strings, Up: Extending Muse
-
-10.4 Tag specifications for special markup
-==========================================
-
-`muse-publish-markup-tags'
-
- A list of tag specifications, for specially marking up text.
-
- XML-style tags are the best way to add custom markup to Muse. This
-is easily accomplished by customizing this list of markup tags.
-
- For each entry, the name of the tag is given, whether it expects a
-closing tag and/or an optional set of attributes, whether it is
-nestable, and a function that performs whatever action is desired within
-the delimited region.
-
- The tags themselves are deleted during publishing, before the
-function is called. The function is called with three arguments, the
-beginning and end of the region surrounded by the tags. If properties
-are allowed, they are passed as a third argument in the form of an
-alist. The `end' argument to the function is always a marker.
-
- Point is always at the beginning of the region within the tags, when
-the function is called. Wherever point is when the function finishes is
-where tag markup will resume.
-
- These tag rules are processed once at the beginning of markup, and
-once at the end, to catch any tags which may have been inserted
-in-between.
-
-
-File: muse.info, Node: Style Elements, Next: Deriving Styles, Prev: Markup
Tags, Up: Extending Muse
-
-10.5 Parameters used for defining styles
-========================================
-
-Style elements are tags that define a style. Use either
-`muse-define-style' or `muse-derive-style' (*note Deriving Styles::) to
-create a new style.
-
- -- Function: muse-define-style name &rest elements
-
-Usable elements
----------------
-
-`:suffix'
- File extension to use for publishing files with this style.
-
-`:link-suffix'
- File extension to use for publishing links to Muse files with this
- style.
-
-`:osuffix'
- File extension to use for publishing second-stage files with this
- style.
-
- For example, PDF publishing generates a LaTeX file first, then a
- PDF from that LaTeX file.
-
-`:regexps'
- List of markup rules for publishing a page with Muse. *Note
- muse-publish-markup-regexps::.
-
-`:functions'
- An alist of style types to custom functions for that kind of text.
- *Note muse-publish-markup-functions::.
-
-`:strings'
- Strings used for marking up text with this style.
-
- These cover the most basic kinds of markup, the handling of which
- differs little between the various styles.
-
-`:tags'
- A list of tag specifications, used for handling extra tags. *Note
- muse-publish-markup-tags::.
-
-`:specials'
- A table of characters which must be represented specially.
-
-`:before'
- A function that is to be executed on the newly-created publishing
- buffer (or the current region) before any publishing occurs.
-
- This is used to set extra parameters that direct the publishing
- process.
-
-`:before-end'
- A function that is to be executed on the publishing buffer (or the
- current region) immediately after applying all of the markup
- regexps.
-
- This is used to fix the order of table elements (header, footer,
- body) in XML-ish styles.
-
-`:after'
- A function that is to be executed on the publishing buffer after
- :before-end, and immediately after inserting the header and footer.
-
- This is used for generating the table of contents as well as
- setting the file coding system.
-
-`:final'
- A function that is to be executed after saving the published file,
- but while still in its buffer.
-
- This is used for generating second-stage documents like PDF files
- from just-published LaTeX files.
-
- The function must accept three arguments: the name of the muse
- source file, the name of the just-published file, and the name of
- the second-stage target file. The name of the second-stage target
- file is the same as that of the just-published file if no
- second-stage publishing is required.
-
-`:header'
- Header used for publishing files of this style.
-
- This may be a variable, text, or a filename. It is inserted at the
- beginning of a file, after evaluating the publishing markup.
-
-`:footer'
- Footer used for publishing files of this style.
-
- This may be a variable, text, or a filename. It is inserted at
- the end of a file, after evaluating the publishing markup.
-
-`:style-sheet'
- Style sheet used for publishing files of this style.
-
- This may be a variable or text. It is used in the header of HTML
- and XHTML based publishing styles.
-
-`:browser'
- The function used to browse the published result of files of this
- style.
-
-
-
-File: muse.info, Node: Deriving Styles, Prev: Style Elements, Up: Extending
Muse
-
-10.6 Deriving a new style from an existing one
-==============================================
-
-To create a new style from an existing one, use `muse-derive-style' as
-follows. This is a good way to fix something you don't like about a
-particular publishing style, or to personalize it.
-
- -- Function: muse-derive-style new-name base-name &rest elements
-
- The derived name is a string defining the new style, such as
-"my-html". The base name must identify an existing style, such as
-"html" - if you have loaded `muse-html'. The style parameters are the
-same as those used to create a style, except that they override whatever
-definitions exist in the base style. However, some definitions only
-partially override. The following parameters support partial
-overriding.
-
- *Note Style Elements::, for a complete list of all parameters.
-
-`:functions'
- If a markup function is not found in the derived style's function
- list, the base style's function list will be queried.
-
-`:regexps'
- All regexps in the current style and the base style(s) will be
- used.
-
-`:strings'
- If a markup string is not found in the derived style's string
- list, the base style's string list will be queried.
-
-
-
-File: muse.info, Node: Miscellaneous, Next: Getting Help and Reporting Bugs,
Prev: Extending Muse, Up: Top
-
-11 Miscellaneous add-ons, like a minor mode
-*******************************************
-
-* Menu:
-
-* Muse List Edit Minor Mode:: Edit lists easily in other major modes.
-
-
-File: muse.info, Node: Muse List Edit Minor Mode, Up: Miscellaneous
-
-11.1 Edit lists easily in other major modes
-===========================================
-
-`muse-list-edit-minor-mode' is meant to be used with other major modes,
-such as Message (for composing email) and debian-changelog-mode (for
-editing debian/changelog files).
-
- It implements practically perfect support for editing and filling
-lists. It can even handle nested lists. In addition to Muse-specific
-list items ("-", numbers, definition lists, footnotes), it can also
-handle items that begin with "*" or "+". Filling list items behaves in
-the same way that it does in Muse, regardless of whether filladapt is
-also enabled, which is the primary reason to use this tool.
-
-Installation
-------------
-
-To use it, add "(require 'muse-mode)" to your Emacs customization file
-and add the function `turn-on-muse-list-edit-minor-mode' to any mode
-hooks where you wish to enable this minor mode.
-
-Keybindings
------------
-
-`muse-list-edit-minor-mode' uses the following keybindings.
-
-`M-RET (`muse-l-e-m-m-insert-list-item')'
- Insert a new list item at point, using the indentation level of the
- current list item.
-
-`C-< (`muse-l-e-m-m-decrease-list-item-indent')'
- Decrease indentation of the current list item.
-
-`C-> (`muse-l-e-m-m-increase-list-item-indent')'
- Increase indentation of the current list item.
-
-
-Functions
----------
-
- -- Function: muse-list-edit-minor-mode
- This is a global minor mode for editing files with lists. It is
- meant to be used with other major modes, and not with Muse mode.
-
- Interactively, with no prefix argument, toggle the mode. With
- universal prefix ARG turn mode on. With zero or negative ARG turn
- mode off.
-
- This minor mode provides the Muse keybindings for editing lists,
- and support for filling lists properly.
-
- It recognizes not only Muse-style lists, which use the "-"
- character or numbers, but also lists that use asterisks or plus
- signs. This should make the minor mode generally useful.
-
- Definition lists and footnotes are also recognized.
-
- Note that list items may omit leading spaces, for compatibility
- with modes that set `left-margin', such as `debian-changelog-mode'.
-
- -- Function: turn-on-muse-list-edit-minor-mode
- Unconditionally turn on Muse list edit minor mode.
-
- -- Function: turn-off-muse-list-edit-minor-mode
- Unconditionally turn off Muse list edit minor mode.
-
-
-File: muse.info, Node: Getting Help and Reporting Bugs, Next: History,
Prev: Miscellaneous, Up: Top
-
-12 Getting Help and Reporting Bugs
-**********************************
-
-After you have read this guide, if you still have questions about Muse,
-or if you have bugs to report, there are several places you can go.
-
- * `http://www.emacswiki.org/cgi-bin/wiki/EmacsMuse' is the
- emacswiki.org page, and anyone may add tips, hints, or bug
- descriptions to it.
-
- * `http://mwolson.org/projects/EmacsMuse.html' is the web page that
- Michael Olson (the current maintainer) made for Muse.
-
- * Muse has several different mailing lists.
-
- `muse-el-announce'
- Low-traffic list for Muse-related announcements.
-
- You can join this mailing list (<muse-el-announce@gna.org>)
- using the subscription form at
- `http://mail.gna.org/listinfo/muse-el-announce/'. This
- mailing list is also available via Gmane
- (`http://gmane.org/'). The group is called
- `gmane.emacs.muse.announce'.
-
- `muse-el-discuss'
- Discussion, bugfixes, suggestions, tips, and the like for
- Muse. This mailing list also includes the content of
- muse-el-announce.
-
- You can join this mailing list (<muse-el-discuss@gna.org>)
- using the subscription form at
- `http://mail.gna.org/listinfo/muse-el-discuss/'. This mailing
- list is also available via Gmane with the identifier
- `gmane.emacs.muse.general'.
-
- `muse-el-logs'
- Log messages for commits made to Muse.
-
- You can join this mailing list (<muse-el-logs@gna.org>) using
- the subscription form at
- `http://mail.gna.org/listinfo/muse-el-logs/'. This mailing
- list is also available via Gmane with the identifier
- `gmane.emacs.muse.scm'.
-
- `muse-el-commits'
- Generated bug reports for Emacs Muse. If you use our
- bug-tracker at `https://gna.org/bugs/?group=muse-el', the bug
- reports will be sent to this list automatically.
-
- You can join this mailing list (<muse-el-commits@gna.org>)
- using the subscription form at
- `http://mail.gna.org/listinfo/muse-el-commits/'. This
- mailing list is also available via Gmane with the identifier
- `gmane.emacs.muse.cvs'.
-
- `muse-el-internationalization'
- Discussion of translation of the Muse website and
- documentation into many languages.
-
- You can join this mailing list
- (<muse-el-internationalization@gna.org>) using the
- subscription form at
- `http://mail.gna.org/listinfo/internationalization/'. This
- mailing list is also available via Gmane with the identifier
- `gmane.emacs.muse.internationalization'.
-
-
- * You can visit the IRC Freenode channel `#emacs'. Many of the
- contributors are frequently around and willing to answer your
- questions. The `#muse' channel is also available for
- Muse-specific help, and its current maintainer hangs out there.
-
- * The maintainer of Emacs Muse, Michael Olson, may be contacted at
- <mwolson@gnu.org>. He can be rather slow at answering email, so
- it is often better to use the muse-el-discuss mailing list.
-
-
-
-File: muse.info, Node: History, Next: Contributors, Prev: Getting Help and
Reporting Bugs, Up: Top
-
-13 History of This Document
-***************************
-
- * 2004 John Wiegley started Muse upon realizing that EmacsWiki had
- some serious limitations. Around February 2004, he started making
- "emacs-wiki version 3.00 APLHA", which eventually became known as
- Muse.
-
- Most of those who frequent the emacs-wiki mailing list continued
- to use emacs-wiki, mainly because Planner hasn't been ported over
- to it.
-
- As of 2004-12-01, Michael Olson became the maintainer of Muse, as
- per John Wiegley's request.
-
- * 2005 Michael Olson overhauled this document and added many new
- sections in preparation for the first release of Muse (3.01).
-
-
-
-File: muse.info, Node: Contributors, Next: GNU Free Documentation License,
Prev: History, Up: Top
-
-14 Contributors to This Documentation
-*************************************
-
-The first draft of this document was taken from the emacs-wiki texinfo
-manual. Michael Olson adapted it for Muse and added most of its
-content.
-
- John Sullivan did a majority of the work on the emacs-wiki texinfo
-manual.
-
- While Sacha Chua maintained emacs-wiki, she worked quite a bit on the
-emacs-wiki texinfo manual.
-
-
-File: muse.info, Node: GNU Free Documentation License, Next: Concept Index,
Prev: Contributors, Up: Top
-
-Appendix A GNU Free Documentation License
-*****************************************
-
- Version 1.2, November 2002
-
- Copyright (C) 2000,2001,2002 Free Software Foundation, Inc.
- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-
- 0. PREAMBLE
-
- The purpose of this License is to make a manual, textbook, or other
- functional and useful document "free" in the sense of freedom: to
- assure everyone the effective freedom to copy and redistribute it,
- with or without modifying it, either commercially or
- noncommercially. Secondarily, this License preserves for the
- author and publisher a way to get credit for their work, while not
- being considered responsible for modifications made by others.
-
- This License is a kind of "copyleft," which means that derivative
- works of the document must themselves be free in the same sense.
- It complements the GNU General Public License, which is a copyleft
- license designed for free software.
-
- We have designed this License in order to use it for manuals for
- free software, because free software needs free documentation: a
- free program should come with manuals providing the same freedoms
- that the software does. But this License is not limited to
- software manuals; it can be used for any textual work, regardless
- of subject matter or whether it is published as a printed book.
- We recommend this License principally for works whose purpose is
- instruction or reference.
-
-
- 1. APPLICABILITY AND DEFINITIONS
-
- This License applies to any manual or other work, in any medium,
- that contains a notice placed by the copyright holder saying it
- can be distributed under the terms of this License. Such a notice
- grants a world-wide, royalty-free license, unlimited in duration,
- to use that work under the conditions stated herein. The
- "Document," below, refers to any such manual or work. Any member
- of the public is a licensee, and is addressed as "you." You
- accept the license if you copy, modify or distribute the work in a
- way requiring permission under copyright law.
-
- A "Modified Version" of the Document means any work containing the
- Document or a portion of it, either copied verbatim, or with
- modifications and/or translated into another language.
-
- A "Secondary Section" is a named appendix or a front-matter
- section of the Document that deals exclusively with the
- relationship of the publishers or authors of the Document to the
- Document's overall subject (or to related matters) and contains
- nothing that could fall directly within that overall subject.
- (Thus, if the Document is in part a textbook of mathematics, a
- Secondary Section may not explain any mathematics.) The
- relationship could be a matter of historical connection with the
- subject or with related matters, or of legal, commercial,
- philosophical, ethical or political position regarding them.
-
- The "Invariant Sections" are certain Secondary Sections whose
- titles are designated, as being those of Invariant Sections, in
- the notice that says that the Document is released under this
- License. If a section does not fit the above definition of
- Secondary then it is not allowed to be designated as Invariant.
- The Document may contain zero Invariant Sections. If the Document
- does not identify any Invariant Sections then there are none.
-
- The "Cover Texts" are certain short passages of text that are
- listed, as Front-Cover Texts or Back-Cover Texts, in the notice
- that says that the Document is released under this License. A
- Front-Cover Text may be at most 5 words, and a Back-Cover Text may
- be at most 25 words.
-
- A "Transparent" copy of the Document means a machine-readable copy,
- represented in a format whose specification is available to the
- general public, that is suitable for revising the document
- straightforwardly with generic text editors or (for images
- composed of pixels) generic paint programs or (for drawings) some
- widely available drawing editor, and that is suitable for input to
- text formatters or for automatic translation to a variety of
- formats suitable for input to text formatters. A copy made in an
- otherwise Transparent file format whose markup, or absence of
- markup, has been arranged to thwart or discourage subsequent
- modification by readers is not Transparent. An image format is
- not Transparent if used for any substantial amount of text. A
- copy that is not "Transparent" is called "Opaque."
-
- Examples of suitable formats for Transparent copies include plain
- ASCII without markup, Texinfo input format, LaTeX input format,
- SGML or XML using a publicly available DTD, and
- standard-conforming simple HTML, PostScript or PDF designed for
- human modification. Examples of transparent image formats include
- PNG, XCF and JPG. Opaque formats include proprietary formats that
- can be read and edited only by proprietary word processors, SGML
- or XML for which the DTD and/or processing tools are not generally
- available, and the machine-generated HTML, PostScript or PDF
- produced by some word processors for output purposes only.
-
- The "Title Page" means, for a printed book, the title page itself,
- plus such following pages as are needed to hold, legibly, the
- material this License requires to appear in the title page. For
- works in formats which do not have any title page as such, "Title
- Page" means the text near the most prominent appearance of the
- work's title, preceding the beginning of the body of the text.
-
- A section "Entitled XYZ" means a named subunit of the Document
- whose title either is precisely XYZ or contains XYZ in parentheses
- following text that translates XYZ in another language. (Here XYZ
- stands for a specific section name mentioned below, such as
- "Acknowledgements," "Dedications," "Endorsements," or "History.")
- To "Preserve the Title" of such a section when you modify the
- Document means that it remains a section "Entitled XYZ" according
- to this definition.
-
- The Document may include Warranty Disclaimers next to the notice
- which states that this License applies to the Document. These
- Warranty Disclaimers are considered to be included by reference in
- this License, but only as regards disclaiming warranties: any other
- implication that these Warranty Disclaimers may have is void and
- has no effect on the meaning of this License.
-
- 2. VERBATIM COPYING
-
- You may copy and distribute the Document in any medium, either
- commercially or noncommercially, provided that this License, the
- copyright notices, and the license notice saying this License
- applies to the Document are reproduced in all copies, and that you
- add no other conditions whatsoever to those of this License. You
- may not use technical measures to obstruct or control the reading
- or further copying of the copies you make or distribute. However,
- you may accept compensation in exchange for copies. If you
- distribute a large enough number of copies you must also follow
- the conditions in section 3.
-
- You may also lend copies, under the same conditions stated above,
- and you may publicly display copies.
-
- 3. COPYING IN QUANTITY
-
- If you publish printed copies (or copies in media that commonly
- have printed covers) of the Document, numbering more than 100, and
- the Document's license notice requires Cover Texts, you must
- enclose the copies in covers that carry, clearly and legibly, all
- these Cover Texts: Front-Cover Texts on the front cover, and
- Back-Cover Texts on the back cover. Both covers must also clearly
- and legibly identify you as the publisher of these copies. The
- front cover must present the full title with all words of the
- title equally prominent and visible. You may add other material
- on the covers in addition. Copying with changes limited to the
- covers, as long as they preserve the title of the Document and
- satisfy these conditions, can be treated as verbatim copying in
- other respects.
-
- If the required texts for either cover are too voluminous to fit
- legibly, you should put the first ones listed (as many as fit
- reasonably) on the actual cover, and continue the rest onto
- adjacent pages.
-
- If you publish or distribute Opaque copies of the Document
- numbering more than 100, you must either include a
- machine-readable Transparent copy along with each Opaque copy, or
- state in or with each Opaque copy a computer-network location from
- which the general network-using public has access to download
- using public-standard network protocols a complete Transparent
- copy of the Document, free of added material. If you use the
- latter option, you must take reasonably prudent steps, when you
- begin distribution of Opaque copies in quantity, to ensure that
- this Transparent copy will remain thus accessible at the stated
- location until at least one year after the last time you
- distribute an Opaque copy (directly or through your agents or
- retailers) of that edition to the public.
-
- It is requested, but not required, that you contact the authors of
- the Document well before redistributing any large number of
- copies, to give them a chance to provide you with an updated
- version of the Document.
-
- 4. MODIFICATIONS
-
- You may copy and distribute a Modified Version of the Document
- under the conditions of sections 2 and 3 above, provided that you
- release the Modified Version under precisely this License, with
- the Modified Version filling the role of the Document, thus
- licensing distribution and modification of the Modified Version to
- whoever possesses a copy of it. In addition, you must do these
- things in the Modified Version:
-
- A. Use in the Title Page (and on the covers, if any) a title
- distinct from that of the Document, and from those of previous
- versions (which should, if there were any, be listed in the
- History section of the Document). You may use the same title
- as a previous version if the original publisher of that version
- gives permission.
- B. List on the Title Page, as authors, one or more persons or
- entities responsible for authorship of the modifications in the
- Modified Version, together with at least five of the principal
- authors of the Document (all of its principal authors, if it
- has fewer than five), unless they release you from this
- requirement.
- C. State on the Title page the name of the publisher of the
- Modified Version, as the publisher.
- D. Preserve all the copyright notices of the Document.
- E. Add an appropriate copyright notice for your modifications
- adjacent to the other copyright notices.
- F. Include, immediately after the copyright notices, a license
- notice giving the public permission to use the Modified Version
- under the terms of this License, in the form shown in the
- Addendum below.
- G. Preserve in that license notice the full lists of Invariant
- Sections and required Cover Texts given in the Document's
- license notice.
- H. Include an unaltered copy of this License.
- I. Preserve the section Entitled "History," Preserve its Title,
- and add to it an item stating at least the title, year, new
- authors, and publisher of the Modified Version as given on the
- Title Page. If there is no section Entitled "History" in the
- Document, create one stating the title, year, authors, and
- publisher of the Document as given on its Title Page, then add
- an item describing the Modified Version as stated in the
- previous sentence.
- J. Preserve the network location, if any, given in the Document for
- public access to a Transparent copy of the Document, and likewise
- the network locations given in the Document for previous versions
- it was based on. These may be placed in the "History" section.
- You may omit a network location for a work that was published at
- least four years before the Document itself, or if the original
- publisher of the version it refers to gives permission.
- K. For any section Entitled "Acknowledgements" or "Dedications,"
- Preserve the Title of the section, and preserve in the section all
- the substance and tone of each of the contributor
- acknowledgements and/or dedications given therein.
- L. Preserve all the Invariant Sections of the Document,
- unaltered in their text and in their titles. Section numbers
- or the equivalent are not considered part of the section titles.
- M. Delete any section Entitled "Endorsements." Such a section
- may not be included in the Modified Version.
- N. Do not retitle any existing section to be Entitled
- "Endorsements" or to conflict in title with any Invariant
- Section.
- O. Preserve any Warranty Disclaimers.
-
- If the Modified Version includes new front-matter sections or
- appendices that qualify as Secondary Sections and contain no
- material copied from the Document, you may at your option
- designate some or all of these sections as invariant. To do this,
- add their titles to the list of Invariant Sections in the Modified
- Version's license notice. These titles must be distinct from any
- other section titles.
-
- You may add a section Entitled "Endorsements," provided it contains
- nothing but endorsements of your Modified Version by various
- parties-for example, statements of peer review or that the text has
- been approved by an organization as the authoritative definition
- of a standard.
-
- You may add a passage of up to five words as a Front-Cover Text,
- and a passage of up to 25 words as a Back-Cover Text, to the end
- of the list of Cover Texts in the Modified Version. Only one
- passage of Front-Cover Text and one of Back-Cover Text may be
- added by (or through arrangements made by) any one entity. If the
- Document already includes a cover text for the same cover,
- previously added by you or by arrangement made by the same entity
- you are acting on behalf of, you may not add another; but you may
- replace the old one, on explicit permission from the previous
- publisher that added the old one.
-
- The author(s) and publisher(s) of the Document do not by this
- License give permission to use their names for publicity for or to
- assert or imply endorsement of any Modified Version.
-
- 5. COMBINING DOCUMENTS
-
- You may combine the Document with other documents released under
- this License, under the terms defined in section 4 above for
- modified versions, provided that you include in the combination
- all of the Invariant Sections of all of the original documents,
- unmodified, and list them all as Invariant Sections of your
- combined work in its license notice, and that you preserve all
- their Warranty Disclaimers.
-
- The combined work need only contain one copy of this License, and
- multiple identical Invariant Sections may be replaced with a single
- copy. If there are multiple Invariant Sections with the same name
- but different contents, make the title of each such section unique
- by adding at the end of it, in parentheses, the name of the
- original author or publisher of that section if known, or else a
- unique number. Make the same adjustment to the section titles in
- the list of Invariant Sections in the license notice of the
- combined work.
-
- In the combination, you must combine any sections Entitled
- "History" in the various original documents, forming one section
- Entitled "History"; likewise combine any sections Entitled
- "Acknowledgements," and any sections Entitled "Dedications." You
- must delete all sections Entitled "Endorsements."
-
- 6. COLLECTIONS OF DOCUMENTS
-
- You may make a collection consisting of the Document and other
- documents released under this License, and replace the individual
- copies of this License in the various documents with a single copy
- that is included in the collection, provided that you follow the
- rules of this License for verbatim copying of each of the
- documents in all other respects.
-
- You may extract a single document from such a collection, and
- distribute it individually under this License, provided you insert
- a copy of this License into the extracted document, and follow
- this License in all other respects regarding verbatim copying of
- that document.
-
- 7. AGGREGATION WITH INDEPENDENT WORKS
-
- A compilation of the Document or its derivatives with other
- separate and independent documents or works, in or on a volume of
- a storage or distribution medium, is called an "aggregate" if the
- copyright resulting from the compilation is not used to limit the
- legal rights of the compilation's users beyond what the individual
- works permit. When the Document is included in an aggregate, this
- License does not apply to the other works in the aggregate which
- are not themselves derivative works of the Document.
-
- If the Cover Text requirement of section 3 is applicable to these
- copies of the Document, then if the Document is less than one half
- of the entire aggregate, the Document's Cover Texts may be placed
- on covers that bracket the Document within the aggregate, or the
- electronic equivalent of covers if the Document is in electronic
- form. Otherwise they must appear on printed covers that bracket
- the whole aggregate.
-
- 8. TRANSLATION
-
- Translation is considered a kind of modification, so you may
- distribute translations of the Document under the terms of section
- 4. Replacing Invariant Sections with translations requires special
- permission from their copyright holders, but you may include
- translations of some or all Invariant Sections in addition to the
- original versions of these Invariant Sections. You may include a
- translation of this License, and all the license notices in the
- Document, and any Warranty Disclaimers, provided that you also
- include the original English version of this License and the
- original versions of those notices and disclaimers. In case of a
- disagreement between the translation and the original version of
- this License or a notice or disclaimer, the original version will
- prevail.
-
- If a section in the Document is Entitled "Acknowledgements,"
- "Dedications," or "History," the requirement (section 4) to
- Preserve its Title (section 1) will typically require changing the
- actual title.
-
- 9. TERMINATION
-
- You may not copy, modify, sublicense, or distribute the Document
- except as expressly provided for under this License. Any other
- attempt to copy, modify, sublicense or distribute the Document is
- void, and will automatically terminate your rights under this
- License. However, parties who have received copies, or rights,
- from you under this License will not have their licenses
- terminated so long as such parties remain in full compliance.
-
- 10. FUTURE REVISIONS OF THIS LICENSE
-
- The Free Software Foundation may publish new, revised versions of
- the GNU Free Documentation License from time to time. Such new
- versions will be similar in spirit to the present version, but may
- differ in detail to address new problems or concerns. See
- http://www.gnu.org/copyleft/.
-
- Each version of the License is given a distinguishing version
- number. If the Document specifies that a particular numbered
- version of this License "or any later version" applies to it, you
- have the option of following the terms and conditions either of
- that specified version or of any later version that has been
- published (not as a draft) by the Free Software Foundation. If
- the Document does not specify a version number of this License,
- you may choose any version ever published (not as a draft) by the
- Free Software Foundation.
-
-
-ADDENDUM: How to use this License for your documents
-====================================================
-
-To use this License in a document you have written, include a copy of
-the License in the document and put the following copyright and license
-notices just after the title page:
-
- Copyright (C) YEAR YOUR NAME.
- Permission is granted to copy, distribute and/or modify this document
- under the terms of the GNU Free Documentation License, Version 1.2
- or any later version published by the Free Software Foundation;
- with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
- A copy of the license is included in the section entitled ``GNU
- Free Documentation License.''
-
- If you have Invariant Sections, Front-Cover Texts and Back-Cover
-Texts, replace the "with...Texts." line with this:
-
- with the Invariant Sections being LIST THEIR TITLES, with the
- Front-Cover Texts being LIST, and with the Back-Cover Texts being
- LIST.
-
- If you have Invariant Sections without Cover Texts, or some other
-combination of the three, merge those two alternatives to suit the
-situation.
-
- If your document contains nontrivial examples of program code, we
-recommend releasing these examples in parallel under your choice of
-free software license, such as the GNU General Public License, to
-permit their use in free software.
-
-
-File: muse.info, Node: Concept Index, Prev: GNU Free Documentation License,
Up: Top
-
-Index
-*****
-
- [index ]
-* Menu:
-
-* #author: Directives. (line 18)
-* #date: Directives. (line 24)
-* #desc: Directives. (line 30)
-* #title: Directives. (line 36)
-* anchors: Horizontal Rules and Anchors.
- (line 13)
-* blog, journal style: Journal. (line 6)
-* blog, one-file-per-entry style: Blosxom. (line 6)
-* bugs, reporting: Getting Help and Reporting Bugs.
- (line 6)
-* citations: Citations. (line 6)
-* comments: Comments. (line 6)
-* compiling Muse: Installation. (line 11)
-* contributors: Contributors. (line 6)
-* dashes: Horizontal Rules and Anchors.
- (line 6)
-* Debian package for Muse: Releases. (line 12)
-* developer, becoming: Development. (line 91)
-* development: Development. (line 6)
-* directives: Directives. (line 6)
-* editing Muse files <1>: Publishing Files Overview.
- (line 6)
-* editing Muse files: Using Muse Mode. (line 6)
-* ELPA package for Muse: Installation. (line 64)
-* Email addresses: Implicit Links. (line 6)
-* emphasizing text: Emphasizing Text. (line 6)
-* examples: Paragraphs. (line 21)
-* file extension, specifying: File Extensions. (line 6)
-* footnotes: Footnotes. (line 6)
-* git version control system, using: Development. (line 9)
-* headings: Headings. (line 6)
-* help, getting: Getting Help and Reporting Bugs.
- (line 6)
-* history, of Muse: History. (line 6)
-* horizontal rules: Horizontal Rules and Anchors.
- (line 6)
-* HTML, inserting a raw block: Paragraphs. (line 28)
-* HTML, rendering blocks in monospace: Paragraphs. (line 21)
-* images: Images. (line 6)
-* images, captions: Images. (line 53)
-* images, displaying: Images. (line 22)
-* images, inlined: Images. (line 43)
-* images, local: Images. (line 22)
-* images, without descriptions: Images. (line 43)
-* inserting files at publish time: Tag Summary. (line 6)
-* installing Muse: Installation. (line 38)
-* inter-project links: Implicit Links. (line 29)
-* InterWiki links: Implicit Links. (line 29)
-* italicizing text: Emphasizing Text. (line 6)
-* journal: Journal. (line 6)
-* keystrokes: Keystroke Summary. (line 6)
-* line breaks: Paragraphs. (line 46)
-* links, explicit: Explicit Links. (line 6)
-* links, implicit: Implicit Links. (line 6)
-* links, raw: Implicit Links. (line 6)
-* links, with images: Images. (line 6)
-* links, with target on same page: Horizontal Rules and Anchors.
- (line 13)
-* lisp, and insert command: Embedded Lisp. (line 13)
-* lisp, embedded: Embedded Lisp. (line 6)
-* lists: Lists. (line 6)
-* lists, breaking lines: Lists. (line 52)
-* lists, bullets: Lists. (line 10)
-* lists, definitions: Lists. (line 24)
-* lists, enumerated: Lists. (line 17)
-* lists, nested: Lists. (line 36)
-* literal text: Paragraphs. (line 28)
-* markup: Markup Rules. (line 6)
-* monospace, rendering blocks: Paragraphs. (line 21)
-* monospace, rendering words: Emphasizing Text. (line 6)
-* muse-define-style: Style Elements. (line 11)
-* muse-derive-style: Deriving Styles. (line 11)
-* muse-list-edit-minor-mode: Muse List Edit Minor Mode.
- (line 44)
-* muse-project-alist, reference: Options for Projects. (line 6)
-* muse-xml-encoding-map: XML. (line 22)
-* paragraphs: Paragraphs. (line 6)
-* paragraphs, centered: Paragraphs. (line 8)
-* paragraphs, quoted: Paragraphs. (line 16)
-* poetry: Verse. (line 6)
-* projects: Projects. (line 6)
-* projects, multiple: Multiple Projects. (line 6)
-* projects, options: Options for Projects. (line 6)
-* projects, single: Single Project. (line 6)
-* projects, subdirectories: Projects and Subdirectories.
- (line 6)
-* publishing styles: Publishing Styles. (line 6)
-* publishing styles, blosxom-html: Blosxom Options. (line 12)
-* publishing styles, blosxom-xhtml: Blosxom Options. (line 15)
-* publishing styles, book-latex: Book. (line 56)
-* publishing styles, book-pdf: Book. (line 60)
-* publishing styles, chapbook-latex: Poem. (line 45)
-* publishing styles, chapbook-pdf: Poem. (line 48)
-* publishing styles, context: ConTeXt. (line 15)
-* publishing styles, context-pdf: ConTeXt. (line 18)
-* publishing styles, context-slides: ConTeXt. (line 22)
-* publishing styles, context-slides-pdf: ConTeXt. (line 40)
-* publishing styles, deriving: Deriving Styles. (line 6)
-* publishing styles, docbook: DocBook. (line 11)
-* publishing styles, html: HTML. (line 11)
-* publishing styles, ikiwiki: Ikiwiki. (line 28)
-* publishing styles, info-pdf: Texinfo. (line 17)
-* publishing styles, journal-book-latex: Journal. (line 82)
-* publishing styles, journal-book-pdf: Journal. (line 85)
-* publishing styles, journal-html: Journal. (line 70)
-* publishing styles, journal-latex: Journal. (line 76)
-* publishing styles, journal-pdf: Journal. (line 79)
-* publishing styles, journal-rdf: Journal. (line 88)
-* publishing styles, journal-rss: Journal. (line 91)
-* publishing styles, journal-rss-entry: Journal. (line 94)
-* publishing styles, journal-xhtml: Journal. (line 73)
-* publishing styles, latex: LaTeX. (line 23)
-* publishing styles, latexcjk: LaTeX. (line 30)
-* publishing styles, lecture-notes: LaTeX. (line 55)
-* publishing styles, lecture-notes-pdf: LaTeX. (line 61)
-* publishing styles, pdf: LaTeX. (line 26)
-* publishing styles, pdfcjk: LaTeX. (line 33)
-* publishing styles, poem-latex: Poem. (line 39)
-* publishing styles, poem-pdf: Poem. (line 42)
-* publishing styles, RSS 1.0: Journal. (line 88)
-* publishing styles, RSS 2.0: Journal. (line 91)
-* publishing styles, slides: LaTeX. (line 37)
-* publishing styles, slides-pdf: LaTeX. (line 52)
-* publishing styles, texi: Texinfo. (line 14)
-* publishing styles, xml: XML. (line 15)
-* publishing, including markup in headers and footers: Tag Summary.
- (line 6)
-* publishing, inserting files: Tag Summary. (line 6)
-* publishing, markup functions: Markup Functions. (line 6)
-* publishing, markup regexps: Markup Regexps. (line 6)
-* publishing, markup strings: Markup Strings. (line 6)
-* publishing, markup tags: Markup Tags. (line 6)
-* publishing, omitting lines: Comments. (line 6)
-* publishing, rules: Markup Regexps. (line 6)
-* publishing, style elements: Style Elements. (line 6)
-* quotations: Paragraphs. (line 16)
-* releases, Debian package: Releases. (line 12)
-* releases, from source: Releases. (line 31)
-* releases, Ubuntu package: Releases. (line 19)
-* settings: Getting Started. (line 6)
-* settings, init file: Loading Muse. (line 6)
-* tables: Tables. (line 6)
-* tables, orgtbl-mode style: Tables. (line 26)
-* tables, simple: Tables. (line 6)
-* tables, table.el style: Tables. (line 42)
-* tags: Tag Summary. (line 6)
-* tags, <cite>: Citations. (line 6)
-* turn-off-muse-list-edit-minor-mode: Muse List Edit Minor Mode.
- (line 67)
-* turn-on-muse-list-edit-minor-mode: Muse List Edit Minor Mode.
- (line 64)
-* Ubuntu package for Muse: Releases. (line 19)
-* underlining text: Emphasizing Text. (line 6)
-* updating Muse with git: Development. (line 66)
-* URLs: Implicit Links. (line 6)
-* verbatim text: Emphasizing Text. (line 6)
-* verses: Verse. (line 6)
-* verses, multiple stanzas: Verse. (line 20)
-* WikiNames: Implicit Links. (line 18)
-* WYSIWYG: Emphasizing Text. (line 15)
-
-
-
-Tag Table:
-Node: Top1427
-Node: Preface7398
-Node: Introduction7871
-Node: Obtaining Muse9320
-Node: Releases9657
-Node: Development11046
-Node: Installation14905
-Node: Getting Started17564
-Node: Loading Muse17946
-Node: Using Muse Mode18893
-Node: Publishing Files Overview20926
-Node: File Extensions22170
-Node: Projects23390
-Node: Single Project24012
-Node: Multiple Projects24962
-Node: Projects and Subdirectories26365
-Node: Options for Projects28048
-Node: Keystroke Summary32872
-Node: Markup Rules34991
-Node: Paragraphs36710
-Node: Headings38711
-Node: Directives39334
-Node: Emphasizing Text40654
-Node: Footnotes41431
-Node: Verse42068
-Node: Lists42812
-Node: Tables44361
-Node: Explicit Links46095
-Node: Implicit Links46810
-Node: Images49153
-Node: Horizontal Rules and Anchors51643
-Node: Embedded Lisp52291
-Node: Citations53387
-Node: Comments55871
-Node: Tag Summary56530
-Node: Publishing Styles64773
-Node: Blosxom65872
-Node: Blosxom Requirements66479
-Node: Blosxom Entries70014
-Node: Blosxom Options71577
-Node: Book72505
-Node: ConTeXt75564
-Node: DocBook79691
-Node: HTML81168
-Node: Ikiwiki85163
-Node: Journal87502
-Node: LaTeX94029
-Node: Poem99573
-Node: Texinfo101782
-Node: XML103699
-Node: Extending Muse105730
-Node: Markup Functions106367
-Ref: muse-publish-markup-functions106540
-Node: Markup Regexps107194
-Ref: muse-publish-markup-regexps107372
-Node: Markup Strings110379
-Node: Markup Tags116839
-Ref: muse-publish-markup-tags117032
-Node: Style Elements118151
-Node: Deriving Styles121558
-Node: Miscellaneous122857
-Node: Muse List Edit Minor Mode123142
-Node: Getting Help and Reporting Bugs125621
-Node: History128923
-Node: Contributors129706
-Node: GNU Free Documentation License130214
-Node: Concept Index152443
-
-End Tag Table
diff --git a/packages/muse/texi/Makefile b/packages/muse/texi/Makefile
deleted file mode 100644
index 8f9f341..0000000
--- a/packages/muse/texi/Makefile
+++ /dev/null
@@ -1,29 +0,0 @@
-.PHONY: all info-only doc clean realclean distclean fullclean install
-.PRECIOUS: %.info %.html
-
-DEFS = $(shell test -f ../Makefile.defs && echo ../Makefile.defs \
- || echo ../Makefile.defs.default)
-
-include $(DEFS)
-
-all: doc
-
-%.info: %.texi
- makeinfo $<
-
-%.html: %.texi
- makeinfo --html --no-split $<
-
-info-only: $(MANUAL).info
-
-doc: $(MANUAL).info $(MANUAL).html
-
-clean: ;
-
-distclean realclean fullclean: clean
- -rm -f $(MANUAL).info $(MANUAL).html
-
-install: $(MANUAL).info
- [ -d $(INFODIR) ] || install -d $(INFODIR)
- install -m 0644 $(MANUAL).info $(INFODIR)/$(MANUAL)
- $(call install_info,$(MANUAL))
diff --git a/packages/muse/texi/dir-template b/packages/muse/texi/dir-template
deleted file mode 100644
index 08346cd..0000000
--- a/packages/muse/texi/dir-template
+++ /dev/null
@@ -1,15 +0,0 @@
-This is the file .../info/dir, which contains the
-topmost node of the Info hierarchy, called (dir)Top.
-The first time you invoke Info you start off looking at this node.
-
-File: dir, Node: Top This is the top of the INFO tree
-
- This (the Directory node) gives a menu of major topics.
- Typing "q" exits, "?" lists all Info commands, "d" returns here,
- "h" gives a primer for first-timers,
- "mEmacs<Return>" visits the Emacs manual, etc.
-
- In Emacs, you can click mouse button 2 on a menu item or cross reference
- to select it.
-
-* Menu:
diff --git a/packages/muse/texi/doclicense.texi
b/packages/muse/texi/doclicense.texi
deleted file mode 100644
index 83e9d6b..0000000
--- a/packages/muse/texi/doclicense.texi
+++ /dev/null
@@ -1,416 +0,0 @@
-@c -*-texinfo-*-
-@center Version 1.2, November 2002
-
-@display
-Copyright (C) 2000,2001,2002 Free Software Foundation, Inc.
-51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-@end display
-@sp 1
-@enumerate 0
-@item
-PREAMBLE
-
-The purpose of this License is to make a manual, textbook, or other
-functional and useful document ``free'' in the sense of freedom: to
-assure everyone the effective freedom to copy and redistribute it,
-with or without modifying it, either commercially or noncommercially.
-Secondarily, this License preserves for the author and publisher a way
-to get credit for their work, while not being considered responsible
-for modifications made by others.
-
-This License is a kind of ``copyleft,'' which means that derivative
-works of the document must themselves be free in the same sense. It
-complements the GNU General Public License, which is a copyleft
-license designed for free software.
-
-We have designed this License in order to use it for manuals for free
-software, because free software needs free documentation: a free
-program should come with manuals providing the same freedoms that the
-software does. But this License is not limited to software manuals;
-it can be used for any textual work, regardless of subject matter or
-whether it is published as a printed book. We recommend this License
-principally for works whose purpose is instruction or reference.
-
-@sp 1
-@item
-APPLICABILITY AND DEFINITIONS
-
-This License applies to any manual or other work, in any medium, that
-contains a notice placed by the copyright holder saying it can be
-distributed under the terms of this License. Such a notice grants a
-world-wide, royalty-free license, unlimited in duration, to use that
-work under the conditions stated herein. The ``Document,'' below,
-refers to any such manual or work. Any member of the public is a
-licensee, and is addressed as ``you.'' You accept the license if you
-copy, modify or distribute the work in a way requiring permission
-under copyright law.
-
-A ``Modified Version'' of the Document means any work containing the
-Document or a portion of it, either copied verbatim, or with
-modifications and/or translated into another language.
-
-A ``Secondary Section'' is a named appendix or a front-matter section of
-the Document that deals exclusively with the relationship of the
-publishers or authors of the Document to the Document's overall subject
-(or to related matters) and contains nothing that could fall directly
-within that overall subject. (Thus, if the Document is in part a
-textbook of mathematics, a Secondary Section may not explain any
-mathematics.) The relationship could be a matter of historical
-connection with the subject or with related matters, or of legal,
-commercial, philosophical, ethical or political position regarding
-them.
-
-The ``Invariant Sections'' are certain Secondary Sections whose titles
-are designated, as being those of Invariant Sections, in the notice
-that says that the Document is released under this License. If a
-section does not fit the above definition of Secondary then it is not
-allowed to be designated as Invariant. The Document may contain zero
-Invariant Sections. If the Document does not identify any Invariant
-Sections then there are none.
-
-The ``Cover Texts'' are certain short passages of text that are listed,
-as Front-Cover Texts or Back-Cover Texts, in the notice that says that
-the Document is released under this License. A Front-Cover Text may
-be at most 5 words, and a Back-Cover Text may be at most 25 words.
-
-A ``Transparent'' copy of the Document means a machine-readable copy,
-represented in a format whose specification is available to the
-general public, that is suitable for revising the document
-straightforwardly with generic text editors or (for images composed of
-pixels) generic paint programs or (for drawings) some widely available
-drawing editor, and that is suitable for input to text formatters or
-for automatic translation to a variety of formats suitable for input
-to text formatters. A copy made in an otherwise Transparent file
-format whose markup, or absence of markup, has been arranged to thwart
-or discourage subsequent modification by readers is not Transparent.
-An image format is not Transparent if used for any substantial amount
-of text. A copy that is not ``Transparent'' is called ``Opaque.''
-
-
-Examples of suitable formats for Transparent copies include plain
-ASCII without markup, Texinfo input format, LaTeX input format, SGML
-or XML using a publicly available DTD, and standard-conforming simple
-HTML, PostScript or PDF designed for human modification. Examples of
-transparent image formats include PNG, XCF and JPG. Opaque formats
-include proprietary formats that can be read and edited only by
-proprietary word processors, SGML or XML for which the DTD and/or
-processing tools are not generally available, and the
-machine-generated HTML, PostScript or PDF produced by some word
-processors for output purposes only.
-
-The ``Title Page'' means, for a printed book, the title page itself,
-plus such following pages as are needed to hold, legibly, the material
-this License requires to appear in the title page. For works in
-formats which do not have any title page as such, ``Title Page'' means
-the text near the most prominent appearance of the work's title,
-preceding the beginning of the body of the text.
-
-A section ``Entitled XYZ'' means a named subunit of the Document whose
-title either is precisely XYZ or contains XYZ in parentheses following
-text that translates XYZ in another language. (Here XYZ stands for a
-specific section name mentioned below, such as ``Acknowledgements,''
-``Dedications,'' ``Endorsements,'' or ``History.'') To ``Preserve the Title''
-of such a section when you modify the Document means that it remains a
-section ``Entitled XYZ'' according to this definition.
-
-The Document may include Warranty Disclaimers next to the notice which
-states that this License applies to the Document. These Warranty
-Disclaimers are considered to be included by reference in this
-License, but only as regards disclaiming warranties: any other
-implication that these Warranty Disclaimers may have is void and has
-no effect on the meaning of this License.
-@sp 1
-@item
-VERBATIM COPYING
-
-You may copy and distribute the Document in any medium, either
-commercially or noncommercially, provided that this License, the
-copyright notices, and the license notice saying this License applies
-to the Document are reproduced in all copies, and that you add no other
-conditions whatsoever to those of this License. You may not use
-technical measures to obstruct or control the reading or further
-copying of the copies you make or distribute. However, you may accept
-compensation in exchange for copies. If you distribute a large enough
-number of copies you must also follow the conditions in section 3.
-
-You may also lend copies, under the same conditions stated above, and
-you may publicly display copies.
-@sp 1
-@item
-COPYING IN QUANTITY
-
-If you publish printed copies (or copies in media that commonly have
-printed covers) of the Document, numbering more than 100, and the
-Document's license notice requires Cover Texts, you must enclose the
-copies in covers that carry, clearly and legibly, all these Cover
-Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
-the back cover. Both covers must also clearly and legibly identify
-you as the publisher of these copies. The front cover must present
-the full title with all words of the title equally prominent and
-visible. You may add other material on the covers in addition.
-Copying with changes limited to the covers, as long as they preserve
-the title of the Document and satisfy these conditions, can be treated
-as verbatim copying in other respects.
-
-If the required texts for either cover are too voluminous to fit
-legibly, you should put the first ones listed (as many as fit
-reasonably) on the actual cover, and continue the rest onto adjacent
-pages.
-
-If you publish or distribute Opaque copies of the Document numbering
-more than 100, you must either include a machine-readable Transparent
-copy along with each Opaque copy, or state in or with each Opaque copy
-a computer-network location from which the general network-using
-public has access to download using public-standard network protocols
-a complete Transparent copy of the Document, free of added material.
-If you use the latter option, you must take reasonably prudent steps,
-when you begin distribution of Opaque copies in quantity, to ensure
-that this Transparent copy will remain thus accessible at the stated
-location until at least one year after the last time you distribute an
-Opaque copy (directly or through your agents or retailers) of that
-edition to the public.
-
-It is requested, but not required, that you contact the authors of the
-Document well before redistributing any large number of copies, to give
-them a chance to provide you with an updated version of the Document.
-@sp 1
-@item
-MODIFICATIONS
-
-You may copy and distribute a Modified Version of the Document under
-the conditions of sections 2 and 3 above, provided that you release
-the Modified Version under precisely this License, with the Modified
-Version filling the role of the Document, thus licensing distribution
-and modification of the Modified Version to whoever possesses a copy
-of it. In addition, you must do these things in the Modified Version:
-
-A. Use in the Title Page (and on the covers, if any) a title distinct
- from that of the Document, and from those of previous versions
- (which should, if there were any, be listed in the History section
- of the Document). You may use the same title as a previous version
- if the original publisher of that version gives permission.@*
-B. List on the Title Page, as authors, one or more persons or entities
- responsible for authorship of the modifications in the Modified
- Version, together with at least five of the principal authors of the
- Document (all of its principal authors, if it has fewer than five),
- unless they release you from this requirement.@*
-C. State on the Title page the name of the publisher of the
- Modified Version, as the publisher.@*
-D. Preserve all the copyright notices of the Document.@*
-E. Add an appropriate copyright notice for your modifications
- adjacent to the other copyright notices.@*
-F. Include, immediately after the copyright notices, a license notice
- giving the public permission to use the Modified Version under the
- terms of this License, in the form shown in the Addendum below.@*
-G. Preserve in that license notice the full lists of Invariant Sections
- and required Cover Texts given in the Document's license notice.@*
-H. Include an unaltered copy of this License.@*
-I. Preserve the section Entitled ``History,'' Preserve its Title, and add
- to it an item stating at least the title, year, new authors, and
- publisher of the Modified Version as given on the Title Page. If
- there is no section Entitled ``History'' in the Document, create one
- stating the title, year, authors, and publisher of the Document as
- given on its Title Page, then add an item describing the Modified
- Version as stated in the previous sentence.@*
-J. Preserve the network location, if any, given in the Document for
- public access to a Transparent copy of the Document, and likewise
- the network locations given in the Document for previous versions
- it was based on. These may be placed in the ``History'' section.
- You may omit a network location for a work that was published at
- least four years before the Document itself, or if the original
- publisher of the version it refers to gives permission.@*
-K. For any section Entitled ``Acknowledgements'' or ``Dedications,''
- Preserve the Title of the section, and preserve in the section all
- the substance and tone of each of the contributor acknowledgements
- and/or dedications given therein.@*
-L. Preserve all the Invariant Sections of the Document,
- unaltered in their text and in their titles. Section numbers
- or the equivalent are not considered part of the section titles.@*
-M. Delete any section Entitled ``Endorsements.'' Such a section
- may not be included in the Modified Version.@*
-N. Do not retitle any existing section to be Entitled ``Endorsements''
- or to conflict in title with any Invariant Section.@*
-O. Preserve any Warranty Disclaimers.@*
-@sp 1
-If the Modified Version includes new front-matter sections or
-appendices that qualify as Secondary Sections and contain no material
-copied from the Document, you may at your option designate some or all
-of these sections as invariant. To do this, add their titles to the
-list of Invariant Sections in the Modified Version's license notice.
-These titles must be distinct from any other section titles.
-
-You may add a section Entitled ``Endorsements,'' provided it contains
-nothing but endorsements of your Modified Version by various
-parties--for example, statements of peer review or that the text has
-been approved by an organization as the authoritative definition of a
-standard.
-
-You may add a passage of up to five words as a Front-Cover Text, and a
-passage of up to 25 words as a Back-Cover Text, to the end of the list
-of Cover Texts in the Modified Version. Only one passage of
-Front-Cover Text and one of Back-Cover Text may be added by (or
-through arrangements made by) any one entity. If the Document already
-includes a cover text for the same cover, previously added by you or
-by arrangement made by the same entity you are acting on behalf of,
-you may not add another; but you may replace the old one, on explicit
-permission from the previous publisher that added the old one.
-
-The author(s) and publisher(s) of the Document do not by this License
-give permission to use their names for publicity for or to assert or
-imply endorsement of any Modified Version.
-@sp 1
-@item
-COMBINING DOCUMENTS
-
-You may combine the Document with other documents released under this
-License, under the terms defined in section 4 above for modified
-versions, provided that you include in the combination all of the
-Invariant Sections of all of the original documents, unmodified, and
-list them all as Invariant Sections of your combined work in its
-license notice, and that you preserve all their Warranty Disclaimers.
-
-The combined work need only contain one copy of this License, and
-multiple identical Invariant Sections may be replaced with a single
-copy. If there are multiple Invariant Sections with the same name but
-different contents, make the title of each such section unique by
-adding at the end of it, in parentheses, the name of the original
-author or publisher of that section if known, or else a unique number.
-Make the same adjustment to the section titles in the list of
-Invariant Sections in the license notice of the combined work.
-
-In the combination, you must combine any sections Entitled ``History''
-in the various original documents, forming one section Entitled
-``History''; likewise combine any sections Entitled ``Acknowledgements,''
-and any sections Entitled ``Dedications.'' You must delete all sections
-Entitled ``Endorsements.''
-@sp 1
-@item
-COLLECTIONS OF DOCUMENTS
-
-You may make a collection consisting of the Document and other documents
-released under this License, and replace the individual copies of this
-License in the various documents with a single copy that is included in
-the collection, provided that you follow the rules of this License for
-verbatim copying of each of the documents in all other respects.
-
-You may extract a single document from such a collection, and distribute
-it individually under this License, provided you insert a copy of this
-License into the extracted document, and follow this License in all
-other respects regarding verbatim copying of that document.
-@sp 1
-@item
-AGGREGATION WITH INDEPENDENT WORKS
-
-A compilation of the Document or its derivatives with other separate
-and independent documents or works, in or on a volume of a storage or
-distribution medium, is called an ``aggregate'' if the copyright
-resulting from the compilation is not used to limit the legal rights
-of the compilation's users beyond what the individual works permit.
-When the Document is included in an aggregate, this License does not
-apply to the other works in the aggregate which are not themselves
-derivative works of the Document.
-
-If the Cover Text requirement of section 3 is applicable to these
-copies of the Document, then if the Document is less than one half of
-the entire aggregate, the Document's Cover Texts may be placed on
-covers that bracket the Document within the aggregate, or the
-electronic equivalent of covers if the Document is in electronic form.
-Otherwise they must appear on printed covers that bracket the whole
-aggregate.
-@sp 1
-@item
-TRANSLATION
-
-Translation is considered a kind of modification, so you may
-distribute translations of the Document under the terms of section 4.
-Replacing Invariant Sections with translations requires special
-permission from their copyright holders, but you may include
-translations of some or all Invariant Sections in addition to the
-original versions of these Invariant Sections. You may include a
-translation of this License, and all the license notices in the
-Document, and any Warranty Disclaimers, provided that you also include
-the original English version of this License and the original versions
-of those notices and disclaimers. In case of a disagreement between
-the translation and the original version of this License or a notice
-or disclaimer, the original version will prevail.
-
-If a section in the Document is Entitled ``Acknowledgements,''
-``Dedications,'' or ``History,'' the requirement (section 4) to Preserve
-its Title (section 1) will typically require changing the actual
-title.
-@sp 1
-@item
-TERMINATION
-
-You may not copy, modify, sublicense, or distribute the Document except
-as expressly provided for under this License. Any other attempt to
-copy, modify, sublicense or distribute the Document is void, and will
-automatically terminate your rights under this License. However,
-parties who have received copies, or rights, from you under this
-License will not have their licenses terminated so long as such
-parties remain in full compliance.
-@sp 1
-@item
-FUTURE REVISIONS OF THIS LICENSE
-
-The Free Software Foundation may publish new, revised versions
-of the GNU Free Documentation License from time to time. Such new
-versions will be similar in spirit to the present version, but may
-differ in detail to address new problems or concerns. See
-http://www.gnu.org/copyleft/.
-
-Each version of the License is given a distinguishing version number.
-If the Document specifies that a particular numbered version of this
-License ``or any later version'' applies to it, you have the option of
-following the terms and conditions either of that specified version or
-of any later version that has been published (not as a draft) by the
-Free Software Foundation. If the Document does not specify a version
-number of this License, you may choose any version ever published (not
-as a draft) by the Free Software Foundation.
-
-@end enumerate
-
-@unnumberedsec ADDENDUM: How to use this License for your documents
-
-To use this License in a document you have written, include a copy of
-the License in the document and put the following copyright and
-license notices just after the title page:
-
-@smallexample
-@group
-Copyright (C) @var{year} @var{your name}.
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2
-or any later version published by the Free Software Foundation;
-with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
-A copy of the license is included in the section entitled ``GNU
-Free Documentation License.''
-@end group
-@end smallexample
-
-If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
-replace the ``with...Texts.'' line with this:
-
-@smallexample
-@group
-with the Invariant Sections being @var{list their titles}, with the
-Front-Cover Texts being @var{list}, and with the Back-Cover Texts being
-@var{list}.
-@end group
-@end smallexample
-
-If you have Invariant Sections without Cover Texts, or some other
-combination of the three, merge those two alternatives to suit the
-situation.
-
-If your document contains nontrivial examples of program code, we
-recommend releasing these examples in parallel under your choice of
-free software license, such as the GNU General Public License,
-to permit their use in free software.
-
-@ignore
- arch-tag: c1679162-1d8a-4f02-bc52-2e71765f0165
-@end ignore
diff --git a/packages/muse/texi/muse.texi b/packages/muse/texi/muse.texi
deleted file mode 100644
index cde8c35..0000000
--- a/packages/muse/texi/muse.texi
+++ /dev/null
@@ -1,4247 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@c %**start of header
-@setfilename muse.info
-@settitle Muse
-@c %**end of header
-
-@dircategory Emacs
-@direntry
-* Muse: (muse). Authoring and publishing environment for Emacs.
-@end direntry
-
-@syncodeindex fn cp
-
-@copying
-This manual is for Emacs Muse version 3.20.
-
-Copyright @copyright{} 2004, 2005, 2006, 2007,
-2008, 2009, 2010 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU
-Manual'', and with the Back-Cover Texts as in (a) below. A copy of the
-license is included in the section entitled ``GNU Free Documentation
-License'' in this manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software. Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License. If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-
-All Emacs Lisp code contained in this document may be used, distributed,
-and modified without restriction.
-@end quotation
-@end copying
-
-@titlepage
-@title Muse manual
-@subtitle an authoring and publishing environment
-@subtitle for GNU Emacs and XEmacs
-
-@c The following two commands
-@c start the copyright page.
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-@c So the toc is printed at the start
-@contents
-
-@ifnottex
-@node Top, Preface, (dir), (dir)
-@comment node-name, next, previous, up
-@top Muse
-
-@insertcopying
-@end ifnottex
-
-@menu
-* Preface:: About the documentation.
-* Introduction:: What is Muse?
-* Obtaining Muse:: How to get Muse releases and development
- changes.
-* Installation:: Compiling and installing Muse.
-* Getting Started:: Setting up Muse and editing files.
-* Projects:: Creating and managing Muse projects.
-* Keystroke Summary:: Keys used in Muse mode.
-* Markup Rules:: Rules for using markup.
-* Publishing Styles:: Publishing various types of documents.
-* Extending Muse:: Making your own publishing styles.
-* Miscellaneous:: Miscellaneous add-ons, like a minor mode.
-* Getting Help and Reporting Bugs::
-* History:: History of this document.
-* Contributors:: Contributors to this documentation.
-* GNU Free Documentation License:: The license for this documentation.
-* Concept Index:: Search for terms.
-
-@detailmenu
- --- The Detailed Node Listing ---
-
-How to Get Muse Releases and Development Changes
-
-* Releases:: Released versions of Muse.
-* Development:: Latest unreleased development changes.
-
-Getting Started
-
-* Loading Muse:: How to load Muse.
-* Using Muse Mode:: How to edit files in Muse.
-* Publishing Files Overview:: Publishing a single file or project.
-* File Extensions:: Using a different file extension.
-
-Creating and Managing Muse Projects
-
-* Single Project:: A single-project example.
-* Multiple Projects:: A multiple-project example.
-* Projects and Subdirectories:: Publishing subdirectories in projects.
-* Options for Projects:: Listing of available options for projects.
-
-Rules for Using Markup
-
-* Paragraphs:: Paragraphs: centering and quoting.
-* Headings:: Levels of headings.
-* Directives:: Directives at the beginning of a
- document.
-* Emphasizing Text:: Bold, italicized, and underlined text.
-* Footnotes:: Making notes to be shown at the end.
-* Verse:: Indicating poetic stanzas.
-* Lists:: Lists of items.
-* Tables:: Generation of data tables.
-* Explicit Links:: Hyperlinks and email addresses with
- descriptions.
-* Implicit Links:: Bare URLs, WikiNames, and InterWiki
- links.
-* Images:: Publishing and displaying images.
-* Horizontal Rules and Anchors:: Inserting a horizontal line or anchor.
-* Embedded Lisp:: Evaluating Emacs Lisp code in documents
- for extensibility.
-* Citations:: Support for citing other resources.
-* Comments:: Lines to omit from published output.
-* Tag Summary:: Tags that Muse recognizes.
-
-Publishing Various Types of Documents
-
-* Blosxom:: Integrating Muse and pyblosxom.cgi.
-* Book:: Publishing entries into a compilation.
-* ConTeXt:: Publishing ConTeXt documents.
-* DocBook:: Publishing in DocBook XML form.
-* HTML:: Publishing in HTML or XHTML form.
-* Ikiwiki:: Integrating with ikiwiki.
-* Journal:: Keeping a journal or blog.
-* LaTeX:: Publishing LaTeX documents.
-* Poem:: Publish a poem to LaTeX or PDF.
-* Texinfo:: Publish entries to Texinfo format or PDF.
-* XML:: Publish entries to XML.
-
-Integrating Muse and pyblosxom.cgi
-
-* Blosxom Requirements:: Other tools needed for the Blosxom style.
-* Blosxom Entries:: Format of a Blosxom entry and automation.
-* Blosxom Options:: Blosxom styles and options provided.
-
-Making your own publishing styles
-
-* Markup Functions:: Specifying functions to mark up text.
-* Markup Regexps:: Markup rules for publishing.
-* Markup Strings:: Strings specific to a publishing style.
-* Markup Tags:: Tag specifications for special markup.
-* Style Elements:: Parameters used for defining styles.
-* Deriving Styles:: Deriving a new style from an existing
- one.
-
-Miscellaneous add-ons, like a minor mode
-
-* Muse List Edit Minor Mode:: Edit lists easily in other major modes.
-
-@end detailmenu
-@end menu
-
-@node Preface, Introduction, Top, Top
-@comment node-name, next, previous, up
-@chapter About the documentation
-
-This document describes Muse, which was written by John Wiegley and is
-now maintained by Michael Olson. Several versions of this manual are
-available on-line.
-
-@itemize @bullet
-@item PDF: http://mwolson.org/static/doc/muse.pdf
-@item HTML (single file): http://mwolson.org/static/doc/muse.html
-@item HTML (multiple files): http://mwolson.org/static/doc/muse/
-@end itemize
-
-@node Introduction, Obtaining Muse, Preface, Top
-@comment node-name, next, previous, up
-@chapter What is Muse?
-
-Emacs Muse (also known as ``Muse'' or ``Emacs-Muse'') is an authoring
-and publishing environment for Emacs. It simplifies the process of
-writing documents and publishing them to various output formats.
-
-Muse consists of two main parts: an enhanced text-mode for authoring
-documents and navigating within Muse projects, and a set of publishing
-styles for generating different kinds of output.
-
-What makes Muse distinct from other text-publishing systems is a modular
-environment, with a rather simple core, in which "styles" are derived
-from to create new styles. Much of Muse's overall functionality is
-optional. For example, you can use the publisher without the
-major-mode, or the mode without doing any publishing; or if you don't
-load the Texinfo or LaTeX modules, those styles won't be available.
-
-The Muse codebase is a departure from emacs-wiki.el version 2.44. The
-code has been restructured and rewritten, especially its publishing
-functions. The focus in this revision is on the authoring and
-publishing aspects, and the "wikiness" has been removed as a default
-behavior (available in the optional @file{muse-wiki} module). CamelCase
-words are no longer special by default.
-
-One of the principal aims in the development of Muse is to make it very
-easy to produce good-looking, standards-compliant documents.
-
-@node Obtaining Muse, Installation, Introduction, Top
-@comment node-name, next, previous, up
-@chapter How to Get Muse Releases and Development Changes
-
-@menu
-* Releases:: Released versions of Muse.
-* Development:: Latest unreleased development changes.
-@end menu
-
-@node Releases, Development, Obtaining Muse, Obtaining Muse
-@comment node-name, next, previous, up
-@section Released versions of Muse
-
-Choose to install a release if you want to minimize risk.
-
-Errors are corrected in development first. User-visible changes will be
-announced on the @email{muse-el-discuss@@gna.org} mailing list.
-@xref{Getting Help and Reporting Bugs}.
-
-@cindex releases, Debian package
-@cindex Debian package for Muse
-Debian users can get Muse via apt-get. The @file{muse-el} package is
-available both at Michael Olson's APT repository and the official Debian
-repository. To make use of the former, add the following line to your
-@file{/etc/apt/sources.list} file and run @code{apt-get install muse}.
-
-@example
-deb http://mwolson.org/debian/ ./
-@end example
-
-@cindex releases, Ubuntu package
-@cindex Ubuntu package for Muse
-Ubuntu users can also get Muse via apt-get. The @file{muse-el} package
-is available both at Michael Olson's APT repository and the official
-Ubuntu repository. To make use of the former, add the following line to
-your @file{/etc/apt/sources.list} file and run @code{apt-get install
-muse}.
-
-@example
-deb http://mwolson.org/ubuntu/ ./
-@end example
-
-The reason for making separate Debian and Ubuntu packages is that this
-manual is under the GFDL, and Debian will not allow it to be distributed
-in its main repository. Ubuntu, on the other hand, permits this manual
-to be included with the @file{muse-el} package.
-
-@cindex releases, from source
-Alternatively, you can download the latest release from
-@uref{http://download.gna.org/muse-el/} .
-
-@node Development, , Releases, Obtaining Muse
-@comment node-name, next, previous, up
-@section Latest unreleased development changes
-@cindex development
-
-Choose the development version if you want to live on the bleeding edge
-of Muse development or try out new features before release.
-
-@cindex git version control system, using
-The git version control system allows you to keep up-to-date with the
-latest changes to the development version of Muse. It also allows you
-to contribute changes (via commits, if you are have developer access to
-the repository, or via patches, otherwise). If you would like to
-contribute to Muse development, it is highly recommended that you use
-git.
-
-If you are new to git, you might find this tutorial helpful:
-@uref{http://www.kernel.org/pub/software/scm/git/docs/tutorial.html}.
-
-Downloading the Muse module with git and staying up-to-date involves
-the following steps.
-
-@enumerate
-@item Install git.
-
-@itemize @bullet
-@item Debian and Ubuntu: @kbd{apt-get install git-core}.
-@item Windows: @uref{http://git.or.cz/gitwiki/WindowsInstall}.
-@item Other operating systems: download, compile, and install the source
-from @uref{http://www.kernel.org/pub/software/scm/git/}, or find a git
-package for your operating system.
-@end itemize
-
-@item Download the Muse development branch.
-
-If you have developer access to Muse, do:
-
-@example
-git clone ssh://repo.or.cz/srv/git/muse-el.git muse
-@end example
-
-otherwise, do:
-
-@example
-git clone git://repo.or.cz/muse-el.git muse
-@end example
-
-If you are behind a restrictive firewall, and do not have developer
-access, then do the following instead:
-
-@example
-git clone http://repo.or.cz/r/muse-el.git muse
-@end example
-
-@item List upstream changes that are missing from your local copy.
-Do this whenever you want to see whether new changes have been committed
-to Muse. If you wish, you may skip this step and proceed directly to
-the ``update'' step.
-
-@example
-# Change to the source directory you are interested in.
-cd muse
-
-# Fetch new changes from the repository, but don't apply them yet
-git fetch origin
-
-# Display log messages for the new changes
-git log HEAD..origin
-@end example
-
-``origin'' is git's name for the location where you originally got Muse
-from. You can change this location at any time by editing the
-@file{.git/config} file in the directory where the Muse source was
-placed.
-
-@cindex updating Muse with git
-@item Update to the latest version by pulling in any missing changes.
-
-@example
-cd muse
-git pull origin
-@end example
-
-git will show how many files changed, and will provide a visual display
-for how many lines were changed in each file.
-
-@end enumerate
-
-There are other ways to interact with the Muse repository.
-
-@itemize
-@item Browse git repo: @uref{http://repo.or.cz/w/muse-el.git}
-@item Latest development snapshot:
@uref{http://mwolson.org/static/dist/muse-latest.tar.gz}
-@item Latest development snapshot (zip file):
@uref{http://mwolson.org/static/dist/muse-latest.zip}
-@end itemize
-
-The latest development snapshot can lag behind the git repo by as much
-as 20 minutes, but never more than that.
-
-@subheading Becoming a Muse developer
-@cindex developer, becoming
-
-If you want commit access to the shared Muse repository, then register
-an account at @uref{http://repo.or.cz} (be sure to add an SSH key), and
-contact the current maintainer at @email{mwolson@@gnu.org}. It would be
-best to send some patches to the @email{muse-el-discuss@@gna.org}
-mailing list first, so that he knows that you know what you are doing.
-@xref{Getting Help and Reporting Bugs}, for instructions on subscribing
-to the mailing list.
-
-You must also be willing to sign a copyright assignment for your changes
-to Muse, since Muse is a GNU project. The current maintainer will
-assist you in this process if you contact him.
-
-For information on committing changes to Muse and performing
-development, please consult
-@uref{http://emacswiki.org/cgi-bin/wiki/MuseDevelopment}.
-
-@node Installation, Getting Started, Obtaining Muse, Top
-@comment node-name, next, previous, up
-@chapter Compiling and Installing Muse
-
-Muse may be compiled and installed on your machine.
-
-@subheading Compilation
-@cindex compiling Muse
-
-This is an optional step, since Emacs Lisp source code does not
-necessarily have to be byte-compiled. Byte-compilation may yield a very
-slight speed increase.
-
-A working copy of Emacs or XEmacs is needed in order to compile Emacs
-Muse. By default, the program that is installed with the name
-@command{emacs} will be used.
-
-If you want to use the @command{xemacs} binary to perform the
-compilation, you must copy @file{Makefile.defs.default} to
-@file{Makefile.defs} in the top-level directory, and then edit
-@file{Makefile.defs} as follows. You can put either a full path to an
-Emacs or XEmacs binary or just the command name, as long as it is in the
-@env{PATH}.
-
-@example
-EMACS = xemacs
-SITEFLAG = -no-site-file
-# Edit the section as necessary
-install_info = install-info --section "XEmacs 21.4" $(1).info \
- $(INFODIR)/dir || :
-@end example
-
-Running @code{make} in the top-level directory should compile the Muse
-source files in the @file{lisp} directory, and generate an autoloads
-file in @file{lisp/muse-autoloads.el}.
-
-@subheading Installation
-@cindex installing Muse
-
-Muse may be installed into your file hierarchy by doing the following.
-
-Copy @file{Makefile.defs.default} to @file{Makefile.defs} in the
-top-level directory, if you haven't done so already. Then edit the
-@file{Makefile.defs} file so that @env{ELISPDIR} points to where you
-want the source and compiled Muse files to be installed and
-@env{INFODIR} indicates where to put the Muse manual. You may use a
-combination of @env{DESTDIR} and @env{PREFIX} to further determine where
-the installed files should be placed. As mentioned earlier, you will
-want to edit @env{EMACS} and @env{SITEFLAG} as shown in the Compilation
-section if you are using XEmacs.
-
-If you are installing Muse on a Debian or Ubuntu system, you might want
-to change the value of @env{INSTALLINFO} as specified in
-@file{Makefile.defs}.
-
-If you wish to install Muse to different locations than the defaults
-specify, edit @file{Makefile.defs} accordingly.
-
-Run @code{make} as a normal user, if you haven't done so already.
-
-Run @code{make install} as the root user if you have chosen installation
-locations that require root permissions.
-
-@subheading ELPA
-@cindex ELPA package for Muse
-
-For those used to installing software packages, there will be a
-@code{muse} package available in the Emacs Lisp Package Archive
-(abbreviated ``ELPA'') as of the 3.10 release of Muse. This package
-will be compiled and installed automatically in a user-specific
-location. For more information on ELPA, see
-@uref{http://tromey.com/elpa/}.
-
-@node Getting Started, Projects, Installation, Top
-@comment node-name, next, previous, up
-@chapter Getting Started
-@cindex settings
-
-@menu
-* Loading Muse:: How to load Muse.
-* Using Muse Mode:: How to edit files in Muse.
-* Publishing Files Overview:: Publishing a single file or project.
-* File Extensions:: Using a different file extension.
-@end menu
-
-@node Loading Muse, Using Muse Mode, Getting Started, Getting Started
-@comment node-name, next, previous, up
-@section How to Load Muse
-@cindex settings, init file
-
-To use Muse, add the directory containing its files to your
-@code{load-path} variable, in your @file{.emacs} file. Then, load in
-the authoring mode, and the styles you wish to publish to. An example
-follows.
-
-@lisp
-(add-to-list 'load-path "<path to Muse>")
-
-(require 'muse-mode) ; load authoring mode
-
-(require 'muse-html) ; load publishing styles I use
-(require 'muse-latex)
-(require 'muse-texinfo)
-(require 'muse-docbook)
-
-(require 'muse-project) ; publish files in projects
-@end lisp
-
-An easy way of seeing which settings are available and changing settings
-is to use the Muse customization interface. To do this, type
-@kbd{M-x customize-group muse RET}. Each of the options has its own
-documentation. Options are grouped logically according to what effect
-they have.
-
-@node Using Muse Mode, Publishing Files Overview, Loading Muse, Getting Started
-@comment node-name, next, previous, up
-@section How to Edit Files in Muse
-@cindex editing Muse files
-
-Muse Mode should automatically be activated when you visit a file with a
-``.muse'' extension. One such file is @file{QuickStart.muse}, which is
-available in the @file{examples} directory of the Muse distribution.
-You can tell that Muse Mode has been activated by checking for the text
-``Muse'' in your mode line. If Muse Mode has not been activated, you
-may activate it by type @kbd{M-x muse-mode RET}.
-
-You will notice that Muse files are highlighted very simply. Links are
-colored blue, headings are large and bold text, and @verb{|<example>|}
-tags are colored in grey.
-
-There are several different ways to edit things like links, which hide
-the underlying Muse markup. One way is to toggle font-locking off by
-hitting @kbd{C-c C-l}, which is also @kbd{M-x font-lock-mode}, make
-changes, and then hit @kbd{C-c C-l} again to toggle font-locking back
-on. Another way is just to move into the text and edit it. Markup can
-also be removed by normal deletion methods, though some side effects
-might require a second deletion.
-
-For the particular case of editing links, it is easiest to move to the
-link and do @kbd{C-c C-e}, which is also @kbd{M-x
-muse-edit-link-at-point}. This prompts you for the link and its
-description, using the previous contents of the link as initial values.
-A link to another Muse file may be created by hitting @kbd{C-c TAB l}.
-A link to a URL may be created by hitting @kbd{C-c TAB u}. Links may be
-followed by hitting @kbd{RET} on them.
-
-If you want to add a new list item, this may by accomplished by hitting
-@kbd{M-RET}. This will put a dash and some spaces on the screen. The
-dash is the Muse markup that indicates a list item. It is also possible
-to created ``nested'' lists with this command, by adjusting the number
-of spaces in front of the dashes. If you have lists with long lines,
-you can move to a list item and hit @kbd{M-q} to wrap it onto multiple
-lines.
-
-@node Publishing Files Overview, File Extensions, Using Muse Mode, Getting
Started
-@comment node-name, next, previous, up
-@section Publishing a Single File or Project
-@cindex editing Muse files
-
-The command @kbd{M-x muse-project-publish-this-file} will publish the
-current document to any available publishing style (a publishing style
-is an output format, like HTML or Docbook), placing the output in the
-current directory. If you are in Muse Mode, this command will be bound
-to @kbd{C-c C-t}. If the file has been published recently, and its
-contents have not changed, running @kbd{C-c C-t} again will not publish
-the file. To force publishing in this case, do @kbd{C-u C-c C-t}.
-
-If you have set up projects and are visiting a file that is part of a
-project, then @kbd{C-c C-t} will restrict the output formats to those
-which are used by the project, and will automatically publish to the
-output directory defined by the project. If you want to publish to a
-different directory or use a different format, then use @kbd{C-c M-C-t},
-which is also @kbd{M-x muse-publish-this-file}.
-
-If the currently opened file is part of a defined project in
-@code{muse-project-alist}, it (and the rest of the changed files in a
-project) may be published using @kbd{C-c C-p}.
-
-@node File Extensions, , Publishing Files Overview, Getting Started
-@comment node-name, next, previous, up
-@section Using a Different File Extension
-@cindex file extension, specifying
-
-By default, Muse expects all project files to have the file extension
-@file{.muse}. Files without this extension will not be associated with
-Muse mode and will not be considered part of any project, even if they
-are within a project directory.
-
-If you don't want to use @file{.muse}, you can customize the extension
-by setting the value of @code{muse-file-extension}.
-
-If you don't want to use any extension at all, and want Muse to
-autodetect project files based on their location, then add the following
-to your Muse settings file.
-
-@lisp
-(setq muse-file-extension nil
- muse-mode-auto-p t)
-@end lisp
-
-Note that if you chose to have @code{muse-file-extension} set to
-@code{nil}, you may have trouble if your @file{.emacs} file or other
-init scripts attempt to visit a Muse file. (A very common example of
-this is if you use Planner with Muse and run @code{(plan)} from your
-@file{.emacs}.) If you wish to visit Muse files from your
-@file{.emacs}, be sure to also add the following additional code before
-any such visits happen:
-
-@lisp
-(add-hook 'find-file-hook 'muse-mode-maybe)
-@end lisp
-
-
-@node Projects, Keystroke Summary, Getting Started, Top
-@comment node-name, next, previous, up
-@chapter Creating and Managing Muse Projects
-@cindex projects
-
-Often you will want to publish all the files within a directory to a
-particular set of output styles automatically. To support, Muse
-allows for the creation of "projects".
-
-@menu
-* Single Project:: A single-project example.
-* Multiple Projects:: A multiple-project example.
-* Projects and Subdirectories:: Publishing subdirectories in projects.
-* Options for Projects:: Listing of available options for projects.
-@end menu
-
-@node Single Project, Multiple Projects, Projects, Projects
-@comment node-name, next, previous, up
-@section A Single-Project Example
-@cindex projects, single
-
-Here is a sample project, which may be defined in your @file{.emacs}
-file.
-
-@lisp
-(setq muse-project-alist
- '(("Website" ("~/Pages" :default "index")
- (:base "html" :path "~/public_html")
- (:base "pdf" :path "~/public_html/pdf"))))
-@end lisp
-
-The above defines a project named "website", whose files are located
-in the directory @file{~/Pages}. The default page to visit is
-@file{index}. When this project is published, each page will be
-output as HTML to the directory @file{~/public_html}, and as PDF to
-the directory @file{~/public_html/pdf}. Within any project page, you
-may create a link to other pages using the syntax @samp{[[pagename]]}.
-
-If you would like to include only some files from a directory in a Muse
-project, you may use a regexp in place of @file{~/Pages} in the example.
-
-@node Multiple Projects, Projects and Subdirectories, Single Project, Projects
-@comment node-name, next, previous, up
-@section A Multiple-Project Example
-@cindex projects, multiple
-
-It is possible to specify multiple projects. Here is an example of
-three projects: a generic website, a projects area, and a day-planner
-(the day-planner part requires Planner Mode---see
-@uref{http://wjsullivan.net/PlannerMode.html} to get it).
-
-@lisp
-(setq muse-project-alist
- '(("Website" ("~/Pages" :default "index")
- (:base "html" :path "~/public_html"))
- (("Projects" ("~/Projects" :default "index")
- (:base "xhtml"
- :path "~/public_html/projects"
- :exclude "/TopSecret")
- (:base "pdf"
- :path "~/public_html/projects/pdf"
- :exclude "/TopSecret")))
- ("Plans" ("~/Plans"
- :default "TaskPool"
- :major-mode planner-mode
- :visit-link planner-visit-link)
- (:base "planner-xhtml"
- :path "~/public_html/plans"))))
-@end lisp
-
-The @option{:major-mode} attribute specifies which major to use when
-visiting files in this directory.
-
-The @option{:visit-link} attribute specifies the function to call when
-visiting links.
-
-The @option{:exclude} attribute has a regexp that matches files to never
-publish.
-
-@node Projects and Subdirectories, Options for Projects, Multiple Projects,
Projects
-@comment node-name, next, previous, up
-@section Publishing Subdirectories in Projects
-@cindex projects, subdirectories
-
-If you want to publish a directory and all of its subdirectories, Muse
-provides two convenience functions that together generate the proper
-rules for you. Note that we use the backtick to begin this
-muse-project-alist definition, rather than a single quote.
-
-@lisp
-(setq muse-project-alist
- `(("Website" ("~/Pages" :default "index")
- (:base "html" :path "~/public_html"))
- ("Blog" (,@@(muse-project-alist-dirs "~/Blog")
- :default "index")
- ;; Publish this directory and its subdirectories. Arguments
- ;; are as follows. The above `muse-project-alist-dirs' part
- ;; is also needed.
- ;; 1. Source directory
- ;; 2. Output directory
- ;; 3. Publishing style
- ;; remainder: Other things to put in every generated style
- ,@@(muse-project-alist-styles "~/Blog"
- "~/public_html/blog"
- "blosxom"))))
-@end lisp
-
-The @code{muse-project-alist-dirs} function takes a directory and
-returns it and all of its subdirectories in a list.
-
-The @code{muse-project-alist-styles} function is explained by the
-comments above.
-
-The ``blosxom'' text is the name of another publishing style, much like
-``html''. @xref{Blosxom}, for further information about it. You can
-use any publishing style you like for the third argument to
-@code{muse-project-alist-styles}.
-
-@node Options for Projects, , Projects and Subdirectories, Projects
-@comment node-name, next, previous, up
-@section Listing of Available Options for Projects
-@cindex projects, options
-@cindex muse-project-alist, reference
-
-This is a listing of all of the various options (or, more accurately:
-attributes) that may be specified in @code{muse-project-alist}.
-
-Each muse-project-alist entry looks like this:
-
-@example
- (PROJECT-NAME (SOURCES)
- OUTPUTS)
-@end example
-
-We refer to these names below.
-
-``Attributes'', which compose SOURCES and OUTPUTS, are a pair of values.
-The first value is a keyword, like @option{:default}. The second part
-is the value associated with that keyword, such as the text ``index''.
-If you are familiar with Emacs Lisp property lists, the concept is
-similar to that, except that in the SOURCES section, single directories
-can be interspersed with two-value attributes.
-
-@subheading Project Name
-
-This is a string that indicates the name of the project. It is
-primarily used for publishing interwiki links with the
-@file{muse-wiki.el} module.
-
-@subheading Sources
-
-This part of a muse-project-alist entry consists of two-value
-attributes, and also directory names. If you are publishing a book, the
-order of directories and attributes is significant.
-
-The minimal content for the sources section is a list of directories.
-
-@table @option
-
-@item :book-chapter
-Indicates a new chapter of a book. The text of the title of the chapter
-comes immediately after this keyword.
-
-@item :book-end
-Indicates the end of a book. Directories listed after this one are
-ignored when publishing a book. The value ``t'' (without quotes) should
-come immediately after this keyword.
-
-@item :book-funcall
-A function to call while publishing a book. This is useful for doing
-something just after a particular chapter.
-
-@item :book-part
-Indicates the beginning of a new part of the book. The text of the
-title should come immediately after this keyword.
-
-@item :book-style
-Indicate a particular publishing style to use for this part of the book.
-If this is specified, it should come just after a @option{:part}
-attribute.
-
-@item :default
-The default page to visit when browsing a project. Also, if you are
-using the @file{muse-wiki.el} module, publishing a link to just a
-project's name will cause it to link to this default file.
-
-@item :force-publish
-This specifies a list of pages which should be published every time a
-project is published (by using @kbd{C-c C-p}, for example), regardless
-of whether their contents have changed. This is useful for updating
-Index pages, pages that use the @verb{|<include>|} tag, and other pages
-that have dynamically-generated content.
-
-@item :major-mode
-This specifies the major mode to use when visiting files in this
-project. The default is @code{muse-mode}.
-
-@item :nochapters
-This indicates that while publishing a book, do not automatically create
-chapters. Values which may follow this are nil (the default, which
-means that we automatically create chapters), or non-nil, which means
-that we manually specify chapters with the @option{:book-chapter}
-attribute,
-
-@item :publish-project
-Indicates which function we should call when publishing a project.
-
-@item :set
-This specifies a list of variables and values to set when publishing a
-project. The list should be a property list, which is in the form:
-
-@example
-(VAR1 VALUE1 VAR2 VALUE2 ...)
-@end example
-
-@item :visit-link
-Specifies the function to call when visiting a link. The default is
-@code{muse-visit-link-default}. The arguments for that function should
-be (1) the link and (2) whether to visit the link in a new window.
-
-@end table
-
-@subheading Outputs
-
-This part of a muse-project-alist entry is composed of lists of
-attributes. Each list is called an ``output style''.
-
-The minimal content for an output style is a @option{:base} attribute
-and a @option{:path} attribute.
-
-@table @option
-
-@item :base
-Publishing style to use, such as ``html'', ``docbook'', or ``pdf''.
-
-@item :base-url
-An external URL which can be used to access published files. This is
-mainly used by the @file{muse-wiki} module when publishing links between
-two separate projects, if the projects are served on different domains.
-
-It is also used by the @file{muse-journal} module to create the RSS or
-RDF output.
-
-@item :exclude
-Exclude items matching a regexp from being published. The regexp should
-usually begin with "/".
-
-@item :include
-Only include items matching a regexp when publishing. The regexp should
-usually begin with "/".
-
-@item :path
-The directory in which to store published files.
-
-@item :timestamps
-A file containing the timestamps (that is, time of creation) for files
-in this project. It might eventually used by the @file{muse-blosxom}
-module, but this option is not currently in use by any Muse code.
-
-@end table
-
-
-@node Keystroke Summary, Markup Rules, Projects, Top
-@comment node-name, next, previous, up
-@chapter Keys Used in Muse Mode
-@cindex keystrokes
-
-This is a summary of keystrokes available in every Muse buffer.
-
-@table @kbd
-
-@item C-c C-a (`muse-index')
-Display an index of all known Muse pages.
-
-@item C-c C-b (`muse-find-backlinks')
-Find all pages that link to this page.
-
-@item C-c C-e (`muse-edit-link-at-point')
-Edit link at point.
-
-@item C-c C-f (`muse-project-find-file')
-Open another Muse page. Prompt for the name.
-
-@item C-c C-i l, C-c TAB l (`muse-insert-relative-link-to-file')
-Insert a link to a file interactively.
-
-@item C-c C-i t, C-c TAB t (`muse-insert-tag')
-Insert a tag interactively.
-
-@item C-c C-i u, C-c TAB u (`muse-insert-url')
-Insert a URL interactively.
-
-@item C-c C-l (`font-lock-mode')
-Toggle font lock / highlighting for the current buffer.
-
-@item C-c C-p (`muse-project-publish')
-Publish any Muse pages that have changed.
-
-@item C-c C-s (`muse-search')
-Find text in all files of the current project.
-
-@item C-c C-t (`muse-project-publish-this-file')
-Publish the currently-visited file. Prompt for the style if the current
-file can be published using more than one style.
-
-@item C-c C-S-t, or C-c C-M-t (`muse-publish-this-file')
-Publish the currently-visited file. Prompt for both the style and
-output directory.
-
-@item C-c C-v (`muse-browse-result')
-Show the published result of this page.
-
-@item C-c = (`muse-what-changed')
-Diff this page against the last backup version.
-
-@item TAB
-Move to the next Wiki reference.
-
-@item S-TAB
-Move to the previous Wiki reference.
-
-@item M-TAB
-Complete the name of a page from the current project at point.
-
-@item M-RET
-Insert a new list item at point, indenting properly.
-
-@item C-<
-Decrease the indentation of the list item at point.
-
-@item C->
-Increase the indentation of the list item at point.
-
-@item M-x muse-colors-toggle-inline-images RET
-Toggle display of inlined images on/off.
-
-@item M-x muse-update-values RET
-Update various values that are automatically generated.
-
-Call this after changing @code{muse-project-alist}.
-@end table
-
-
-@node Markup Rules, Publishing Styles, Keystroke Summary, Top
-@comment node-name, next, previous, up
-@chapter Rules for Using Markup
-@cindex markup
-
-A Muse document uses special, contextual markup rules to determine how
-to format the output result. For example, if a paragraph is indented,
-Muse assumes it should be quoted.
-
-There are not too many markup rules, and all of them strive to be as
-simple as possible so that you can focus on document creation, rather
-than formatting.
-
-@menu
-* Paragraphs:: Paragraphs: centering and quoting.
-* Headings:: Levels of headings.
-* Directives:: Directives at the beginning of a
- document.
-* Emphasizing Text:: Bold, italicized, and underlined text.
-* Footnotes:: Making notes to be shown at the end.
-* Verse:: Indicating poetic stanzas.
-* Lists:: Lists of items.
-* Tables:: Generation of data tables.
-* Explicit Links:: Hyperlinks and email addresses with
- descriptions.
-* Implicit Links:: Bare URLs, WikiNames, and InterWiki
- links.
-* Images:: Publishing and displaying images.
-* Horizontal Rules and Anchors:: Inserting a horizontal line or anchor.
-* Embedded Lisp:: Evaluating Emacs Lisp code in documents
- for extensibility.
-* Citations:: Support for citing other resources.
-* Comments:: Lines to omit from published output.
-* Tag Summary:: Tags that Muse recognizes.
-@end menu
-
-@node Paragraphs, Headings, Markup Rules, Markup Rules
-@comment node-name, next, previous, up
-@section Paragraphs: centering and quoting
-@cindex paragraphs
-
-Paragraphs in Muse must be separated by a blank line.
-
-@cindex paragraphs, centered
-@subheading Centered paragraphs and quotations
-
-A line that begins with six or more columns of whitespace (either tabs
-or spaces) indicates a centered paragraph. Alternatively, you can use
-the @verb{|<center>|} tag to surround regions that are to be published
-as centered paragraphs.
-
-@cindex paragraphs, quoted
-@cindex quotations
-But if a line begins with whitespace, though less than six columns, it
-indicates a quoted paragraph. Alternatively, you can use the
-@verb{|<quote>|} tag to surround regions that are to be published as
-quoted paragraphs.
-
-@cindex examples
-@cindex monospace, rendering blocks
-@cindex HTML, rendering blocks in monospace
-@subheading Literal paragraphs
-
-The @verb{|<example>|} tag is used for examples, where whitespace should
-be preserved, the text rendered in monospace, and any characters special
-to the output style escaped.
-
-@cindex literal text
-@cindex HTML, inserting a raw block
-There is also the @verb{|<literal>|} tag, which causes a marked block to
-be entirely left alone. This can be used for inserting a hand-coded
-HTML blocks into HTML output, for example.
-
-If you want some text to only be inserted when publishing to a
-particular publishing style, use the @option{style} attribute for the
-@verb{|<literal>|} tag. An example follows.
-
-@example
-<literal style="latex">
-A LaTeX-based style was used in the publishing of this document.
-</literal>
-@end example
-
-This will leave the region alone if the current publishing style is
-``latex'' or based on ``latex'', such as ``pdf'', and delete the region
-otherwise. It is also possible to leave the text alone only for one
-particular style, rather than its derivations, by adding
-@code{exact="t"} to the tag.
-
-@cindex line breaks
-@subheading Line breaks
-
-If you need a line break, then use the @samp{<br>} tag. Most of the
-time this tag is unnecessary, because Muse will automatically detect
-paragraphs by means of blank lines. If you want to preserve newlines in
-several lines of text, then use verse markup instead (@pxref{Verse}).
-
-@node Headings, Directives, Paragraphs, Markup Rules
-@comment node-name, next, previous, up
-@section Levels of headings
-@cindex headings
-
-A heading becomes a chapter or section in printed output -- depending on
-the style. To indicate a heading, start a new paragraph with one or
-more asterices, followed by a space and the heading title. Then begin
-another paragraph to enter the text for that section.
-
-All levels of headings will be published. Most publishing styles only
-distinguish the between the first 4 levels, however.
-
-@example
-* First level
-
-** Second level
-
-*** Third level
-
-**** Fourth level
-@end example
-
-@node Directives, Emphasizing Text, Headings, Markup Rules
-@comment node-name, next, previous, up
-@section Directives at the beginning of a document
-@cindex directives
-
-Directives are lines beginning with the @samp{#} character that come
-before any paragraphs or sections in the document. Directives are of
-the form ``#directive content of directive''. You can use any
-combination of uppercase and lowercase letters for directives, even if
-the directive is not in the list below.
-
-The @code{muse-publishing-directive} function may be used in header and
-footer text to access directives. For example, to access the
-@code{#title} directive, use @code{(muse-publishing-directive "title")}.
-
-The following is a list of directives that Muse uses.
-
-@table @code
-@cindex #author
-@item #author
-The author of this document.
-
-If this is not specified, Muse will attempt to figure it out from the
-@code{user-full-name} variable.
-
-@cindex #date
-@item #date
-The date that the document was last modified.
-
-This is used by publishing styles that are able to embed the date
-information.
-
-@cindex #desc
-@item #desc
-A short description of this document.
-
-This is used by the @code{journal} publishing style to embed information
-inside of an RSS/RDF feed.
-
-@cindex #title
-@item #title
-The title of this document.
-
-If this is not specified, the name of the file is used.
-
-@end table
-
-@node Emphasizing Text, Footnotes, Directives, Markup Rules
-@comment node-name, next, previous, up
-@section Bold, italicized, and underlined text
-@cindex emphasizing text
-@cindex underlining text
-@cindex italicizing text
-@cindex verbatim text
-@cindex monospace, rendering words
-
-To emphasize text, surround it with certain specially recognized
-characters.
-
-@example
-*emphasis*
-**strong emphasis**
-***very strong emphasis***
-_underlined_
-=verbatim and monospace=
-@end example
-
-@cindex WYSIWYG
-While editing a Muse document in Muse mode, these forms of emphasis will
-be highlighted in a WYSIWYG manner. Each of these forms may span
-multiple lines.
-
-Verbatim text will be colored as gray by default. To change this,
-customize @code{muse-verbatim-face}.
-
-You can also use the @verb{|<code>|} tag to indicate verbatim and
-monospace text. This is handy for regions that have an ``='' in them.
-
-@node Footnotes, Verse, Emphasizing Text, Markup Rules
-@comment node-name, next, previous, up
-@section Making notes to be shown at the end
-@cindex footnotes
-
-A footnote reference is simply a number in square brackets. To define
-the footnote, place this definition at the bottom of your file.
-@samp{footnote-mode} can be used to greatly facilitate the creation of
-these kinds of footnotes.
-
-Footnotes are defined by the same number in brackets occurring at the
-beginning of a line. Use footnote-mode's @kbd{C-c ! a} command, to very
-easily insert footnotes while typing. Use @kbd{C-x C-x} to return to
-the point of insertion.
-
-@node Verse, Lists, Footnotes, Markup Rules
-@comment node-name, next, previous, up
-@section Indicating poetic stanzas
-@cindex verses
-@cindex poetry
-
-Poetry requires that whitespace be preserved, but without resorting to
-monospace. To indicate this, use the following markup, reminiscent of
-email quotations.
-
-@example
-> A line of Emacs verse;
-> forgive its being so terse.
-@end example
-
-You can also use the @verb{|<verse>|} tag, if you prefer.
-
-@example
-<verse>
-A line of Emacs verse;
- forgive its being so terse.
-</verse>
-@end example
-
-@cindex verses, multiple stanzas
-Multiple stanzas may be included in one set of @verb{|<verse>|} tags, as
-follows.
-
-@example
-<verse>
-A line of Emacs verse;
- forgive its being so terse.
-
-In terms of terse verse,
- you could do worse.
-</verse>
-@end example
-
-@node Lists, Tables, Verse, Markup Rules
-@comment node-name, next, previous, up
-@section Lists of items
-@cindex lists
-
-Lists are given using special characters at the beginning of a line.
-Whitespace must occur before bullets or numbered items, to distinguish
-from the possibility of those characters occurring in a real sentence.
-
-@cindex lists, bullets
-These are rendered as a bullet list.
-
-@example
-Normal text.
-
- - bullet item one
- - bullet item two
-@end example
-
-@cindex lists, enumerated
-An enumerated list follows.
-
-@example
-Normal text.
-
- 1. Enum item one
- 2. Enum item two
-@end example
-
-@cindex lists, definitions
-Here is a definition list.
-
-@example
-Term1 ::
- This is a first definition
- And it has two lines;
- no, make that three.
-
-Term2 :: This is a second definition
-@end example
-
-@subheading Nested lists
-
-@cindex lists, nested
-It is possible to nest lists of the same or different kinds. The
-``level'' of the list is determined by the amount of initial whitespace.
-
-@example
-Normal text.
-
- - Level 1, bullet item one
- 1. Level 2, enum item one
- 2. Level 2, enum item two
- - Level 1, bullet item two
- 1. Level 2, enum item three
- 2. Level 2, enum item four
- term :: definition
-@end example
-
-@subheading Breaking list items
-
-@cindex lists, breaking lines
-If you want to break up a line within any list type, just put one blank
-line between the end of the previous line and the beginning of the next
-line, using the same amount of initial indentation.
-
-@example
- - bullet item 1, line 1
-
- bullet item 1, line 2
-
- 1. Enum line 1
-
- Enum line 2
-
- - bullet item 2, line 1
-
- bullet item 2, line 2
-@end example
-
-@node Tables, Explicit Links, Lists, Markup Rules
-@comment node-name, next, previous, up
-@section Generation of data tables
-@cindex tables
-
-@cindex tables, simple
-Only very simple tables are supported. The syntax is as follows.
-
-@example
-Double bars || Separate header fields
-
-Single bars | Separate body fields
-Here are more | body fields
-
-Triple bars ||| Separate footer fields
-@end example
-
-Some publishing styles require header fields to come first, then footer
-fields, and then the body fields. You can use any order for these
-sections that you like, and Muse will re-order them for you at
-publish-time.
-
-If you wish to disable table generation for one Muse file, add the
-directive @samp{#disable-tables t} to the top of the file.
-
-@subheading Other table formats
-
-@cindex tables, orgtbl-mode style
-It is possible to publish very basic Orgtbl-mode style tables.
-
-@example
-| org | style | table |
-|------+-------+-------|
-| one | | one |
-| two | two | |
-| | three | three |
-|------+-------+-------|
-| more | stuff | |
-@end example
-
-If you are used to the way that Org Mode publishes these tables, then
-customize `muse-html-table-attributes' to the following, in order to get
-a similar kind of output.
-
-@example
-border="2" cellspacing="0" cellpadding="6" rules="groups" frame="hsides"
-@end example
-
-@cindex tables, table.el style
-@file{table.el} style tables are also supported, as long as
-@file{table.el} itself supports outputting tables for a particular
-publishing style. At the time of this writing, the ``html'', ``latex'',
-and ``docbook'' styles are supported by @file{table.el}. Styles derived
-from these styles will also work.
-
-@example
-+---+-----+---+
-| | one | 1 |
-+---+-----+---+
-| b | two | |
-+---+-----+---+
-| c | | 3 |
-+---+-----+---+
-@end example
-
-@node Explicit Links, Implicit Links, Tables, Markup Rules
-@comment node-name, next, previous, up
-@section Hyperlinks and email addresses with descriptions
-@cindex links, explicit
-
-A hyperlink can reference a URL, or another page within a Muse
-project. In addition, descriptive text can be specified, which should
-be displayed rather than the link text in output styles that supports
-link descriptions. The syntax is as follows.
-
-@example
-[[link target][link description]]
-[[link target without description]]
-@end example
-
-Thus, the current maintainer's homepage for Muse can be found
-@samp{[[http://mwolson.org/projects/EmacsMuse.html][here]]},
-or at @samp{[[http://mwolson.org/projects/EmacsMuse.html]]}.
-
-@node Implicit Links, Images, Explicit Links, Markup Rules
-@comment node-name, next, previous, up
-@section Bare URLs, WikiNames, and InterWiki links
-@cindex links, implicit
-@cindex links, raw
-
-@cindex URLs
-@cindex Email addresses
-
-A URL or email address encountered in the input text is published as a
-hyperlink. These kind of links are called @dfn{implicit links} because
-they are not separated from the rest of the Muse document in any way.
-
-Some characters in URLs will prevent Muse from recognizing them as
-implicit links. If you want to link to a URL containing spaces or any of
-the characters ``][,"'`()<>^'', you will have to make the link
-explicit. The punctuation characters ``.,;:'' are also not recognized as
-part of a URL when they appear at its end. For information on how to
-make an explicit link, see @ref{Explicit Links,,Hyperlinks and email
-addresses with descriptions}.
-
-@cindex WikiNames
-If the @command{muse-wiki} module is loaded, another form of implicit
-link will be made available. WikiNames, which are typed in CamelCase,
-are highlighted and published as links, provided that the file they
-refer to exists.
-
-Customization of WikiName recognition may be accomplished by editing the
-@code{muse-wiki-wikiword-regexp} option and subsequently running
-@code{(muse-configure-highlighting 'muse-colors-markupmuse-colors-markup)}.
-If you use the Customize interface, the latter will be done
-automatically.
-
-@cindex InterWiki links
-@cindex inter-project links
-The @command{muse-wiki} module also allows for InterWiki links. These
-are similar to WikiWords, but they specify both the project and page of
-a file. The names of your project entries in @code{muse-project-alist}
-will be used as InterWiki names by default. Several examples follow.
-
-@example
-Blog::DocumentingMuse
-Projects#EmacsMuse
-Website
-@end example
-
-In the first case, the interwiki delimiter is @samp{::}, @samp{Blog} is
-the project name, and @samp{DocumentingMuse} is the page name. In the
-second example, @samp{#} is the interwiki delimiter. If the name of a
-project occurs by itself in text, like the third case, it will be
-colorized and published as a link to the default page of the given
-project.
-
-Customization of interwiki links may be accomplished by editing the
-@code{muse-wiki-interwiki-alist} option.
-
-It is also possible to link to an anchor in an interwiki document. This
-is called a ``three-part link''. Examples of this follow.
-
-@example
-Blog::DocumentingMuse#anchor1
-Projects#EmacsMuse#anchor2
-@end example
-
-@node Images, Horizontal Rules and Anchors, Implicit Links, Markup Rules
-@comment node-name, next, previous, up
-@section Publishing and displaying images
-@cindex images
-@cindex links, with images
-@subheading Image links
-
-Links to images may be used in either the target or the description, or
-both. Thus, the following code will publish as a clickable image that
-points to @url{http://mwolson.org/}.
-
-@example
-[[http://mwolson.org/][/static/logos/site-logo.png]]
-@end example
-
-Normally, images in the link part will be inlined.
-
-If you want these images to be published as links instead, place the
-text ``URL:'' immediately in front of the link text. An example
-follows.
-
-@example
-[[URL:http://mwolson.org/static/logos/site-logo.png]]
-@end example
-
-@cindex images, displaying
-@cindex images, local
-@subheading Displaying images in Muse mode
-If a link to a locally-available image is encountered in the link
-description, Muse mode will attempt to display it if your version of
-Emacs permits this.
-
-This behavior may be toggled with @kbd{C-c C-i}, or disabled permanently
-by setting the @code{muse-colors-inline-images} option to @code{nil}.
-
-The method for finding images may be altered by customizing the
-@code{muse-colors-inline-image-method} option. One useful value for
-this option is @code{muse-colors-use-publishing-directory}, which tells
-Muse mode to look in the directory where the current file will be
-published. The default is to look in the current directory. Relative
-paths like @samp{../pics/} should work for either setting.
-
-Eventually, it is hoped that Muse will be able to copy images from the a
-``source'' directory to a publishing directory by customizing
-@code{muse-project-alist}, but this has not been implemented yet.
-
-@cindex images, without descriptions
-@cindex images, inlined
-@subheading Publishing simple images
-The following example will display correctly and publish correctly if a
-@acronym{PNG} file called @file{TestLogo.png} exists in the
-@file{../pics/} directory. If text is on the same line as the picture,
-it will remain so in the output.
-
-@example
-[[../myimage.png]]
-@end example
-
-@cindex images, captions
-@subheading Publishing images with captions
-If you want to add a caption to an image, use the following syntax.
-This will center the image (if the output format supports it) and add a
-centered caption below the picture. Formats that do not support
-centering the image will instead leave it against the left margin.
-
-@example
-[[../pics/mycat.png][My cat Dexter]]
-@end example
-
-Images with captions may only occur in their own paragraphs, with no
-text on the same line. Otherwise, the published output will not be
-syntactically correct.
-
-@node Horizontal Rules and Anchors, Embedded Lisp, Images, Markup Rules
-@comment node-name, next, previous, up
-@section Inserting a horizontal line or anchor
-
-@cindex horizontal rules
-@cindex dashes
-@subheading Horizontal Rules
-
-Four or more dashes indicate a horizontal rule. Be sure to put blank
-lines around it, or it will be considered part of the proceeding or
-following paragraph!
-
-@cindex anchors
-@cindex links, with target on same page
-@subheading Anchors
-
-If you begin a line with "#anchor" -- where "anchor" can be any word
-that doesn't contain whitespace -- it defines an anchor at that point
-into the document. This point can be referenced using "page#anchor" as
-the target in a Muse link.
-
-@node Embedded Lisp, Citations, Horizontal Rules and Anchors, Markup Rules
-@comment node-name, next, previous, up
-@section Evaluating Emacs Lisp code in documents for extensibility
-@cindex lisp, embedded
-
-Arbitrary kinds of markup can be achieved using the @verb{|<lisp>|} tag.
-With the @verb{|<lisp>|} tag, you may generate whatever output text you
-wish. The inserted output will get marked up if the @verb{|<lisp>|}
-tag appears within the main text of the document.
-
-@example
-<lisp>(concat "This form gets " "inserted")</lisp>
-@end example
-
-@cindex lisp, and insert command
-Note that you should not use the @code{insert} command within a set of
-@verb{|<lisp>|} tags, since the return value from the @verb{|<lisp>|}
-tags will be automatically inserted into the document.
-
-It is also possible to treat the output as if it were surrounded by the
-@verb{|<example>|}, @verb{|<src>|}, or @verb{|<verse>|} tags, by
-specifying ``example'', ``src'', or ``verse'' as the @option{markup}
-attribute of the @verb{|<lisp>|} tag.
-
-@example
-<lisp markup="example">
-(concat "Insert" " me")
-</lisp>
-@end example
-
-Other languages also have tags that cause source code to be evaluated.
-@xref{Tag Summary}, for details.
-
-@node Citations, Comments, Embedded Lisp, Markup Rules
-@comment node-name, next, previous, up
-@section Support for citing other resources
-@cindex citations
-@cindex tags, <cite>
-
-@subheading Example
-
-Here is an example of what citations look like in a Muse document.
-
-@example
-#bibsource REFDB
-
-* Title
-** Subtitle
-
-Some text before <cite>Miller1999</cite> and after the citation.
-
-This is an author-only citation <cite type="author">Miller1999</cite>.
-
-And this is a year-only citation <cite type="year">Miller1999</cite>.
-
-Finally, this is a multi-head citation
-<cite>Miller1999,Andrews2005</cite>.
-@end example
-
-@subheading Overview
-
-The @code{#bibsource} directive defines the source of the
-bibliographies. The following sources are possible.
-
-@itemize @bullet
-@item DocBook + RefDB:
-the string "REFDB"
-
-@item LaTeX + bibtex:
-the name of an appropriate bibtex file
-
-@item LaTeX + RefDB:
-if the input file is called "foo.muse", then set this to "foo.bib"
-@end itemize
-
-Citations are encoded as @verb{|<cite>|} elements which enclose the
-citation keys as they are defined in the bibliography file or database.
-In multi-head citations, the citation keys have to be separated by
-colons or semicolons. The @code{latex} and @code{docbook} styles
-translate these to the proper separator automatically.
-
-The @verb{|<cite>|} elements take an optional ``type'' attribute that
-defines how the citation is rendered. If the attribute is missing,
-you'll get a regular citation according to the bibliography style,
-e.g.'' (Miller et al., 1999)''. If the attribute is set to "author",
-only the name of the author(s) will be rendered. Accordingly, "year"
-will cause the year to be printed. This is useful to create citations
-like this:
-
-@example
-Miller et al. had already shown in a previous publication (1999) that
-this is not going to work.
-@end example
-
-Remember that refdb-mode (the Emacs interface to RefDB) can retrieve
-references by simply marking the citation key and running the
-@code{refdb-getref-by-field-on-region} command. Later versions of
-@code{refdb-mode} will also allow to insert references as Muse citations
-(which is already implemented for DocBook, TEI, and LaTeX documents).
-
-You may have noticed that there is no element to indicate the position
-of the bibliography. The latter is always created at a valid position
-close to the end of the document. The functions
-@code{muse-docbook-bibliography} and @code{muse-latex-bibliography} are
-called in the header or footer to generate this content, so it is
-possible to change the exact position.
-
-@node Comments, Tag Summary, Citations, Markup Rules
-@comment node-name, next, previous, up
-@section Lines to omit from published output
-@cindex comments
-@cindex publishing, omitting lines
-
-Use the following syntax to indicate a comment. Comments will not be
-published.
-
-@example
-; Comment text goes here.
-@end example
-
-That is, only a semi-colon at the beginning of a line, followed by a
-literal space, will cause that line to be treated as a comment.
-
-You can alternatively surround the region with the @verb{|<comment>|}
-tag.
-
-If you wish the comment to be published, but just commented out using
-the comment syntax of the output format, then set
-@option{muse-publish-comments-p} to non-nil.
-
-@node Tag Summary, , Comments, Markup Rules
-@comment node-name, next, previous, up
-@section Tags that Muse recognizes
-@cindex tags
-@cindex inserting files at publish time
-@cindex publishing, including markup in headers and footers
-@cindex publishing, inserting files
-
-Muse has several built-in tags that may prove useful during publishing.
-@xref{muse-publish-markup-tags}, to see how to customize the tags that
-Muse uses, as well as make your own tags.
-
-Only a small subset of these tags are available in header and footer
-text. The @code{muse-publish-markup-header-footer-tags} option lists
-the tags that are allowed in headers and footers.
-
-@subheading Syntax
-
-If a tag takes arguments, it will look like this, where ``tagname'' is
-the name of the tag.
-
-@example
-<tagname arg1="string1" arg2="string2">
-@end example
-
-If you want the tag to look like it came straight from an XHTML
-document, you can alternatively do the following.
-
-@example
-<tagname arg1="string1" arg2="string2" />
-@end example
-
-If a tag surrounds some text, it will look like this.
-
-@example
-<tagname>Some text</tagname>
-@end example
-
-If a tag surrounds a large region, it will look like this.
-
-@example
-<tagname>
-Some text.
-Some more text.
-</tagname>
-@end example
-
-@subheading Tag listing
-
-This is the complete list of tags that Muse accepts, including those
-that were mentioned in previous sections.
-
-@table @samp
-
-@item <br>
-Insert a line break.
-
-Muse will automatically detect paragraphs when publishing by means of
-blank lines, so this tag is usually unnecessary.
-
-@item <cite>
-Insert a citation to another source.
-
-This takes the argument @option{type}, which indicates the type of
-citation. The valid types are "author" and "year". If this argument is
-omitted, include both author and year in the citation.
-
-The bibliography to use for the citation may be specified by the
-@option{#bibsource} directive.
-
-@xref{Citations}, for additional information.
-
-@item <class>
-If publishing to HTML, surround the given text with a @verb{|<span>|}
-tag. It takes one argument called ``name'' that specifies the ``class''
-attribute of the @verb{|<span>|} tag.
-
-If publishing to a different format, do nothing extra to the text.
-
-@item <code>
-Treat the text surrounded by the tag as if they were enclosed in equal
-signs, that is, make it monospace.
-
-@item <command>
-Run a command on the region, replacing the region with the result of the
-command. The command is specified with the ``interp'' argument. If no
-value for ``interp'' is given, pass the entire region to the shell.
-
-The ``markup'' argument controls how this section is marked up.
-
-If it is omitted, publish the region with the normal Muse rules.
-
-If "nil", do not mark up the region at all, but prevent Muse from
-further interpreting it.
-
-If "example", treat the region as if it was surrounded by the
-@verb{|<example>|} tag.
-
-If "src", treat the included text as if it was surrounded by the
-@verb{|<src>|} tag. You should also specify the ``lang'' attribute if
-doing this.
-
-If "verse", treat the region as if it was surrounded by the
-@verb{|<verse>|} tag, to preserve newlines.
-
-Otherwise, it should be the name of a function to call, with the buffer
-narrowed to the region.
-
-@item <comment>
-Treat the entire region as a comment. If the option
-@var{muse-publish-comments-p} is nil, delete the region, otherwise
-publish it using the comment syntax of the current publishing style.
-
-@item <contents>
-Publish a Table of Contents. This will either be inserted in-place or
-at the beginning of the document, depending on your publishing style.
-It does not have a delimiting tag.
-
-By default, only 2 levels of headings will be included in the generated
-Table of Contents. To change this globally, customize the
-@var{muse-publish-contents-depth} option. To change this only for the
-current tag, use the ``depth'' argument.
-
-@item <div>
-Insert a <div> tag into HTML documents, and do not insert anything
-special for other non-HTML publishing formats.
-
-If the ``style'' argument is provided, include it with the published
-@verb{|<div>|} tag. Likewise for the ``id'' argument.
-
-@item <example>
-Publish the region in monospace, preserving the newlines in the region.
-This is useful for snippets of code.
-
-@item <include>
-Insert the given file at the current location during publishing. The
-basic use of this tag is as follows, replacing ``included_file'' with
-the name of the file that you want to include.
-
-@example
-<include file="included_file">
-@end example
-
-The ``markup'' argument controls how this section is marked up.
-
-If it is omitted, publish the included text with the normal Muse
-rules.
-
-If "nil", do not mark up the included text at all.
-
-If "example", treat the included text as if it was surrounded by the
-@verb{|<example>|} tag.
-
-If "src", treat the included text as if it was surrounded by the
-@verb{|<src>|} tag. You should also specify the ``lang'' attribute if
-doing this.
-
-If "verse", treat the included text as if it was surrounded by the
-@verb{|<verse>|} tag, to preserve newlines.
-
-Otherwise, it should be the name of a function to call after inserting
-the file with the buffer narrowed to the section inserted.
-
-@item <lisp>
-Evaluate the Emacs Lisp expressions between the initial and ending tags.
-The result is then inserted into the document, so you do not need to
-explicitly call @code{insert}. All text properties are removed from the
-resulting text.
-
-This tag takes the ``markup'' argument. See the description of
-@verb{|<command>|} for details.
-
-@item <literal>
-Make sure that the text enclosed by this tag is published without
-escaping it in any way. This is useful for inserting markup directly
-into the published document, when Muse does not provide the desired
-functionality.
-
-@item <markup>
-Mark up the text between the initial and ending tags. The markup
-command to use may be specified by the ``function'' argument. The
-standard Muse markup routines are used by default if no ``function''
-argument is provided.
-
-This is useful for marking up regions in headers and footers. One
-example that comes to mind is generating a published index of all of the
-files in the current project by doing the following.
-
-@example
-<markup><lisp>(muse-index-as-string t t)</lisp></markup>
-@end example
-
-@item <perl>
-Run the @command{perl} language interpreter on the region, replacing the
-region with the result of the command.
-
-This tag takes the ``markup'' argument. See the description of
-@verb{|<command>|} for details.
-
-@item <python>
-Run the @command{python} language interpreter on the region, replacing
-the region with the result of the command.
-
-This tag takes the ``markup'' argument. See the description of
-@verb{|<command>|} for details.
-
-@item <quote>
-Publish the region as a blockquote. This will either be inserted
-in-place or at the beginning of the document, depending on your
-publishing style. It does not have a delimiting tag.
-
-@item <ruby>
-Run the @command{ruby} language interpreter on the region, replacing the
-region with the result of the command.
-
-This tag takes the ``markup'' argument. See the description of
-@verb{|<command>|} for details.
-
-@item <src>
-Publish the region using htmlize.
-The language to use may be specified by the ``lang'' attribute.
-
-Muse will look for a function named @var{lang}-mode, where @var{lang} is
-the value of the ``lang'' attribute.
-
-This tag requires htmlize 1.34 or later in order to work. If this is
-not satisfied, or the current publishing style is not HTML-based, Muse
-will publish the region like an @verb{|<example>|} tag.
-
-@item <verbatim>
-This is used when you want to prevent Muse from trying to interpret some
-markup. Surround the markup in @verb{|<verbatim>|} and
-@verb{|</verbatim>|}, and it will not be interpreted.
-
-This tag was used often in previous versions of Muse because they did
-not support whole-document escaping of specials. Now, it will only be
-needed for other tags, and perhaps footnotes as well.
-
-@item <verse>
-Preserve the newlines in the region. In formats like HTML, newlines are
-removed by default, hence the need for this tag. In other publishing
-styles, this tag may cause the text to be indented slightly in a way
-that looks nice for poetry and prose.
-
-@end table
-
-@node Publishing Styles, Extending Muse, Markup Rules, Top
-@comment node-name, next, previous, up
-@chapter Publishing Various Types of Documents
-@cindex publishing styles
-
-One of the principle features of Muse is the ability to publish a simple
-input text to a variety of different output styles. Muse also makes it
-easy to create new styles, or derive from an existing style.
-
-@menu
-* Blosxom:: Integrating Muse and pyblosxom.cgi.
-* Book:: Publishing entries into a compilation.
-* ConTeXt:: Publishing ConTeXt documents.
-* DocBook:: Publishing in DocBook XML form.
-* HTML:: Publishing in HTML or XHTML form.
-* Ikiwiki:: Integrating with ikiwiki.
-* Journal:: Keeping a journal or blog.
-* LaTeX:: Publishing LaTeX documents.
-* Poem:: Publish a poem to LaTeX or PDF.
-* Texinfo:: Publish entries to Texinfo format or PDF.
-* XML:: Publish entries to XML.
-@end menu
-
-@node Blosxom, Book, Publishing Styles, Publishing Styles
-@comment node-name, next, previous, up
-@section Integrating Muse and pyblosxom.cgi
-@cindex blog, one-file-per-entry style
-
-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.
-In other words, each blog entry corresponds with one file.
-
-@menu
-* Blosxom Requirements:: Other tools needed for the Blosxom style.
-* Blosxom Entries:: Format of a Blosxom entry and automation.
-* Blosxom Options:: Blosxom styles and options provided.
-@end menu
-
-@node Blosxom Requirements, Blosxom Entries, Blosxom, Blosxom
-@comment node-name, next, previous, up
-@subsection Other tools needed for the Blosxom style
-
-You will need to have @command{pyblosxom.cgi} or @command{blosxom.cgi}
-installed on a machine that you have upload access to.
-
-The major difficulty in both of these programs is specifying the date of
-the entries. Both programs rely on the file modification time rather
-than any data contained in the entries themselves. A plugin is needed
-in order for these programs to be able to get the correct date.
-
-@subheading PyBlosxom
-
-There are two different ways of accomplishing this in pyblosxom. The
-first way involves gathering the timestamps (as specified by the
-@code{#date} directive) into one file and then sending that file along
-with published entries to the webserver.
-
-The second will read each file at render time and parse the
-@code{#postdate} directive. Muse will translate the @code{#date}
-directive into @code{#postdate} at publish time, so you don't have to do
-any extra work.
-
-@subsubheading Placing timestamps in one file
-
-The following additional components are required in order to make the
-date of blog entries display as something sensible.
-
-@enumerate
-@item
-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.
-
-@item
-A plugin for (py)blosxom that reads this file.
-@end enumerate
-
-These 2 things are provided for @command{pyblosxom.cgi} in the
-@file{contrib/pyblosxom} subdirectory. @file{getstamps.py} provides the
-former service, while @file{hardcodedates.py} provides the latter
-service.
-
-Here is a sample listing from my @file{timestamps} file, which maps
-each file to a date. This can really be in any format, as long as your
-date-gathering script and your plugin can both understand it.
-
-@example
-2005-04-01-14-16 personal/paper_cranes
-2005-03-21 personal/spring_break_over
-2004-10-24 personal/finished_free_culture
-@end example
-
-The script @file{contrib/pyblosxom/make-blog} demonstrates how to call
-@file{getstamps.py}. Note that you will need to set the current
-directory to where your Muse files are, execute @file{getstamps.py}, and
-then move the generated timestamps file to your publishing directory.
-
-@subsubheading Getting timestamp from entry while rendering
-
-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 @code{muse-blosxom-use-metadate} to non-nil
-to enable adding a @code{#postdate} directive to all published files.
-You can do this by:
-
-@example
-M-x customize-variable RET muse-blosxom-use-metadate RET
-@end example
-
-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 @file{contrib/pyblosxom/metadate.py}.
-
-@subheading Blosxom
-
-It is also possible to use Blosxom, which is written in Perl, to serve
-blog entries that were published with Muse. The steps are as follows.
-
-@enumerate
-@item
-Download and install blosxom from @url{http://blosxom.sourceforge.net/}.
-
-@item
-Install the metadate plugin. It is available in
-@file{contrib/blosxom/metadate_0_0_3}.
-
-@item
-Every time you make a new blog entry, change to the blosxom data
-directory and execute the @file{contrib/blosxom/getstamps.pl} script.
-This script has only recently been made, and may still have some bugs,
-so use with caution.
-
-@end enumerate
-
-@node Blosxom Entries, Blosxom Options, Blosxom Requirements, Blosxom
-@comment node-name, next, previous, up
-@subsection Format of a Blosxom entry and automation
-
-Each Blosxom file must include `#date yyyy-mm-dd', or optionally the
-longer `#date yyyy-mm-dd-hh-mm', a title (using the @code{#title}
-directive), plus whatever normal content is desired.
-
-The date directive is not used directly by @command{pyblosxom.cgi} or
-this program. You need to have the two additional items from the former
-section to make use of this feature.
-
-There is a function called @code{muse-blosxom-new-entry} that will
-automate the process of making a new blog entry. To make use of it, do
-the following.
-
-@itemize @bullet
-@item
-Customize @code{muse-blosxom-base-directory} to the location that your
-blog entries are stored.
-
-@item
-Assign the @code{muse-blosxom-new-entry} function to a key sequence. I
-use the following code to assign this function to @kbd{C-c p l'}.
-
-@example
-(global-set-key "\C-cpl" 'muse-blosxom-new-entry)
-@end example
-
-@item
-You should create your directory structure ahead of time under your base
-directory. These directories, which correspond with category names, may
-be nested.
-
-@item
-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.
-@end itemize
-
-@node Blosxom Options, , Blosxom Entries, Blosxom
-@comment node-name, next, previous, up
-@subsection Blosxom styles and options provided
-
-The following styles and options are available in the Blosxom publishing
-style.
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, blosxom-html
-@item blosxom-html
-Publish Blosxom entries in HTML form.
-
-@cindex publishing styles, blosxom-xhtml
-@item blosxom-xhtml
-Publish Blosxom entries in XHTML form.
-
-@end table
-
-@subheading Options provided
-
-@table @code
-
-@item muse-blosxom-extension
-Default file extension for publishing Blosxom files.
-
-@item muse-blosxom-header
-Header used for publishing Blosxom files.
-
-This may be text or a filename.
-
-@item muse-blosxom-footer
-Footer used for publishing Blosxom files.
-
-This may be text or a filename.
-
-@item muse-blosxom-base-directory
-Base directory of blog entries, used by @code{muse-blosxom-new-entry}.
-
-This is the top-level directory where your blog entries may be found
-locally.
-
-@end table
-
-@node Book, ConTeXt, Blosxom, Publishing Styles
-@comment node-name, next, previous, up
-@section Publishing entries into a compilation
-
-This publishing style is used to output ``books'' in LaTeX or PDF
-format.
-
-Each page will become a separate chapter in the book, unless the style
-keyword @option{:nochapters} is used, in which case they are all run
-together as if one giant chapter.
-
-One way of publishing a book is to make a project for it, add the
-project to @code{muse-project-alist}, and use the @code{book-pdf} style
-with a very specific @option{:include} value to specify some page whose
-contents will be checked for the values of @code{#title} and
-@code{#date}, and whose name will be used in the output file. Then to
-publish the book, visit the aforementioned page and use @kbd{C-c C-t} or
-@kbd{C-c C-p} to trigger the publishing process. An example
-@code{muse-project-alist} for this method follows.
-
-@example
-(setq muse-project-alist
- '(("MyNotes" (:nochapters t ; do automatically add chapters
- :book-chapter "Computer Science"
- "~/Notes/cs"
- :book-chapter "Mathematics"
- "~/Notes/math"
- :book-chapter "Emacs"
- "~/Notes/emacs"
- :book-end t ; the rest will not be placed in the book
- "~/Notes" ; so we can find the notes-anthology page
- "~/Notes/private"
- :force-publish ("index")
- :default "index")
- (:base "book-pdf"
- :include "/notes-anthology[^/]*$"
- :path "~/public_html/notes")
- ;; other publishing styles for each directory go here,
- ;; if desired
- )))
-@end example
-
-In this example, there would be a file called
-@file{~/Notes/notes-anthology.muse}, which would contain just the
-following. The resulting book would be published to
-@file{~/public_html/notes/notes-anthology.pdf}.
-
-@example
-#title My Technology Ramblings
-@end example
-
-Another way is to call the @code{muse-book-publish-project} function
-manually, with a custom project entry. An example of this may be found
-in John Wiegley's configuration file at
-@file{examples/johnw/muse-init.el}, in the @code{muse-publish-my-books}
-function.
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, book-latex
-@item book-latex
-Publish a book in LaTeX form. The header and footer are different than
-the normal LaTeX publishing mode.
-
-@cindex publishing styles, book-pdf
-@item book-pdf
-Publish a book in PDF form. The header and footer are different than
-the normal PDF publishing mode.
-
-@end table
-
-@subheading Options provided
-
-@table @code
-
-@item muse-book-before-publish-hook
-A hook run in the book buffer before it is marked up.
-
-@item muse-book-after-publish-hook
-A hook run in the book buffer after it is marked up.
-
-@item muse-book-latex-header
-Header used for publishing books to LaTeX.
-
-This may be text or a filename.
-
-@item muse-book-latex-footer
-Footer used for publishing books to LaTeX.
-
-This may be text or a filename.
-
-@end table
-@node ConTeXt, DocBook, Book, Publishing Styles
-@comment node-name, next, previous, up
-@section Publishing ConTeXt documents
-
-This publishing style is capable of producing ConTeXt or PDF documents.
-
-If you wish to publish PDF documents based on ConTeXt, you will need to
-have it installed. For Debian and Ubuntu, this can be accomplished by
-installing the ``texlive'' package.
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, context
-@item context
-Publish a ConTeXt document.
-
-@cindex publishing styles, context-pdf
-@item context-pdf
-Publish a PDF document, using an external ConTeXt document conversion
-tool.
-
-@cindex publishing styles, context-slides
-@item context-slides
-Produce slides from a ConTeXt document.
-
-Here is an example of a slide.
-
-@example
-* First Slide
-
-[[Some-sort-of-cute-image.png]]
-
-** A subheading
-
- - A bullet point.
- - Another bullet point.
-
-* Second Slide
-
-... and so on
-@end example
-
-@cindex publishing styles, context-slides-pdf
-@item context-slides-pdf
-Publish a PDF document of ConTeXt slides.
-
-@end table
-
-@subheading Options provided
-
-@table @code
-
-@item muse-context-extension
-Default file extension for publishing ConTeXt files.
-
-@item muse-context-pdf-extension
-Default file extension for publishing ConTeXt files to PDF.
-
-@item muse-context-pdf-program
-The program that is called to generate PDF content from ConTeXt content.
-
-@item muse-context-pdf-cruft
-Extensions of files to remove after generating PDF output successfully.
-
-@item muse-context-header
-Header used for publishing ConTeXt files.
-
-This may be text or a filename.
-
-@item muse-context-footer
-Footer used for publishing ConTeXt files.
-
-This may be text or a filename.
-
-@item muse-context-markup-regexps
-List of markup regexps for identifying regions in a Muse page.
-
-For more on the structure of this list,
-@xref{muse-publish-markup-regexps}.
-
-@item muse-context-markup-functions
-An alist of style types to custom functions for that kind of text.
-
-For more on the structure of this list,
-@xref{muse-publish-markup-functions}.
-
-@item muse-context-markup-strings
-Strings used for marking up text.
-
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-@item muse-context-slides-header
-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.
-
-@item muse-context-slides-markup-strings
-Strings used for marking up text in ConTeXt slides.
-
-@item muse-context-markup-specials-document
-A table of characters which must be represented specially.
-These are applied to the entire document, sans already-escaped
-regions.
-
-@item muse-context-markup-specials-example
-A table of characters which must be represented specially.
-These are applied to @verb{|example>|} regions.
-
-With the default interpretation of @verb{|<example>|} regions, no
-specials need to be escaped.
-
-@item muse-context-markup-specials-literal
-A table of characters which must be represented specially.
-This applies to =monospaced text= and @verb{|<code>|} regions.
-
-@item muse-context-markup-specials-url
-A table of characters which must be represented specially.
-These are applied to URLs.
-
-@item muse-context-markup-specials-image
-A table of characters which must be represented specially.
-These are applied to image filenames.
-
-@item muse-context-permit-contents-tag
-If nil, ignore @verb{|<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 @verb{|<contents>|} tag.
-
-If you don't agree with this, then set this option to non-nil,
-and it will do what you expect.
-
-@end table
-
-@node DocBook, HTML, ConTeXt, Publishing Styles
-@comment node-name, next, previous, up
-@section Publishing in DocBook XML form
-
-This publishing style is used to generate DocBook XML files.
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, docbook
-@item docbook
-Publish a file in Docbook form.
-
-@end table
-
-@subheading Options provided
-
-This publishing style uses the same options for markup up special
-characters as the ``xml'' publishing style. @xref{XML}, for details.
-
-@table @code
-
-@item muse-docbook-extension
-Default file extension for publishing DocBook XML files.
-
-@item muse-docbook-header
-Header used for publishing DocBook XML files.
-
-This may be text or a filename.
-
-@item muse-docbook-footer
-Footer used for publishing DocBook XML files.
-
-This may be text or a filename.
-
-@item muse-docbook-markup-regexps
-List of markup rules for publishing a Muse page to DocBook XML.
-
-@item muse-docbook-markup-functions
-An alist of style types to custom functions for that kind of text.
-
-@item muse-docbook-markup-strings
-Strings used for marking up text.
-
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-@item muse-docbook-encoding-default
-The default Emacs buffer encoding to use in published files.
-This will be used if no special characters are found.
-
-@item muse-docbook-charset-default
-The default DocBook XML charset to use if no translation is
-found in @code{muse-xml-encoding-map}.
-
-@end table
-
-@node HTML, Ikiwiki, DocBook, Publishing Styles
-@comment node-name, next, previous, up
-@section Publishing in HTML or XHTML form
-
-This publishing style is capable of producing HTML or XHTML documents.
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, html
-@item html
-Supports publishing to HTML 4.0 and HTML 4.01, Strict or Transitional.
-
-@item xhtml
-Supports publishing to XHTML 1.0 and XHTML 1.1, Strict or Transitional.
-
-@end table
-
-@subheading Options provided
-
-If an HTML option does not have a corresponding XHTML option, it will
-be used for both of these publishing styles.
-
-These publishing styles use the same options for markup up special
-characters as the ``xml'' publishing style. @xref{XML}, for details.
-
-@table @code
-
-@item muse-html-extension
-Default file extension for publishing HTML files.
-
-@item muse-xhtml-extension
-Default file extension for publishing XHTML files.
-
-@item muse-html-style-sheet
-Store your stylesheet definitions here.
-
-This is used in @code{muse-html-header}. You can put raw CSS in here or
-a @verb{|<link>|} tag to an external stylesheet. This text may contain
-@verb{|<lisp>|} markup tags.
-
-If you are publishing to XHTML, then customize the
-@code{muse-xhtml-style-sheet} option instead.
-
-@item muse-xhtml-style-sheet
-Store your stylesheet definitions here.
-
-This is used in @code{muse-xhtml-header}. You can put raw CSS in here
-or a @verb{|<link>|} tag to an external stylesheet. This text may
-contain @verb{|<lisp>|} markup tags.
-
-@item muse-html-header
-Header used for publishing HTML files.
-
-This may be text or a filename.
-
-@item muse-html-footer
-Footer used for publishing HTML files.
-
-This may be text or a filename.
-
-@item muse-xhtml-header
-Header used for publishing XHTML files.
-
-This may be text or a filename.
-
-@item muse-xhtml-footer
-Footer used for publishing XHTML files.
-
-This may be text or a filename.
-
-@item muse-html-anchor-on-word
-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.
-
-@item muse-html-table-attributes
-The attribute to be used with HTML @verb{|<table>|} tags.
-
-If you want to make more-complicated tables in HTML, surround the HTML
-with the @verb{|literal|} tag, so that it does not get escaped.
-
-@item muse-html-markup-regexps
-List of markup rules for publishing a Muse page to HTML.
-
-@item muse-html-markup-functions
-An alist of style types to custom functions for that kind of text.
-
-@item muse-html-markup-strings
-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.
-
-@item muse-xhtml-markup-strings
-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.
-
-@item muse-html-markup-tags
-A list of tag specifications, for specially marking up HTML.
-@xref{muse-publish-markup-tags}, for more information.
-
-@item muse-html-meta-http-equiv
-The http-equiv attribute used for the HTML @verb{|<meta>|} tag.
-
-@item muse-html-meta-content-type
-The content type used for the HTML @verb{|<meta>|} tag.
-
-If you are striving for XHTML 1.1 compliance, you may want to change
-this to ``application/xhtml+xml''.
-
-@item muse-html-meta-content-encoding
-The charset to append to the HTML @verb{|<meta>|} tag.
-
-If set to the symbol 'detect, use @code{muse-xml-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.
-
-@item muse-html-charset-default
-The default HTML meta charset to use if no translation is found in
-@code{muse-xml-encoding-map}.
-
-@item muse-html-encoding-default
-The default Emacs buffer encoding to use in published files.
-This will be used if no special characters are found.
-
-@end table
-
-@node Ikiwiki, Journal, HTML, Publishing Styles
-@comment node-name, next, previous, up
-@section Integrating with ikiwiki
-
-Note: Support for Ikiwiki is not yet complete. Use at your own risk.
-
-Ikiwiki is a wiki compiler (@url{http://ikiwiki.info/}). Emacs Muse can
-(not yet) be used as a source format for Ikiwiki pages with the plugin
-@file{IkiWiki::Plugin::muse}.
-
-The @file{lisp/muse-ikiwiki.el} file provides publishing functions and
-styles for Ikiwiki. The plugin for Ikiwiki to recognize Muse files is
-provided by the @file{contrib/ikiwiki/IkiWiki/Plugin/muse.pm} file. Two
-sample init files are available in the @file{examples/ikiwiki}
-directory. Configure your @file{ikiwiki.setup} file so that the
-@code{muse_init} variable has the location of your Muse init file.
-
-If you are using CGI, The directory @file{contrib/ikiwiki/IkiWiki} must
-be copied to the same directory as the CGI script that Ikiwiki
-generates. When publishing your wiki, the @var{PERL5LIB} environment
-variable must contain the path to the @file{contrib/ikiwiki/IkiWiki}
-directory.
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, ikiwiki
-@item ikiwiki
-Supports publishing XHTML output that Ikiwiki can understand.
-
-@end table
-
-@subheading Options provided
-
-@table @code
-
-@item muse-ikiwiki-header
-Header used for publishing Ikiwiki output files.
-
-This may be text or a filename.
-
-@item muse-ikiwiki-footer
-Footer used for publishing Ikiwiki output files.
-
-This may be text or a filename.
-
-@end table
-
-@subheading Other relevant options
-
-@table @code
-
-@item muse-colors-evaluate-lisp-tags
-Specify whether to evaluate the contents of @verb{|<lisp>|} tags at
-display time. If nil, don't evaluate them. If non-nil, evaluate
-them.
-
-The actual contents of the buffer are not changed, only the
-displayed text.
-
-@item muse-html-src-allowed-modes
-Modes that we allow the @verb{|<src>|} tag to colorize. If @code{t},
-permit the @verb{|<src>|} tag to colorize any mode.
-
-If a list of mode names, such as @code{'("html" "latex")}, and the lang
-argument to @verb{|<src>|} is not in the list, then use fundamental mode
-instead.
-
-@item muse-publish-enable-dangerous-tags
-If non-nil, publish tags like @verb{|<lisp>|} and @verb{|<command>|}
-that can call external programs or expose sensitive information.
-Otherwise, ignore tags like this.
-
-This is useful to set to @code{nil} when the file to publish is coming
-from an untrusted source.
-
-@end table
-
-@node Journal, LaTeX, Ikiwiki, Publishing Styles
-@comment node-name, next, previous, up
-@section Keeping a journal or blog
-@cindex journal
-@cindex blog, journal style
-
-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.
-
-@example
-* 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>
-@end example
-
-The "qotd", or Quote of the Day, is entirely optional. When generated
-to HTML, this entry is rendered as the following.
-
-@example
-<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>
-@end example
-
-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 auto-generates tags
-for linking to the various entries.
-
-@subheading muse-project-alist considerations
-
-If you wish to publish an RDF or RSS feed, it is important to include
-the @option{:base-url} attribute in your @code{muse-project-alist} entry
-for your Journal projects. An example follows.
-
-@example
-(setq muse-project-alist
- '(("Journal" ("~/Journal/"
- :default "journal")
- (:base "journal-rss"
- :base-url "http://example.org/journal/";
- :path "~/public_html/journal"))))
-@end example
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, journal-html
-@item journal-html
-Publish journal entries as an HTML document.
-
-@cindex publishing styles, journal-xhtml
-@item journal-xhtml
-Publish journal entries as an XHTML document.
-
-@cindex publishing styles, journal-latex
-@item journal-latex
-Publish journal entries as a LaTeX document.
-
-@cindex publishing styles, journal-pdf
-@item journal-pdf
-Publish journal entries as a PDF document.
-
-@cindex publishing styles, journal-book-latex
-@item journal-book-latex
-Publish journal entries as a LaTeX book.
-
-@cindex publishing styles, journal-book-pdf
-@item journal-book-pdf
-Publish journal entries as a PDF book.
-
-@cindex publishing styles, journal-rdf
-@cindex publishing styles, RSS 1.0
-@item journal-rdf
-Publish journal entries as an RDF file (RSS 1.0).
-
-@cindex publishing styles, journal-rss
-@cindex publishing styles, RSS 2.0
-@item journal-rss
-Publish journal entries as an RSS file (RSS 2.0).
-
-@cindex publishing styles, journal-rss-entry
-@item journal-rss-entry
-Used internally by @code{journal-rss} and @code{journal-rdf} for
-publishing individual entries.
-
-@end table
-
-@subheading Options provided
-
-@table @code
-
-@item muse-journal-heading-regexp
-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.
-
-@item muse-journal-date-format
-Date format to use for journal entries.
-
-@item muse-journal-html-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.
-
-@item muse-journal-html-entry-template
-Template used to publish individual journal entries as HTML.
-
-This may be text or a filename.
-
-@item muse-journal-latex-section
-Template used to publish a LaTeX section.
-
-@item muse-journal-latex-subsection
-Template used to publish a LaTeX subsection.
-
-@item muse-journal-markup-tags
-A list of tag specifications, for specially marking up Journal entries.
-
-@xref{muse-publish-markup-tags}, for more information.
-
-This is used by @code{journal-latex} and its related styles, as well as
-the @code{journal-rss-entry} style, which both @code{journal-rdf} and
-@code{journal-rss} use.
-
-@item muse-journal-rdf-extension
-Default file extension for publishing RDF (RSS 1.0) files.
-
-@item muse-journal-rdf-base-url
-The base URL of the website referenced by the RDF file.
-
-@item muse-journal-rdf-header
-Header used for publishing RDF (RSS 1.0) files.
-
-This may be text or a filename.
-
-@item muse-journal-rdf-footer
-Footer used for publishing RDF (RSS 1.0) files.
-
-This may be text or a filename.
-
-@item muse-journal-rdf-date-format
-Date format to use for RDF entries.
-
-@item muse-journal-rdf-entry-template
-Template used to publish individual journal entries as RDF.
-
-This may be text or a filename.
-
-@item muse-journal-rdf-summarize-entries
-If non-nil, include only summaries in the RDF file, not the full data.
-
-The default is nil, because this annoys some subscribers.
-
-@item muse-journal-rss-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.
-
-@item muse-journal-rss-extension
-Default file extension for publishing RSS 2.0 files.
-
-@item muse-journal-rss-base-url
-The base URL of the website referenced by the RSS file.
-
-@item muse-journal-rss-header
-Header used for publishing RSS 2.0 files.
-
-This may be text or a filename.
-
-@item muse-journal-rss-footer
-Footer used for publishing RSS 2.0 files.
-
-This may be text or a filename.
-
-@item muse-journal-rss-date-format
-Date format to use for RSS 2.0 entries.
-
-@item muse-journal-rss-entry-template
-Template used to publish individual journal entries as RSS 2.0.
-
-This may be text or a filename.
-
-@item muse-journal-rss-enclosure-types-alist
-File types that are accepted as RSS enclosures.
-
-This is an alist that maps file extension to content type.
-
-Useful for podcasting.
-
-@item muse-journal-rss-summarize-entries
-If non-nil, include only summaries in the RSS file, not the full data.
-
-The default is nil, because this annoys some subscribers.
-
-@item muse-journal-rss-markup-regexps
-List of markup rules for publishing a Muse journal page to RSS.
-
-For more information on the structure of this list,
-@xref{muse-publish-markup-regexps}.
-
-@item muse-journal-rss-markup-functions
-An alist of style types to custom functions for that kind of text.
-
-For more on the structure of this list,
-@xref{muse-publish-markup-functions}.
-
-@end table
-
-@node LaTeX, Poem, Journal, Publishing Styles
-@comment node-name, next, previous, up
-@section Publishing LaTeX documents
-
-This publishing style is capable of producing LaTeX or PDF documents.
-
-If you wish to publish PDF documents, you will need to have a good LaTeX
-installation. For Debian and Ubuntu, this can be accomplished by
-installing the ``tetex-bin'' and ``tetex-extra'' packages. TeX fonts
-are also a must.
-
-If your LaTeX installation has the file @file{grffile.sty}, which may be
-found in the @file{texlive-latex-recommended} package for Debian and
-Ubuntu, then consider using it by adding the following to your header
-file. This allows spaces in filenames to work.
-
-@example
-\usepackage@{grffile@}
-@end example
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, latex
-@item latex
-Publish a LaTeX document.
-
-@cindex publishing styles, pdf
-@item pdf
-Publish a PDF document, using an external LaTeX document conversion
-tool.
-
-@cindex publishing styles, latexcjk
-@item latexcjk
-Publish a LaTeX document with CJK (Chinese) encodings.
-
-@cindex publishing styles, pdfcjk
-@item pdfcjk
-Publish a PDF document with CJK (Chinese) encodings, using an external
-LaTeX document conversion tool.
-
-@cindex publishing styles, slides
-@item slides
-Publish a LaTeX document that uses the Beamer extension. This is
-suitable for producing slides.
-
-Here is an example of a slide.
-
-@example
-<slide title="First Slide">
-Everything between the slide tags composes this slide.
-
-[[Some-sort-of-cute-image.png]]
-
- - A bullet point.
- - Another bullet point.
-</slide>
-@end example
-
-@cindex publishing styles, slides-pdf
-@item slides-pdf
-Publish a PDF document of slides, using the Beamer extension.
-
-@cindex publishing styles, lecture-notes
-@item lecture-notes
-Publish a LaTeX document that uses the Beamer extension. This is
-suitable for producing lecture notes.
-
-This can also use the @verb{|<slide>|} tag.
-
-@cindex publishing styles, lecture-notes-pdf
-@item lecture-notes-pdf
-Publish a PDF document of lecture notes, using the Beamer extension.
-
-@end table
-
-@subheading Options provided
-
-@table @code
-
-@item muse-latex-extension
-Default file extension for publishing LaTeX files.
-
-@item muse-latex-pdf-extension
-Default file extension for publishing LaTeX files to PDF.
-
-@item muse-latex-pdf-browser
-The program to use when browsing a published PDF file.
-
-This should be a format string.
-
-@item muse-latex-pdf-program
-The program that is called to generate PDF content from LaTeX content.
-
-@item muse-latex-pdf-cruft
-Extensions of files to remove after generating PDF output successfully.
-
-@item muse-latex-header
-Header used for publishing LaTeX files.
-
-This may be text or a filename.
-
-@item muse-latex-footer
-Footer used for publishing LaTeX files.
-
-This may be text or a filename.
-
-@item muse-latexcjk-header
-Header used for publishing LaTeX files (CJK).
-
-This may be text or a filename.
-
-@item muse-latexcjk-footer
-Footer used for publishing LaTeX files (CJK).
-
-This may be text or a filename.
-
-@item muse-latex-slides-header
-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.
-
-@item muse-latex-lecture-notes-header
-Header 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.
-
-@item muse-latex-markup-regexps
-List of markup regexps for identifying regions in a Muse page.
-
-For more on the structure of this list,
-@xref{muse-publish-markup-regexps}.
-
-@item muse-latex-markup-functions
-An alist of style types to custom functions for that kind of text.
-
-For more on the structure of this list,
-@xref{muse-publish-markup-functions}.
-
-@item muse-latex-markup-strings
-Strings used for marking up text.
-
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-@item muse-latex-slides-markup-tags
-A list of tag specifications, for specially marking up LaTeX slides.
-
-@item muse-latexcjk-encoding-map
-An alist mapping emacs coding systems to appropriate CJK codings.
-Use the base name of the coding system (ie, without the -unix).
-
-@item muse-latexcjk-encoding-default
-The default Emacs buffer encoding to use in published files.
-
-This will be used if no special characters are found.
-
-@item muse-latex-markup-specials-document
-A table of characters which must be represented specially.
-These are applied to the entire document, sans already-escaped
-regions.
-
-@item muse-latex-markup-specials-example
-A table of characters which must be represented specially.
-These are applied to @verb{|example>|} regions.
-
-With the default interpretation of @verb{|<example>|} regions, no
-specials need to be escaped.
-
-@item muse-latex-markup-specials-literal
-A table of characters which must be represented specially.
-This applies to =monospaced text= and @verb{|<code>|} regions.
-
-@item muse-latex-markup-specials-url
-A table of characters which must be represented specially.
-These are applied to URLs.
-
-@item muse-latex-markup-specials-image
-A table of characters which must be represented specially.
-These are applied to image filenames.
-
-@item muse-latex-permit-contents-tag
-If nil, ignore @verb{|<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 @verb{|<contents>|} tag.
-
-If you don't agree with this, then set this option to non-nil,
-and it will do what you expect.
-
-@end table
-
-@node Poem, Texinfo, LaTeX, Publishing Styles
-@comment node-name, next, previous, up
-@section Publish a poem to LaTeX or PDF
-
-The @code{muse-poem} module makes it easy to attractively publish and
-reference poems in the following format, using the "memoir" module for
-LaTeX publishing. It will also markup poems for every other output
-style, though none are nearly as pretty.
-
-@example
-Title
-
-
-Body of poem
-
-
-Annotations, history, notes, etc.
-@end example
-
-Once a poem is written in this format, just publish it to PDF using the
-@code{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.
-
-@example
-<poem title="name.of.poem.page">
-@end example
-
-Let's assume the template above was called @file{name.of.poem.page};
-then the above tag would result in this inclusion.
-
-@example
-** Title
-
-> Body of poem
-@end example
-
-John Wiegley uses this module for publishing all of the poems on his
-website, which are at
-@uref{http://www.newartisans.com/johnw/poems.html}.
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, poem-latex
-@item poem-latex
-Publish a poem in LaTeX form.
-
-@cindex publishing styles, poem-pdf
-@item poem-pdf
-Publish a poem to a PDF document.
-
-@cindex publishing styles, chapbook-latex
-@item chapbook-latex
-Publish a book of poems in LaTeX form.
-
-@cindex publishing styles, chapbook-pdf
-@item chapbook-pdf
-Publish a book of poems to a PDF document.
-
-@end table
-
-@subheading Options provided
-
-@table @code
-
-@item muse-poem-latex-header
-Header used for publishing LaTeX poems.
-
-This may be text or a filename.
-
-@item muse-poem-latex-footer
-Footer used for publishing LaTeX files.
-
-This may be text or a filename.
-
-@item muse-poem-markup-strings
-Strings used for marking up poems.
-
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-@item muse-chapbook-latex-header
-Header used for publishing a book of poems in LaTeX form.
-
-This may be text or a filename.
-
-@item muse-chapbook-latex-footer
-Footer used for publishing a book of poems in LaTeX form.
-
-This may be text or a filename.
-
-@item muse-poem-chapbook-strings
-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.
-
-@end table
-
-@node Texinfo, XML, Poem, Publishing Styles
-@comment node-name, next, previous, up
-@section Publish entries to Texinfo format or PDF
-
-Rules for publishing a Muse file as a Texinfo article.
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, texi
-@item texi
-Publish a file in Texinfo form.
-
-@cindex publishing styles, texi
-@item info
-Generate an Info file from a Muse file.
-
-@cindex publishing styles, info-pdf
-@item info-pdf
-Publish a file in PDF form.
-
-@end table
-
-@subheading Options provided
-
-@table @code
-
-@item muse-texinfo-process-natively
-If non-nil, use the Emacs `texinfmt' module to make Info files.
-
-@item muse-texinfo-extension
-Default file extension for publishing Texinfo files.
-
-@item muse-texinfo-info-extension
-Default file extension for publishing Info files.
-
-@item muse-texinfo-pdf-extension
-Default file extension for publishing PDF files.
-
-@item muse-texinfo-header
-Text to prepend to a Muse page being published as Texinfo.
-
-This may be text or a filename.
-It may contain @verb{|<lisp>|} markup tags.
-
-@item muse-texinfo-footer
-Text to append to a Muse page being published as Texinfo.
-
-This may be text or a filename.
-It may contain @verb{|<lisp>|} markup tags.
-
-@item muse-texinfo-markup-regexps
-List of markup rules for publishing a Muse page to Texinfo.
-
-For more on the structure of this list,
-@xref{muse-publish-markup-regexps}.
-
-@item muse-texinfo-markup-functions
-An alist of style types to custom functions for that kind of text.
-
-For more on the structure of this list,
-@xref{muse-publish-markup-functions}.
-
-@item muse-texinfo-markup-strings
-Strings used for marking up text.
-
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-@item muse-texinfo-markup-specials
-A table of characters which must be represented specially.
-
-@item muse-texinfo-markup-specials
-A table of characters which must be represented specially.
-These are applied to URLs.
-
-@end table
-
-@node XML, , Texinfo, Publishing Styles
-@comment node-name, next, previous, up
-@section Publish entries to XML
-
-Muse is capable of publishing XML documents, with the help of the
-@file{muse-xml.el} module.
-
-A RelaxNG schema is available as part of the Muse distribution in the
-@file{etc/muse.rnc} file.
-
-@subheading Styles provided
-
-@table @code
-
-@cindex publishing styles, xml
-@item xml
-Publish a file in XML form.
-
-@end table
-
-@subheading Options provided
-
-@table @code
-
-@cindex muse-xml-encoding-map
-@item muse-xml-encoding-map
-An alist mapping Emacs coding systems to appropriate XML charsets.
-Use the base name of the coding system (i.e. without the -unix).
-
-@item muse-xml-markup-specials
-A table of characters which must be represented specially in all
-XML-like markup formats.
-
-@item muse-xml-markup-specials-url-extra
-A table of characters which must be represented specially in all
-XML-like markup formats.
-
-These are extra characters that are escaped within URLs.
-
-@item muse-xml-extension
-Default file extension used for publishing XML files.
-
-@item muse-xml-header
-Header used for publishing XML files.
-
-This may be text or a filename.
-
-@item muse-xml-footer
-Footer used for publishing XML files.
-
-This may be text or a filename.
-
-@item muse-xml-markup-regexps
-List of markup rules for publishing a Muse page to XML.
-
-For more on the structure of this list,
-@xref{muse-publish-markup-regexps}.
-
-@item muse-xml-markup-functions
-An alist of style types to custom functions for that kind of text.
-
-For more on the structure of this list,
-@xref{muse-publish-markup-functions}.
-
-@item muse-xml-markup-strings
-Strings used for marking up text.
-
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-@item muse-xml-encoding-default
-The default Emacs buffer encoding to use in published files.
-
-This will be used if no special characters are found.
-
-@item muse-xml-charset-default
-The default XML charset to use if no translation is found in
-@code{muse-xml-encoding-map}.
-
-@end table
-
-
-@node Extending Muse, Miscellaneous, Publishing Styles, Top
-@comment node-name, next, previous, up
-@chapter Making your own publishing styles
-
-@menu
-* Markup Functions:: Specifying functions to mark up text.
-* Markup Regexps:: Markup rules for publishing.
-* Markup Strings:: Strings specific to a publishing style.
-* Markup Tags:: Tag specifications for special markup.
-* Style Elements:: Parameters used for defining styles.
-* Deriving Styles:: Deriving a new style from an existing
- one.
-@end menu
-
-@node Markup Functions, Markup Regexps, , Extending Muse
-@comment node-name, next, previous, up
-@section Specifying functions to mark up text
-@cindex publishing, markup functions
-
-@anchor{muse-publish-markup-functions}
-@code{muse-publish-markup-functions}
-
-An alist of style types to custom functions for that kind of text.
-
-This is used by publishing styles to attempt to minimize the amount of
-custom regexps that each has to define. @file{muse-publish} provides
-rules for the most common types of markup.
-
-Each member of the list is of the following form.
-
-@example
-(SYMBOL FUNCTION)
-@end example
-
-@itemize @bullet
-@item SYMBOL
-Describes the type of text to associate with this rule.
-@code{muse-publish-markup-regexps} maps regexps to these symbols.
-
-@item FUNCTION
-Function to use to mark up this kind of rule if no suitable function is
-found through the @option{:functions} tag of the current style.
-@end itemize
-
-@node Markup Regexps, Markup Strings, Markup Functions, Extending Muse
-@comment node-name, next, previous, up
-@section Markup rules for publishing
-@cindex publishing, markup regexps
-@cindex publishing, rules
-
-@anchor{muse-publish-markup-regexps}
-@code{muse-publish-markup-regexps}
-
-List of markup rules for publishing a page with Muse.
-
-The rules given in this variable are invoked first, followed by whatever
-rules are specified by the current style.
-
-Each member of the list is either a function, or a list of the following
-form.
-
-@example
-(REGEXP/SYMBOL TEXT-BEGIN-GROUP REPLACEMENT-TEXT/FUNCTION/SYMBOL)
-@end example
-
-@itemize @bullet
-@item REGEXP
-A regular expression, or symbol whose value is a regular expression,
-which is searched for using `re-search-forward'.
-
-@item TEXT-BEGIN-GROUP
-The matching group within that regexp which denotes the beginning of the
-actual text to be marked up.
-
-@item REPLACEMENT-TEXT
-A string that will be passed to `replace-match'.
-
-If it is not a string, but a function, it will be called to determine
-what the replacement text should be (it must return a string). If it is
-a symbol, the value of that symbol should be a string.
-@end itemize
-
-The replacements are done in order, one rule at a time. Writing
-the regular expressions can be a tricky business. Note that case
-is never ignored. `case-fold-search' is always bound to nil
-while processing the markup rules.
-
-@subheading Publishing order
-
-This is the order that the publishing rules are consulted, by default.
-This may be changed by customizing @code{muse-publish-markup-regexps}.
-
-@table @code
-
-@item trailing and leading whitespace
-Remove trailing and leading whitespace from a file.
-
-@item directive
-@samp{#directive}
-
-This is only recognized at the beginning of a file.
-
-@item comment
-@samp{; a commented line}
-
-@item tag
-@samp{<tag>}
-
-@item comment
-@samp{; comment}
-
-@item explicit links
-Prevent emphasis characters in explicit links from being marked up.
-
-Don't actually publish them here, just add a special no-emphasis text
-property.
-
-@item word
-Whitespace-delimited word, possibly with emphasis characters
-
-This function is responsible for marking up emphasis and escaping some
-specials.
-
-@item heading
-@samp{** Heading}
-
-Outline-mode style headings.
-
-@item enddots
-@samp{....}
-
-These are ellipses with a dot at end.
-
-@item dots
-@samp{...}
-
-Ellipses.
-
-@item rule
-@samp{----}
-
-Horizontal rule or section separator.
-
-@item no-break-space
-@samp{~~}
-
-Prevent lines from being split before or after these characters.
-
-@item line-break
-@samp{<br>}
-
-Break a line at point.
-
-@item fn-sep
-@samp{Footnotes:}
-
-Beginning of footnotes section.
-
-@item footnote
-@samp{[1]}
-
-Footnote definition or reference. If at beginning of line, it is a
-definition.
-
-@item list
-@itemize @bullet
-@item
-@samp{ 1. }
-
-@item
-@samp{ - }
-
-@item
-@samp{term :: }
-@end itemize
-
-Numbered list, item list, or term definition list.
-
-@item table-el
-
-@file{table.el} style tables
-
-@item table
-@samp{table | cells}
-
-Muse tables or orgtbl-mode style tables.
-
-@item quote
-spaces before beginning of text
-
-Blockquotes.
-
-@item emdash
-@samp{--}
-
-2-wide dash
-
-@item verse
-@samp{> verse text}
-
-@item anchor
-@samp{#anchor}
-
-@item link
-@samp{[[explicit][links]]}
-
-@item url
-@samp{http://example.com/}
-
-@item email
-@samp{bare-email@@example.com}
-
-@end table
-
-@node Markup Strings, Markup Tags, Markup Regexps, Extending Muse
-@comment node-name, next, previous, up
-@section Strings specific to a publishing style
-@cindex publishing, markup strings
-
-@dfn{Markup strings} are strings used for marking up text for a
-particular style.
-
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-@subheading Available markup strings
-
-@table @code
-
-@item image-with-desc
-An image and a description.
-
-Argument 1: image without extension. Argument 2: image extension.
-Argument 3: description.
-
-@item image
-An inlined image.
-
-Argument 1: image without extension. Argument 2: image extension.
-
-@item image-link
-An image with a link around it.
-
-Argument 1: link. Argument 2: image without extension.
-Argument 3: image extension.
-
-@item anchor-ref
-A reference to an anchor on the current page.
-
-Argument 1: anchor name. Argument 2: description if one exists, or the
-original link otherwise.
-
-@item url
-A URL without a description.
-
-Argument 1: URL.
-
-@item link
-A link to a Muse page with a description.
-
-Argument 1: link. Argument 2: description if one exists, or the
-original link otherwise.
-
-@item link-and-anchor
-A link to a Muse page with an anchor, and a description.
-
-Argument 1: link. Argument 2: anchor name.
-Argument 3: description if one exists, or the original link otherwise.
-Argument 4: link without an extension.
-
-@item email-addr
-A link to an email address.
-
-Argument 1: email address. Argument 2: email address.
-
-@item anchor
-An anchor.
-
-Argument 1: name of anchor.
-
-@item emdash
-A 2-length dash.
-
-Argument 1: Initial whitespace. Argument 2: Terminating whitespace.
-
-@item comment-begin
-Beginning of a comment.
-
-@item comment-end
-End of a comment.
-
-@item rule
-A horizontal line or space.
-
-@item no-break-space
-A space that separates two words which are not to be separated.
-
-@item footnote
-Beginning of footnote.
-
-@item footnote-end
-End of footnote.
-
-@item footnotemark
-Mark a reference for the current footnote.
-
-Argument 1: number of this footnote.
-
-@item footnotemark-end
-End of a reference for the current footnote.
-
-@item footnotetext
-Indicate the text of the current footnote.
-
-Argument 1: number of this footnote.
-
-@item footnotetext-end
-End of a footnote text line.
-
-@item fn-sep
-Text used to replace ``Footnotes:'' line.
-
-@item dots
-3 dots.
-
-@item enddots
-4 dots.
-
-@item part
-Beginning of a part indicator line. This is used by book publishing.
-
-@item part-end
-End of a part indicator line. This is used by book publishing.
-
-@item chapter
-Beginning of a chapter indicator line. This is used by book publishing.
-
-@item chapter-end
-End of a chapter indicator line. This is used by book publishing.
-
-@item section
-Beginning of level 1 section indicator line.
-
-Argument 1: level of section; always 1.
-
-@item section-end
-End of level 1 section indicator line.
-
-Argument 1: level of section; always 1.
-
-@item subsection
-Beginning of level 2 section indicator line.
-
-Argument 1: level of section; always 2.
-
-@item subsection-end
-End of level 2 section indicator line.
-
-Argument 1: level of section; always 2.
-
-@item subsubsection
-Beginning of level 3 section indicator line.
-
-Argument 1: level of section; always 3.
-
-@item subsubsection-end
-End of level 3 section indicator line.
-
-Argument 1: level of section; always 3.
-
-@item section-other
-Beginning of section indicator line, where level is greater than 3.
-
-Argument 1: level of section.
-
-@item section-other-end
-End of section indicator line, where level is greater than 3.
-
-Argument 1: level of section.
-
-@item begin-underline
-Beginning of underlined text.
-
-@item end-underline
-End of underlined text.
-
-@item begin-literal
-Beginning of verbatim text. This includes @verb{|<code>|} tags and
-=teletype text=.
-
-@item end-literal
-End of verbatim text. This includes @verb{|<code>|} tags and =teletype
-text=.
-
-@item begin-emph
-Beginning of the first level of emphasized text.
-
-@item end-emph
-End of the first level of emphasized text.
-
-@item begin-more-emph
-Beginning of the second level of emphasized text.
-
-@item end-more-emph
-End of the second level of emphasized text.
-
-@item begin-most-emph
-Beginning of the third (and final) level of emphasized text.
-
-@item end-most-emph
-End of the third (and final) level of emphasized text.
-
-@item begin-verse
-Beginning of verse text.
-
-@item verse-space
-String used to each space that is further indented than the beginning of
-the verse.
-
-@item begin-verse-line
-Beginning of a line of verse.
-
-@item empty-verse-line
-End of a line of verse.
-
-@item begin-last-stanza-line
-Beginning of the last line of a verse stanza.
-
-@item end-last-stanza-line
-End of the last line of a verse stanza.
-
-@item end-verse
-End of verse text.
-
-@item begin-example
-Beginning of an example region. To make use of this, an
-@samp{<example>} tag is needed.
-
-@item end-example
-End of an example region. To make use of this, an @samp{</example>} tag
-is needed.
-
-@item begin-center
-Begin a centered line.
-
-@item end-center
-End a centered line.
-
-@item begin-quote
-Begin a quoted region.
-
-@item end-quote
-End a quoted region.
-
-@item begin-quote-item
-Begin a quote paragraph.
-
-@item end-quote-item
-End a quote paragraph.
-
-@item begin-uli
-Begin an unordered list.
-
-@item end-uli
-End an unordered list.
-
-@item begin-uli-item
-Begin an unordered list item.
-
-@item end-uli-item
-End an unordered list item.
-
-@item begin-oli
-Begin an ordered list.
-
-@item end-oli
-End an ordered list.
-
-@item begin-oli-item
-Begin an ordered list item.
-
-@item end-oli-item
-End an ordered list item.
-
-@item begin-dl
-Begin a definition list.
-
-@item end-dl
-End a definition list.
-
-@item begin-dl-item
-Begin a definition list item.
-
-@item end-dl-item
-End a definition list item.
-
-@item begin-ddt
-Begin a definition list term.
-
-@item end-ddt
-End a definition list term.
-
-@item begin-dde
-Begin a definition list entry.
-
-@item end-dde
-End a definition list entry.
-
-@item begin-table
-Begin a table.
-
-@item end-table
-End a table.
-
-@item begin-table-group
-Begin a table grouping.
-
-@item end-table-group
-End a table grouping.
-
-@item begin-table-row
-Begin a table row.
-
-@item end-table-row
-End a table row.
-
-@item begin-table-entry
-Begin a table entry.
-
-@item end-table-entry
-End a table entry.
-
-@end table
-
-@node Markup Tags, Style Elements, Markup Strings, Extending Muse
-@comment node-name, next, previous, up
-@section Tag specifications for special markup
-@cindex publishing, markup tags
-
-@anchor{muse-publish-markup-tags}
-@code{muse-publish-markup-tags}
-
-A list of tag specifications, for specially marking up text.
-
-XML-style tags are the best way to add custom markup to Muse. This is
-easily accomplished by customizing this list of markup tags.
-
-For each entry, the name of the tag is given, whether it expects a
-closing tag and/or an optional set of attributes, whether it is
-nestable, and a function that performs whatever action is desired within
-the delimited region.
-
-The tags themselves are deleted during publishing, before the function
-is called. The function is called with three arguments, the beginning
-and end of the region surrounded by the tags. If properties are
-allowed, they are passed as a third argument in the form of an alist.
-The `end' argument to the function is always a marker.
-
-Point is always at the beginning of the region within the tags, when the
-function is called. Wherever point is when the function finishes is
-where tag markup will resume.
-
-These tag rules are processed once at the beginning of markup, and once
-at the end, to catch any tags which may have been inserted in-between.
-
-@node Style Elements, Deriving Styles, Markup Tags, Extending Muse
-@comment node-name, next, previous, up
-@section Parameters used for defining styles
-@cindex publishing, style elements
-
-Style elements are tags that define a style. Use either
-@code{muse-define-style} or @code{muse-derive-style}
-(@pxref{Deriving Styles}) to create a new style.
-
-@defun muse-define-style name &rest elements
-@end defun
-
-@subheading Usable elements
-
-@table @option
-
-@item :suffix
-File extension to use for publishing files with this style.
-
-@item :link-suffix
-File extension to use for publishing links to Muse files with this
-style.
-
-@item :osuffix
-File extension to use for publishing second-stage files with this style.
-
-For example, PDF publishing generates a LaTeX file first, then a PDF
-from that LaTeX file.
-
-@item :regexps
-List of markup rules for publishing a page with Muse.
-@xref{muse-publish-markup-regexps}.
-
-@item :functions
-An alist of style types to custom functions for that kind of text.
-@xref{muse-publish-markup-functions}.
-
-@item :strings
-Strings used for marking up text with this style.
-
-These cover the most basic kinds of markup, the handling of which
-differs little between the various styles.
-
-@item :tags
-A list of tag specifications, used for handling extra tags.
-@xref{muse-publish-markup-tags}.
-
-@item :specials
-A table of characters which must be represented specially.
-
-@item :before
-A function that is to be executed on the newly-created publishing buffer
-(or the current region) before any publishing occurs.
-
-This is used to set extra parameters that direct the publishing process.
-
-@item :before-end
-A function that is to be executed on the publishing buffer (or the
-current region) immediately after applying all of the markup regexps.
-
-This is used to fix the order of table elements (header, footer, body)
-in XML-ish styles.
-
-@item :after
-A function that is to be executed on the publishing buffer after
-:before-end, and immediately after inserting the header and footer.
-
-This is used for generating the table of contents as well as setting the
-file coding system.
-
-@item :final
-A function that is to be executed after saving the published file, but
-while still in its buffer.
-
-This is used for generating second-stage documents like PDF files from
-just-published LaTeX files.
-
-The function must accept three arguments: the name of the muse source
-file, the name of the just-published file, and the name of the
-second-stage target file. The name of the second-stage target file is
-the same as that of the just-published file if no second-stage
-publishing is required.
-
-@item :header
-Header used for publishing files of this style.
-
-This may be a variable, text, or a filename. It is inserted at the
-beginning of a file, after evaluating the publishing markup.
-
-@item :footer
-Footer used for publishing files of this style.
-
-This may be a variable, text, or a filename. It is inserted at the end
-of a file, after evaluating the publishing markup.
-
-@item :style-sheet
-Style sheet used for publishing files of this style.
-
-This may be a variable or text. It is used in the header of HTML and
-XHTML based publishing styles.
-
-@item :browser
-The function used to browse the published result of files of this style.
-
-@end table
-
-@node Deriving Styles, , Style Elements, Extending Muse
-@comment node-name, next, previous, up
-@section Deriving a new style from an existing one
-@cindex publishing styles, deriving
-
-To create a new style from an existing one, use @code{muse-derive-style}
-as follows. This is a good way to fix something you don't like about a
-particular publishing style, or to personalize it.
-
-@defun muse-derive-style new-name base-name &rest elements
-@end defun
-
-The derived name is a string defining the new style, such as "my-html".
-The base name must identify an existing style, such as "html" -- if you
-have loaded @file{muse-html}. The style parameters are the same as
-those used to create a style, except that they override whatever
-definitions exist in the base style. However, some definitions only
-partially override. The following parameters support partial
-overriding.
-
-@xref{Style Elements}, for a complete list of all parameters.
-
-@table @option
-
-@item :functions
-If a markup function is not found in the derived style's function list,
-the base style's function list will be queried.
-
-@item :regexps
-All regexps in the current style and the base style(s) will be used.
-
-@item :strings
-If a markup string is not found in the derived style's string list, the
-base style's string list will be queried.
-
-@end table
-
-@node Miscellaneous, Getting Help and Reporting Bugs, Extending Muse, Top
-@comment node-name, next, previous, up
-@chapter Miscellaneous add-ons, like a minor mode
-
-@menu
-* Muse List Edit Minor Mode:: Edit lists easily in other major modes.
-@end menu
-
-@node Muse List Edit Minor Mode, , , Miscellaneous
-@comment node-name, next, previous, up
-@section Edit lists easily in other major modes
-@cindex muse-list-edit-minor-mode
-
-@code{muse-list-edit-minor-mode} is meant to be used with other major
-modes, such as Message (for composing email) and debian-changelog-mode
-(for editing debian/changelog files).
-
-It implements practically perfect support for editing and filling lists.
-It can even handle nested lists. In addition to Muse-specific list
-items ("-", numbers, definition lists, footnotes), it can also handle
-items that begin with "*" or "+". Filling list items behaves in the
-same way that it does in Muse, regardless of whether filladapt is also
-enabled, which is the primary reason to use this tool.
-
-@subheading Installation
-
-To use it, add ``(require 'muse-mode)'' to your Emacs customization file
-and add the function @code{turn-on-muse-list-edit-minor-mode} to any
-mode hooks where you wish to enable this minor mode.
-
-@subheading Keybindings
-
-@code{muse-list-edit-minor-mode} uses the following keybindings.
-
-@table @kbd
-
-@item M-RET (`muse-l-e-m-m-insert-list-item')
-Insert a new list item at point, using the indentation level of the
-current list item.
-
-@item C-< (`muse-l-e-m-m-decrease-list-item-indent')
-Decrease indentation of the current list item.
-
-@item C-> (`muse-l-e-m-m-increase-list-item-indent')
-Increase indentation of the current list item.
-
-@end table
-
-@subheading Functions
-
-@defun muse-list-edit-minor-mode
-This is a global minor mode for editing files with lists.
-It is meant to be used with other major modes, and not with Muse mode.
-
-Interactively, with no prefix argument, toggle the mode.
-With universal prefix @var{arg} turn mode on.
-With zero or negative @var{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 @code{left-margin}, such as
-@code{debian-changelog-mode}.
-@end defun
-
-@defun turn-on-muse-list-edit-minor-mode
-Unconditionally turn on Muse list edit minor mode.
-@end defun
-
-@defun turn-off-muse-list-edit-minor-mode
-Unconditionally turn off Muse list edit minor mode.
-@end defun
-
-@node Getting Help and Reporting Bugs, History, Miscellaneous, Top
-@comment node-name, next, previous, up
-@chapter Getting Help and Reporting Bugs
-@cindex help, getting
-@cindex bugs, reporting
-
-After you have read this guide, if you still have questions about
-Muse, or if you have bugs to report, there are several places you can
-go.
-
-@itemize @bullet
-
-@item
-@uref{http://www.emacswiki.org/cgi-bin/wiki/EmacsMuse} is the
-emacswiki.org page, and anyone may add tips, hints, or bug descriptions
-to it.
-
-@item
-@uref{http://mwolson.org/projects/EmacsMuse.html} is the web page
-that Michael Olson (the current maintainer) made for Muse.
-
-@item
-Muse has several different mailing lists.
-
-@table @samp
-
-@item muse-el-announce
-Low-traffic list for Muse-related announcements.
-
-You can join this mailing list (@email{muse-el-announce@@gna.org})
-using the subscription form at
-@url{http://mail.gna.org/listinfo/muse-el-announce/}. This
-mailing list is also available via Gmane (@url{http://gmane.org/}). The
-group is called @samp{gmane.emacs.muse.announce}.
-
-@item muse-el-discuss
-Discussion, bugfixes, suggestions, tips, and the like for Muse.
-This mailing list also includes the content of muse-el-announce.
-
-You can join this mailing list (@email{muse-el-discuss@@gna.org})
-using the subscription form at
-@url{http://mail.gna.org/listinfo/muse-el-discuss/}. This mailing
-list is also available via Gmane with the identifier
-@samp{gmane.emacs.muse.general}.
-
-@item muse-el-logs
-Log messages for commits made to Muse.
-
-You can join this mailing list (@email{muse-el-logs@@gna.org}) using
-the subscription form at
-@url{http://mail.gna.org/listinfo/muse-el-logs/}. This mailing list
-is also available via Gmane with the identifier
-@samp{gmane.emacs.muse.scm}.
-
-@item muse-el-commits
-Generated bug reports for Emacs Muse. If you use our bug-tracker at
-@url{https://gna.org/bugs/?group=muse-el}, the bug reports will be
-sent to this list automatically.
-
-You can join this mailing list (@email{muse-el-commits@@gna.org}) using
-the subscription form at
-@url{http://mail.gna.org/listinfo/muse-el-commits/}. This mailing list
-is also available via Gmane with the identifier
-@samp{gmane.emacs.muse.cvs}.
-
-@item muse-el-internationalization
-Discussion of translation of the Muse website and documentation into
-many languages.
-
-You can join this mailing list
-(@email{muse-el-internationalization@@gna.org}) using the subscription
-form at @url{http://mail.gna.org/listinfo/internationalization/}. This
-mailing list is also available via Gmane with the identifier
-@samp{gmane.emacs.muse.internationalization}.
-
-@end table
-
-@item
-You can visit the IRC Freenode channel @samp{#emacs}. Many of the
-contributors are frequently around and willing to answer your
-questions. The @samp{#muse} channel is also available for
-Muse-specific help, and its current maintainer hangs out there.
-
-@item
-The maintainer of Emacs Muse, Michael Olson, may be contacted at
-@email{mwolson@@gnu.org}. He can be rather slow at answering email, so
-it is often better to use the muse-el-discuss mailing list.
-
-@end itemize
-
-@node History, Contributors, Getting Help and Reporting Bugs, Top
-@comment node-name, next, previous, up
-@chapter History of This Document
-@cindex history, of Muse
-
-@itemize
-@item 2004
-John Wiegley started Muse upon realizing that EmacsWiki had some serious
-limitations. Around February 2004, he started making "emacs-wiki version
-3.00 APLHA", which eventually became known as Muse.
-
-Most of those who frequent the emacs-wiki mailing list continued to use
-emacs-wiki, mainly because Planner hasn't been ported over to it.
-
-As of 2004-12-01, Michael Olson became the maintainer of Muse, as per
-John Wiegley's request.
-
-@item 2005
-Michael Olson overhauled this document and added many new sections in
-preparation for the first release of Muse (3.01).
-
-@end itemize
-
-@node Contributors, GNU Free Documentation License, History, Top
-@comment node-name, next, previous, up
-@chapter Contributors to This Documentation
-@cindex contributors
-
-The first draft of this document was taken from the emacs-wiki texinfo
-manual. Michael Olson adapted it for Muse and added most of its
-content.
-
-John Sullivan did a majority of the work on the emacs-wiki texinfo
-manual.
-
-While Sacha Chua maintained emacs-wiki, she worked quite a bit on the
-emacs-wiki texinfo manual.
-
-
-@node GNU Free Documentation License, Concept Index, Contributors, Top
-@appendix GNU Free Documentation License
-@include doclicense.texi
-
-
-@node Concept Index, , GNU Free Documentation License, Top
-@comment node-name, next, previous, up
-@unnumbered Index
-
-@printindex cp
-
-@bye
diff --git a/packages/pinentry/pinentry.el b/packages/pinentry/pinentry.el
deleted file mode 100644
index 50ea614..0000000
--- a/packages/pinentry/pinentry.el
+++ /dev/null
@@ -1,460 +0,0 @@
-;;; pinentry.el --- GnuPG Pinentry server implementation -*- lexical-binding:
t -*-
-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@gnu.org>
-;; Version: 0.1
-;; Keywords: GnuPG
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package allows GnuPG passphrase to be prompted through the
-;; minibuffer instead of graphical dialog.
-;;
-;; To use, add "allow-emacs-pinentry" to "~/.gnupg/gpg-agent.conf",
-;; reload the configuration with "gpgconf --reload gpg-agent", and
-;; start the server with M-x pinentry-start.
-;;
-;; The actual communication path between the relevant components is
-;; as follows:
-;;
-;; gpg --> gpg-agent --> pinentry --> Emacs
-;;
-;; where pinentry and Emacs communicate through a Unix domain socket
-;; created at:
-;;
-;; ${TMPDIR-/tmp}/emacs$(id -u)/pinentry
-;;
-;; under the same directory which server.el uses. The protocol is a
-;; subset of the Pinentry Assuan protocol described in (info
-;; "(pinentry) Protocol").
-;;
-;; NOTE: As of August 2015, this feature requires newer versions of
-;; GnuPG (2.1.5+) and Pinentry (0.9.5+).
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-
-(defgroup pinentry nil
- "The Pinentry server"
- :version "25.1"
- :group 'external)
-
-(defcustom pinentry-popup-prompt-window t
- "If non-nil, display multiline prompt in another window."
- :type 'boolean
- :group 'pinentry)
-
-(defcustom pinentry-prompt-window-height 5
- "Number of lines used to display multiline prompt."
- :type 'integer
- :group 'pinentry)
-
-(defvar pinentry-debug nil)
-(defvar pinentry-debug-buffer nil)
-(defvar pinentry--server-process nil)
-(defvar pinentry--connection-process-list nil)
-
-(defvar pinentry--labels nil)
-(put 'pinentry-read-point 'permanent-local t)
-(defvar pinentry--read-point nil)
-(put 'pinentry--read-point 'permanent-local t)
-
-(defvar pinentry--prompt-buffer nil)
-
-;; We use the same location as `server-socket-dir', when local sockets
-;; are supported.
-(defvar pinentry--socket-dir
- (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid))
- "The directory in which to place the server socket.
-If local sockets are not supported, this is nil.")
-
-(defconst pinentry--set-label-commands
- '("SETPROMPT" "SETTITLE" "SETDESC"
- "SETREPEAT" "SETREPEATERROR"
- "SETOK" "SETCANCEL" "SETNOTOK"))
-
-;; These error codes are defined in libgpg-error/src/err-codes.h.in.
-(defmacro pinentry--error-code (code)
- (logior (lsh 5 24) code))
-(defconst pinentry--error-not-implemented
- (cons (pinentry--error-code 69) "not implemented"))
-(defconst pinentry--error-cancelled
- (cons (pinentry--error-code 99) "cancelled"))
-(defconst pinentry--error-not-confirmed
- (cons (pinentry--error-code 114) "not confirmed"))
-
-(autoload 'server-ensure-safe-dir "server")
-
-(defvar pinentry-prompt-mode-map
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap "q" 'quit-window)
- keymap))
-
-(define-derived-mode pinentry-prompt-mode special-mode "Pinentry"
- "Major mode for `pinentry--prompt-buffer'."
- (buffer-disable-undo)
- (setq truncate-lines t
- buffer-read-only t))
-
-(defun pinentry--prompt (labels query-function &rest query-args)
- (let ((desc (cdr (assq 'desc labels)))
- (error (cdr (assq 'error labels)))
- (prompt (cdr (assq 'prompt labels))))
- (when (string-match "[ \n]*\\'" prompt)
- (setq prompt (concat
- (substring
- prompt 0 (match-beginning 0)) " ")))
- (when error
- (setq desc (concat "Error: " (propertize error 'face 'error)
- "\n" desc)))
- (if (and desc pinentry-popup-prompt-window)
- (save-window-excursion
- (delete-other-windows)
- (unless (and pinentry--prompt-buffer
- (buffer-live-p pinentry--prompt-buffer))
- (setq pinentry--prompt-buffer (generate-new-buffer "*Pinentry*")))
- (if (get-buffer-window pinentry--prompt-buffer)
- (delete-window (get-buffer-window pinentry--prompt-buffer)))
- (with-current-buffer pinentry--prompt-buffer
- (let ((inhibit-read-only t)
- buffer-read-only)
- (erase-buffer)
- (insert desc))
- (pinentry-prompt-mode)
- (goto-char (point-min)))
- (if (> (window-height)
- pinentry-prompt-window-height)
- (set-window-buffer (split-window nil
- (- (window-height)
- pinentry-prompt-window-height))
- pinentry--prompt-buffer)
- (pop-to-buffer pinentry--prompt-buffer)
- (if (> (window-height) pinentry-prompt-window-height)
- (shrink-window (- (window-height)
- pinentry-prompt-window-height))))
- (prog1 (apply query-function prompt query-args)
- (quit-window)))
- (apply query-function (concat desc "\n" prompt) query-args))))
-
-;;;###autoload
-(defun pinentry-start (&optional quiet)
- "Start a Pinentry service.
-
-Once the environment is properly set, subsequent invocations of
-the gpg command will interact with Emacs for passphrase input.
-
-If the optional QUIET argument is non-nil, messages at startup
-will not be shown."
- (interactive)
- (unless (featurep 'make-network-process '(:family local))
- (error "local sockets are not supported"))
- (if (process-live-p pinentry--server-process)
- (unless quiet
- (message "Pinentry service is already running"))
- (let* ((server-file (expand-file-name "pinentry" pinentry--socket-dir)))
- (server-ensure-safe-dir pinentry--socket-dir)
- ;; Delete the socket files made by previous server invocations.
- (ignore-errors
- (let (delete-by-moving-to-trash)
- (delete-file server-file)))
- (cl-letf (((default-file-modes) ?\700))
- (setq pinentry--server-process
- (make-network-process
- :name "pinentry"
- :server t
- :noquery t
- :sentinel #'pinentry--process-sentinel
- :filter #'pinentry--process-filter
- :coding 'no-conversion
- :family 'local
- :service server-file))
- (process-put pinentry--server-process :server-file server-file)))))
-
-(defun pinentry-stop ()
- "Stop a Pinentry service."
- (interactive)
- (when (process-live-p pinentry--server-process)
- (delete-process pinentry--server-process))
- (setq pinentry--server-process nil)
- (dolist (process pinentry--connection-process-list)
- (when (buffer-live-p (process-buffer process))
- (kill-buffer (process-buffer process))))
- (setq pinentry--connection-process-list nil))
-
-(defun pinentry--labels-to-shortcuts (labels)
- "Convert strings in LABEL by stripping mnemonics."
- (mapcar (lambda (label)
- (when label
- (let (c)
- (if (string-match "\\(?:\\`\\|[^_]\\)_\\([[:alnum:]]\\)" label)
- (let ((key (match-string 1 label)))
- (setq c (downcase (aref key 0)))
- (setq label (replace-match
- (propertize key 'face 'underline)
- t t label)))
- (setq c (if (= (length label) 0)
- ??
- (downcase (aref label 0)))))
- ;; Double underscores mean a single underscore.
- (when (string-match "__" label)
- (setq label (replace-match "_" t t label)))
- (cons c label))))
- labels))
-
-(defun pinentry--escape-string (string)
- "Escape STRING in the Assuan percent escape."
- (let ((length (length string))
- (index 0)
- (count 0))
- (while (< index length)
- (if (memq (aref string index) '(?\n ?\r ?%))
- (setq count (1+ count)))
- (setq index (1+ index)))
- (setq index 0)
- (let ((result (make-string (+ length (* count 2)) ?\0))
- (result-index 0)
- c)
- (while (< index length)
- (setq c (aref string index))
- (if (memq c '(?\n ?\r ?%))
- (let ((hex (format "%02X" c)))
- (aset result result-index ?%)
- (setq result-index (1+ result-index))
- (aset result result-index (aref hex 0))
- (setq result-index (1+ result-index))
- (aset result result-index (aref hex 1))
- (setq result-index (1+ result-index)))
- (aset result result-index c)
- (setq result-index (1+ result-index)))
- (setq index (1+ index)))
- result)))
-
-(defun pinentry--unescape-string (string)
- "Unescape STRING in the Assuan percent escape."
- (let ((length (length string))
- (index 0))
- (let ((result (make-string length ?\0))
- (result-index 0)
- c)
- (while (< index length)
- (setq c (aref string index))
- (if (and (eq c '?%) (< (+ index 2) length))
- (progn
- (aset result result-index
- (string-to-number (substring string
- (1+ index)
- (+ index 3))
- 16))
- (setq result-index (1+ result-index))
- (setq index (+ index 2)))
- (aset result result-index c)
- (setq result-index (1+ result-index)))
- (setq index (1+ index)))
- (substring result 0 result-index))))
-
-(defun pinentry--send-data (process escaped)
- "Send a string ESCAPED to a process PROCESS.
-ESCAPED will be split if it exceeds the line length limit of the
-Assuan protocol."
- (let ((length (length escaped))
- (index 0))
- (if (= length 0)
- (process-send-string process "D \n")
- (while (< index length)
- ;; 997 = ASSUAN_LINELENGTH (= 1000) - strlen ("D \n")
- (let* ((sub-length (min (- length index) 997))
- (sub (substring escaped index (+ index sub-length))))
- (unwind-protect
- (progn
- (process-send-string process "D ")
- (process-send-string process sub)
- (process-send-string process "\n"))
- (clear-string sub))
- (setq index (+ index sub-length)))))))
-
-(defun pinentry--send-error (process error)
- (process-send-string process (format "ERR %d %s\n" (car error) (cdr error))))
-
-(defun pinentry--process-filter (process input)
- (unless (buffer-live-p (process-buffer process))
- (let ((buffer (generate-new-buffer " *pinentry*")))
- (set-process-buffer process buffer)
- (with-current-buffer buffer
- (if (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil))
- (make-local-variable 'pinentry--read-point)
- (setq pinentry--read-point (point-min))
- (make-local-variable 'pinentry--labels))))
- (with-current-buffer (process-buffer process)
- (when pinentry-debug
- (with-current-buffer
- (or pinentry-debug-buffer
- (setq pinentry-debug-buffer (generate-new-buffer
- " *pinentry-debug*")))
- (goto-char (point-max))
- (insert input)))
- (save-excursion
- (goto-char (point-max))
- (insert input)
- (goto-char pinentry--read-point)
- (beginning-of-line)
- (while (looking-at ".*\n") ;the input line finished
- (if (looking-at "\\([A-Z_]+\\) ?\\(.*\\)")
- (let ((command (match-string 1))
- (string (pinentry--unescape-string (match-string 2))))
- (pcase command
- ((and set (guard (member set pinentry--set-label-commands)))
- (when (> (length string) 0)
- (let* ((symbol (intern (downcase (substring set 3))))
- (entry (assq symbol pinentry--labels))
- (label (decode-coding-string string 'utf-8)))
- (if entry
- (setcdr entry label)
- (push (cons symbol label) pinentry--labels))))
- (ignore-errors
- (process-send-string process "OK\n")))
- ("NOP"
- (ignore-errors
- (process-send-string process "OK\n")))
- ("GETPIN"
- (let ((confirm (not (null (assq 'repeat pinentry--labels))))
- passphrase escaped-passphrase encoded-passphrase)
- (unwind-protect
- (condition-case err
- (progn
- (setq passphrase
- (pinentry--prompt
- pinentry--labels
- #'read-passwd confirm))
- (setq escaped-passphrase
- (pinentry--escape-string
- passphrase))
- (setq encoded-passphrase (encode-coding-string
- escaped-passphrase
- 'utf-8))
- (ignore-errors
- (pinentry--send-data
- process encoded-passphrase)
- (process-send-string process "OK\n")))
- (error
- (message "GETPIN error %S" err)
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-cancelled))))
- (if passphrase
- (clear-string passphrase))
- (if escaped-passphrase
- (clear-string escaped-passphrase))
- (if encoded-passphrase
- (clear-string encoded-passphrase))))
- (setq pinentry--labels nil))
- ("CONFIRM"
- (let ((prompt
- (or (cdr (assq 'prompt pinentry--labels))
- "Confirm? "))
- (buttons
- (delq nil
- (pinentry--labels-to-shortcuts
- (list (cdr (assq 'ok pinentry--labels))
- (cdr (assq 'notok pinentry--labels))
- (cdr (assq 'cancel pinentry--labels))))))
- entry)
- (if buttons
- (progn
- (setq prompt
- (concat prompt " ("
- (mapconcat #'cdr buttons
- ", ")
- ") "))
- (if (setq entry (assq 'prompt pinentry--labels))
- (setcdr entry prompt)
- (setq pinentry--labels (cons (cons 'prompt prompt)
- pinentry--labels)))
- (condition-case nil
- (let ((result (pinentry--prompt pinentry--labels
- #'read-char)))
- (if (eq result (caar buttons))
- (ignore-errors
- (process-send-string process "OK\n"))
- (if (eq result (car (nth 1 buttons)))
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-not-confirmed))
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-cancelled)))))
- (error
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-cancelled)))))
- (if (setq entry (assq 'prompt pinentry--labels))
- (setcdr entry prompt)
- (setq pinentry--labels (cons (cons 'prompt prompt)
- pinentry--labels)))
- (if (condition-case nil
- (pinentry--prompt pinentry--labels #'y-or-n-p)
- (quit))
- (ignore-errors
- (process-send-string process "OK\n"))
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-not-confirmed))))
- (setq pinentry--labels nil)))
- (_ (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-not-implemented))))
- (forward-line)
- (setq pinentry--read-point (point))))))))
-
-(defun pinentry--process-sentinel (process _status)
- "The process sentinel for Emacs server connections."
- ;; If this is a new client process, set the query-on-exit flag to nil
- ;; for this process (it isn't inherited from the server process).
- (when (and (eq (process-status process) 'open)
- (process-query-on-exit-flag process))
- (push process pinentry--connection-process-list)
- (set-process-query-on-exit-flag process nil)
- (ignore-errors
- (process-send-string process "OK Your orders please\n")))
- ;; Kill the process buffer of the connection process.
- (when (and (not (process-contact process :server))
- (eq (process-status process) 'closed))
- (when (buffer-live-p (process-buffer process))
- (kill-buffer (process-buffer process)))
- (setq pinentry--connection-process-list
- (delq process pinentry--connection-process-list)))
- ;; Delete the associated connection file, if applicable.
- ;; Although there's no 100% guarantee that the file is owned by the
- ;; running Emacs instance, server-start uses server-running-p to check
- ;; for possible servers before doing anything, so it *should* be ours.
- (and (process-contact process :server)
- (eq (process-status process) 'closed)
- (ignore-errors
- (delete-file (process-get process :server-file)))))
-
-(provide 'pinentry)
-
-;;; pinentry.el ends here
diff --git a/packages/vlf/vlf-base.el b/packages/vlf/vlf-base.el
deleted file mode 100644
index 1c1c8e2..0000000
--- a/packages/vlf/vlf-base.el
+++ /dev/null
@@ -1,456 +0,0 @@
-;;; vlf-base.el --- VLF primitive operations -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Keywords: large files, chunk
-;; Author: Andrey Kotlarski <m00naticus@gmail.com>
-;; URL: https://github.com/m00natic/vlfi
-
-;; This file 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 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; This package provides basic chunk operations for VLF,
-;; most notable being the `vlf-move-to-chunk' function.
-
-;;; Code:
-
-(require 'vlf-tune)
-
-(defcustom vlf-before-chunk-update-hook nil
- "Hook that runs before chunk update."
- :group 'vlf :type 'hook)
-
-(defcustom vlf-after-chunk-update-hook nil
- "Hook that runs after chunk update."
- :group 'vlf :type 'hook)
-
-;;; Keep track of file position.
-(defvar vlf-start-pos 0
- "Absolute position of the visible chunk start.")
-(make-variable-buffer-local 'vlf-start-pos)
-(put 'vlf-start-pos 'permanent-local t)
-
-(defvar vlf-end-pos 0 "Absolute position of the visible chunk end.")
-(make-variable-buffer-local 'vlf-end-pos)
-(put 'vlf-end-pos 'permanent-local t)
-
-(defvar hexl-bits)
-
-(defconst vlf-sample-size 24
- "Minimal number of bytes that can be properly decoded.")
-
-(defun vlf-get-file-size (file)
- "Get size in bytes of FILE."
- (or (nth 7 (file-attributes file)) 0))
-
-(defun vlf-verify-size (&optional update-visited-time file)
- "Update file size information if necessary and visited file time.
-If non-nil, UPDATE-VISITED-TIME.
-FILE if given is filename to be used, otherwise `buffer-file-truename'."
- (unless (verify-visited-file-modtime (current-buffer))
- (setq vlf-file-size (vlf-get-file-size (or file
- buffer-file-truename)))
- (if update-visited-time
- (set-visited-file-modtime))))
-
-(unless (fboundp 'file-size-human-readable)
- (defun file-size-human-readable (file-size)
- "Print FILE-SIZE in MB."
- (format "%.3fMB" (/ file-size 1048576.0))))
-
-(defmacro vlf-with-undo-disabled (&rest body)
- "Execute BODY with temporarily disabled undo."
- `(let ((undo-list buffer-undo-list))
- (setq buffer-undo-list t)
- (unwind-protect (progn ,@body)
- (setq buffer-undo-list undo-list))))
-
-(defun vlf-move-to-chunk (start end)
- "Move to chunk enclosed by START END bytes.
-If same as current chunk is requested, do nothing.
-Return number of bytes moved back for proper decoding and number of
-bytes added to the end."
- (vlf-verify-size)
- (if (or (<= end start) (<= end 0)
- (<= vlf-file-size start))
- (when (or (not (buffer-modified-p))
- (y-or-n-p "Chunk modified, are you sure? "))
- (erase-buffer)
- (set-buffer-modified-p nil)
- (let ((place (if (<= vlf-file-size start)
- vlf-file-size
- 0)))
- (setq vlf-start-pos place
- vlf-end-pos place)
- (cons (- start place) (- place end))))
- (if (derived-mode-p 'hexl-mode)
- (setq start (- start (mod start hexl-bits))
- end (+ end (- hexl-bits (mod end hexl-bits)))))
- (if (or (/= start vlf-start-pos)
- (/= end vlf-end-pos))
- (vlf-move-to-chunk-1 start end))))
-
-(defun vlf-move-to-chunk-1 (start end)
- "Move to chunk enclosed by START END keeping as much edits if any.
-Return number of bytes moved back for proper decoding and number of
-bytes added to the end."
- (widen)
- (let* ((modified (buffer-modified-p))
- (start (max 0 start))
- (end (min end vlf-file-size))
- (hexl (derived-mode-p 'hexl-mode))
- restore-hexl hexl-undo-list
- (edit-end (if modified
- (progn
- (when hexl
- (setq restore-hexl t
- hexl-undo-list buffer-undo-list
- buffer-undo-list t)
- (vlf-tune-dehexlify))
- (+ vlf-start-pos
- (vlf-tune-encode-length (point-min)
- (point-max))))
- vlf-end-pos))
- (shifts
- (cond
- ((and hexl (not modified)) (vlf-move-to-chunk-2 start end))
- ((or (< edit-end start) (< end vlf-start-pos)
- (not (verify-visited-file-modtime (current-buffer))))
- (when (or (not modified)
- (y-or-n-p "Chunk modified, are you sure? ")) ;full chunk
renewal
- (set-buffer-modified-p nil)
- (if (consp hexl-undo-list)
- (setq hexl-undo-list nil))
- (vlf-move-to-chunk-2 start end)))
- ((and (= start vlf-start-pos) (= end edit-end))
- (unless modified
- (if (consp hexl-undo-list)
- (setq hexl-undo-list nil))
- (vlf-move-to-chunk-2 start end)))
- ((and (not modified)
- (not (consp buffer-undo-list)))
- (vlf-move-to-chunk-2 start end))
- ((or (not modified)
- (and (<= start vlf-start-pos) (<= edit-end end))
- (y-or-n-p "Chunk modified, are you sure? "))
- (run-hooks 'vlf-before-chunk-update-hook)
- (when (and hexl (not restore-hexl))
- (if (consp buffer-undo-list)
- (setq buffer-undo-list nil))
- (vlf-tune-dehexlify))
- (let ((shift-start 0)
- (shift-end 0))
- (let ((pos (+ (position-bytes (point)) vlf-start-pos))
- (inhibit-read-only t))
- (cond ((= end vlf-start-pos)
- (or (eq buffer-undo-list t)
- (setq buffer-undo-list nil))
- (vlf-with-undo-disabled (erase-buffer))
- (setq modified nil))
- ((< end edit-end)
- (setq end (car (vlf-delete-region
- (point-min) vlf-start-pos
- edit-end end
- (min (or (byte-to-position
- (- end vlf-start-pos))
- (point-min))
- (point-max))
- nil))))
- ((< edit-end end)
- (vlf-with-undo-disabled
- (setq shift-end (cdr (vlf-insert-file-contents
- vlf-end-pos end nil t
- (point-max)))))))
- (setq vlf-end-pos (+ end shift-end))
- (cond ((= start edit-end)
- (or (eq buffer-undo-list t)
- (setq buffer-undo-list nil))
- (vlf-with-undo-disabled
- (delete-region (point-min) (point)))
- (setq modified nil))
- ((< vlf-start-pos start)
- (let ((del-info (vlf-delete-region
- (point-min) vlf-start-pos
- vlf-end-pos start
- (min (or
- (byte-to-position
- (- start vlf-start-pos))
- (point))
- (point-max)) t)))
- (setq start (car del-info))
- (vlf-shift-undo-list (- (point-min)
- (cdr del-info)))))
- ((< start vlf-start-pos)
- (let ((edit-end-pos (point-max)))
- (vlf-with-undo-disabled
- (setq shift-start (car
- (vlf-insert-file-contents
- start vlf-start-pos t nil
- edit-end-pos)))
- (goto-char (point-min))
- (insert (delete-and-extract-region
- edit-end-pos (point-max))))
- (vlf-shift-undo-list (- (point-max)
- edit-end-pos)))))
- (setq start (- start shift-start))
- (goto-char (or (byte-to-position (- pos start))
- (byte-to-position (- pos vlf-start-pos))
- (point-max)))
- (setq vlf-start-pos start))
- (set-buffer-modified-p modified)
- (set-visited-file-modtime)
- (when hexl
- (vlf-tune-hexlify)
- (setq restore-hexl nil))
- (run-hooks 'vlf-after-chunk-update-hook)
- (cons shift-start shift-end))))))
- (when restore-hexl
- (vlf-tune-hexlify)
- (setq buffer-undo-list hexl-undo-list))
- shifts))
-
-(defun vlf-move-to-chunk-2 (start end)
- "Unconditionally move to chunk enclosed by START END bytes.
-Return number of bytes moved back for proper decoding and number of
-bytes added to the end."
- (run-hooks 'vlf-before-chunk-update-hook)
- (let ((adjust-start t)
- (adjust-end t)
- (is-hexl (derived-mode-p 'hexl-mode)))
- (and (not is-hexl)
- (verify-visited-file-modtime (current-buffer))
- (setq adjust-start (and (/= start vlf-start-pos)
- (/= start vlf-end-pos))
- adjust-end (and (/= end vlf-start-pos)
- (/= end vlf-end-pos))))
- (vlf-verify-size t)
- (setq vlf-start-pos (max 0 start)
- vlf-end-pos (min end vlf-file-size))
- (let ((shifts '(0 . 0)))
- (let ((inhibit-read-only t)
- (pos (position-bytes (point))))
- (vlf-with-undo-disabled
- (erase-buffer)
- (if is-hexl
- (progn (vlf-tune-insert-file-contents-literally
- vlf-start-pos vlf-end-pos)
- (vlf-tune-hexlify))
- (setq shifts (vlf-insert-file-contents vlf-start-pos
- vlf-end-pos
- adjust-start
- adjust-end)
- vlf-start-pos (- vlf-start-pos (car shifts))
- vlf-end-pos (+ vlf-end-pos (cdr shifts)))))
- (goto-char (or (byte-to-position (+ pos (car shifts)))
- (point-max))))
- (set-buffer-modified-p nil)
- (or (eq buffer-undo-list t)
- (setq buffer-undo-list nil))
- (run-hooks 'vlf-after-chunk-update-hook)
- shifts)))
-
-(defun vlf-insert-file-contents (start end adjust-start adjust-end
- &optional position)
- "Adjust chunk at absolute START to END till content can be\
-properly decoded. ADJUST-START determines if trying to prepend bytes
-to the beginning, ADJUST-END - append to the end.
-Use buffer POSITION as start if given.
-Return number of bytes moved back for proper decoding and number of
-bytes added to the end."
- (setq adjust-end (and adjust-end (/= end vlf-file-size))
- position (or position (point-min)))
- (and adjust-start (<= start 4)
- (setq adjust-start nil
- start 0))
- (goto-char position)
- (let ((shift-start 0)
- (shift-end 0)
- (safe-end (if adjust-end
- (min vlf-file-size (+ end 4))
- end)))
- (if adjust-start
- (setq shift-start (vlf-adjust-start start safe-end position
- adjust-end)
- start (- start shift-start))
- (vlf-insert-file-contents-1 start safe-end))
- (if adjust-end
- (setq shift-end (- (car (vlf-delete-region position start
- safe-end end
- (point-max)
- nil 'start))
- end)))
- (cons shift-start shift-end)))
-
-(defun vlf-insert-file-contents-1 (start end)
- "Extract decoded file bytes START to END."
- (if (zerop start)
- (vlf-tune-insert-file-contents start end)
- (let ((coding-system-for-read buffer-file-coding-system))
- (vlf-tune-insert-file-contents start end))))
-
-(defun vlf-adjust-start (start end position adjust-end)
- "Adjust chunk beginning at absolute START to END till content can\
-be properly decoded. Use buffer POSITION as start.
-ADJUST-END is non-nil if end would be adjusted later.
-Return number of bytes moved back for proper decoding."
- (let* ((safe-start (max 0 (- start 4)))
- (sample-end (min end (+ safe-start vlf-sample-size)))
- (chunk-size (- sample-end safe-start))
- (strict (or (= sample-end vlf-file-size)
- (and (not adjust-end) (= sample-end end))))
- (shift 0))
- (while (and (let ((coding-system-for-read buffer-file-coding-system))
- (insert-file-contents buffer-file-name
- nil safe-start sample-end)
- (not (zerop safe-start)))
- (< shift 3)
- (let ((diff (- chunk-size
- (length
- (encode-coding-region
- position (point-max)
- buffer-file-coding-system t)))))
- (if strict
- (not (zerop diff))
- (or (< diff -3) (< 0 diff)))))
- (setq shift (1+ shift)
- safe-start (1- safe-start)
- chunk-size (1+ chunk-size))
- (delete-region position (point-max)))
- (setq safe-start (car (vlf-delete-region position safe-start
- sample-end start
- position t 'start)))
- (unless (= sample-end end)
- (delete-region position (point-max))
- (vlf-insert-file-contents-1 safe-start end))
- (- start safe-start)))
-
-(defun vlf-delete-region (position start end border cut-point from-start
- &optional encode-direction)
- "Delete from chunk starting at POSITION enclosing absolute file\
-positions START to END at absolute position BORDER. Start search for
-best cut at CUT-POINT. Delete from buffer beginning if FROM-START is
-non nil or up to buffer end otherwise. ENCODE-DIRECTION determines
-which side of the region to use to calculate cut position's absolute
-file position. Possible values are: `start' - from the beginning;
-`end' - from end; nil - the shorter side.
-Return actual absolute position of new border and buffer point at
-which deletion was performed."
- (let* ((encode-from-end (if encode-direction
- (eq encode-direction 'end)
- (< (- end border) (- border start))))
- (dist (if encode-from-end
- (- end (vlf-tune-encode-length cut-point
- (point-max)))
- (+ start (vlf-tune-encode-length position
- cut-point))))
- (len 0))
- (if (< border dist)
- (while (< border dist)
- (setq len (length (encode-coding-region
- cut-point (1- cut-point)
- buffer-file-coding-system t))
- cut-point (1- cut-point)
- dist (- dist len)))
- (while (< dist border)
- (setq len (length (encode-coding-region
- cut-point (1+ cut-point)
- buffer-file-coding-system t))
- cut-point (1+ cut-point)
- dist (+ dist len)))
- (or (= dist border)
- (setq cut-point (1- cut-point)
- dist (- dist len))))
- (and (not from-start) (/= dist border)
- (setq cut-point (1+ cut-point)
- dist (+ dist len)))
- (vlf-with-undo-disabled
- (if from-start (delete-region position cut-point)
- (delete-region cut-point (point-max))))
- (cons dist (1+ cut-point))))
-
-(defun vlf-byte-position (point)
- "Determine global byte position of POINT."
- (let ((pmax (point-max)))
- (if (< (/ pmax 2) point)
- (- vlf-end-pos (vlf-tune-encode-length (min (1+ point) pmax)
- pmax))
- (+ vlf-start-pos (vlf-tune-encode-length (point-min) point)))))
-
-(defun vlf-shift-undo-list (n)
- "Shift undo list element regions by N."
- (or (null buffer-undo-list) (eq buffer-undo-list t)
- (setq buffer-undo-list
- (nreverse
- (let ((min (point-min))
- undo-list)
- (catch 'end
- (dolist (el buffer-undo-list undo-list)
- (push
- (cond
- ((null el) nil)
- ((numberp el) (let ((pos (+ el n)))
- (if (< pos min)
- (throw 'end undo-list)
- pos)))
- (t (let ((head (car el)))
- (cond ((numberp head)
- (let ((beg (+ head n)))
- (if (< beg min)
- (throw 'end undo-list)
- (cons beg (+ (cdr el) n)))))
- ((stringp head)
- (let* ((pos (cdr el))
- (positive (< 0 pos))
- (new (+ (abs pos) n)))
- (if (< new min)
- (throw 'end undo-list)
- (cons head (if positive
- new
- (- new))))))
- ((null head)
- (let ((beg (+ (nth 3 el) n)))
- (if (< beg min)
- (throw 'end undo-list)
- (cons
- nil
- (cons
- (cadr el)
- (cons
- (nth 2 el)
- (cons beg
- (+ (cddr
- (cddr el)) n))))))))
- ((and (eq head 'apply)
- (numberp (cadr el)))
- (let ((beg (+ (nth 2 el) n)))
- (if (< beg min)
- (throw 'end undo-list)
- (cons
- 'apply
- (cons
- (cadr el)
- (cons
- beg
- (cons
- (+ (nth 3 el) n)
- (cons (nth 4 el)
- (cdr (last el))))))))))
- (t el)))))
- undo-list))))))))
-
-(provide 'vlf-base)
-
-;;; vlf-base.el ends here
diff --git a/packages/vlf/vlf-ediff.el b/packages/vlf/vlf-ediff.el
deleted file mode 100644
index a28e24e..0000000
--- a/packages/vlf/vlf-ediff.el
+++ /dev/null
@@ -1,331 +0,0 @@
-;;; vlf-ediff.el --- VLF ediff functionality -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Keywords: large files, compare, ediff
-;; Author: Andrey Kotlarski <m00naticus@gmail.com>
-;; URL: https://github.com/m00natic/vlfi
-
-;; This file 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 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; This package provides ediff functionality for VLF managed buffers
-;; in face of the `vlf-ediff-buffers' and `vlf-ediff-files' commands.
-
-;;; Code:
-
-(require 'vlf)
-(require 'ediff)
-
-(defvar vlf-ediff-session nil
- "If non nil, specifies that ediff is done over VLF buffers.")
-(make-variable-buffer-local 'vlf-ediff-session)
-
-(defvar tramp-verbose)
-
-(defun vlf-ediff-buffers (buffer-A buffer-B)
- "Run batch by batch ediff over VLF buffers BUFFER-A and BUFFER-B.
-Batch size is determined by the size in BUFFER-A.
-Requesting next or previous difference at the end or beginning
-respectively of difference list, runs ediff over the adjacent chunks."
- (interactive
- (let (bf)
- (list (setq bf (read-buffer "Buffer A to compare: "
- (ediff-other-buffer "") t))
- (read-buffer "Buffer B to compare: "
- (progn
- ;; realign buffers so that two visible bufs will be
- ;; at the top
- (save-window-excursion (other-window 1))
- (ediff-other-buffer bf))
- t))))
- (set-buffer buffer-A)
- (setq buffer-A (current-buffer)) ;names change, so reference by buffer object
- (let ((batch-size vlf-batch-size))
- (set-buffer buffer-B)
- (setq buffer-B (current-buffer))
- (vlf-set-batch-size batch-size))
- (ediff-buffers buffer-A buffer-B
- '((lambda () (setq vlf-ediff-session t)
- (vlf-ediff-next ediff-buffer-A ediff-buffer-B
- ediff-control-buffer
- 'vlf-next-chunk)))))
-
-;;;###autoload
-(defun vlf-ediff-files (file-A file-B batch-size)
- "Run batch by batch ediff over FILE-A and FILE-B.
-Files are processed with VLF with BATCH-SIZE chunks.
-Requesting next or previous difference at the end or beginning
-respectively of difference list, runs ediff over the adjacent chunks."
- (interactive
- (let ((dir-A (if ediff-use-last-dir
- ediff-last-dir-A
- default-directory))
- dir-B f)
- (list (setq f (ediff-read-file-name
- "File A to compare"
- dir-A
- (ediff-get-default-file-name)
- 'no-dirs))
- (ediff-read-file-name "File B to compare"
- (setq dir-B
- (if ediff-use-last-dir
- ediff-last-dir-B
- (file-name-directory f)))
- (progn
- (ediff-add-to-history
- 'file-name-history
- (ediff-abbreviate-file-name
- (expand-file-name
- (file-name-nondirectory f)
- dir-B)))
- (ediff-get-default-file-name f 1)))
- (read-number "Batch size (in bytes): " vlf-batch-size))))
- (let ((buffer-A (vlf file-A t)))
- (set-buffer buffer-A)
- (vlf-set-batch-size batch-size)
- (let ((buffer-B (vlf file-B t)))
- (vlf-ediff-buffers buffer-A buffer-B))))
-
-(defadvice ediff-next-difference (around vlf-ediff-next-difference
- compile activate)
- "Move to the next VLF chunk and search for difference if at the end\
-of difference list."
- (if (and vlf-ediff-session
- (<= (1- ediff-number-of-differences)
- ediff-current-difference))
- (let ((buffer-A ediff-buffer-A)
- (buffer-B ediff-buffer-B)
- (ediff-buffer (current-buffer)))
- (save-excursion
- (set-buffer buffer-A)
- (vlf-next-chunk)
- (set-buffer buffer-B)
- (vlf-next-chunk)
- (vlf-ediff-next buffer-A buffer-B ediff-buffer
- 'vlf-next-chunk))
- (or (zerop ediff-number-of-differences)
- (ediff-jump-to-difference 1)))
- ad-do-it))
-
-(defadvice ediff-previous-difference (around vlf-ediff-prev-difference
- compile activate)
- "Move to the previous VLF chunk and search for difference if at the\
-beginning of difference list."
- (if (and vlf-ediff-session
- (<= ediff-current-difference 0))
- (let ((buffer-A ediff-buffer-A)
- (buffer-B ediff-buffer-B)
- (ediff-buffer (current-buffer)))
- (save-excursion
- (set-buffer buffer-A)
- (vlf-prev-chunk)
- (set-buffer buffer-B)
- (vlf-prev-chunk)
- (vlf-ediff-next buffer-A buffer-B ediff-buffer
- 'vlf-prev-chunk))
- (or (zerop ediff-number-of-differences)
- (ediff-jump-to-difference -1)))
- ad-do-it))
-
-(defun vlf-next-chunk ()
- "Move to next chunk."
- (vlf-move-to-chunk vlf-end-pos (+ vlf-end-pos vlf-batch-size)))
-
-(defun vlf-prev-chunk ()
- "Move to previous chunk."
- (vlf-move-to-chunk (- vlf-start-pos vlf-batch-size) vlf-start-pos))
-
-(defun vlf-ediff-next (buffer-A buffer-B ediff-buffer
- &optional next-func)
- "Find next pair of chunks that differ in BUFFER-A and BUFFER-B\
-governed by EDIFF-BUFFER. NEXT-FUNC is used to jump to the next
-logical chunks in case there is no difference at the current ones."
- (set-buffer buffer-A)
- (run-hook-with-args 'vlf-before-batch-functions 'ediff)
- (setq buffer-A (current-buffer)) ;names change, so reference by buffer object
- (let ((end-A (= vlf-start-pos vlf-end-pos))
- (chunk-A (cons vlf-start-pos vlf-end-pos))
- (point-max-A (point-max))
- (font-lock-A font-lock-mode)
- (min-file-size vlf-file-size)
- (forward-p (eq next-func 'vlf-next-chunk))
- (is-hexl (derived-mode-p 'hexl-mode)))
- (font-lock-mode 0)
- (set-buffer buffer-B)
- (run-hook-with-args 'vlf-before-batch-functions 'ediff)
- (setq buffer-B (current-buffer)
- min-file-size (min min-file-size vlf-file-size)
- is-hexl (or is-hexl (derived-mode-p 'hexl-mode)))
- (let ((tramp-verbose (if (and (boundp 'tramp-verbose)
- tramp-verbose)
- (min tramp-verbose 1)))
- (end-B (= vlf-start-pos vlf-end-pos))
- (chunk-B (cons vlf-start-pos vlf-end-pos))
- (font-lock-B font-lock-mode)
- (done nil)
- (reporter (make-progress-reporter
- "Searching for difference..."
- (if forward-p vlf-start-pos
- (- min-file-size vlf-end-pos))
- min-file-size)))
- (font-lock-mode 0)
- (unwind-protect
- (progn
- (while (and (or (not end-A) (not end-B))
- (or (zerop (compare-buffer-substrings
- buffer-A (point-min) point-max-A
- buffer-B (point-min) (point-max)))
- (with-current-buffer ediff-buffer
- (ediff-update-diffs)
- (and (not end-A) (not end-B) (not is-hexl)
- (vlf-ediff-refine buffer-A
- buffer-B))
- (zerop ediff-number-of-differences))))
- (funcall next-func)
- (setq end-B (= vlf-start-pos vlf-end-pos))
- (with-current-buffer buffer-A
- (funcall next-func)
- (setq end-A (= vlf-start-pos vlf-end-pos)
- point-max-A (point-max)))
- (progress-reporter-update reporter
- (if forward-p vlf-end-pos
- (- vlf-file-size
- vlf-start-pos))))
- (progress-reporter-done reporter)
- (when (and end-A end-B)
- (if forward-p
- (let ((max-file-size vlf-file-size))
- (vlf-move-to-chunk (- max-file-size vlf-batch-size)
- max-file-size)
- (set-buffer buffer-A)
- (setq max-file-size (max max-file-size
- vlf-file-size))
- (vlf-move-to-chunk (- max-file-size
- vlf-batch-size)
- max-file-size))
- (vlf-move-to-batch 0)
- (set-buffer buffer-A)
- (vlf-move-to-batch 0))
- (set-buffer ediff-buffer)
- (ediff-update-diffs)
- (or is-hexl
- (if (or (not forward-p)
- (and (not end-A) (not end-B)))
- (vlf-ediff-refine buffer-A buffer-B))))
- (setq done t))
- (unless done
- (set-buffer buffer-A)
- (set-buffer-modified-p nil)
- (vlf-move-to-chunk (car chunk-A) (cdr chunk-A))
- (set-buffer buffer-B)
- (set-buffer-modified-p nil)
- (vlf-move-to-chunk (car chunk-B) (cdr chunk-B))
- (set-buffer ediff-buffer)
- (ediff-update-diffs)
- (or is-hexl
- (vlf-ediff-refine buffer-A buffer-B)))
- (set-buffer buffer-A)
- (if font-lock-A (font-lock-mode 1))
- (run-hook-with-args 'vlf-after-batch-functions 'ediff)
- (set-buffer buffer-B)
- (if font-lock-B (font-lock-mode 1))
- (run-hook-with-args 'vlf-after-batch-functions 'ediff)))))
-
-(defun vlf-ediff-refine (buffer-A buffer-B)
- "Try to minimize differences between BUFFER-A and BUFFER-B.
-This can happen if first or last difference is at the start/end of
-buffer."
- (or (zerop ediff-number-of-differences)
- (let ((adjust-p (vlf-ediff-adjust buffer-A buffer-B)))
- (setq adjust-p (or (vlf-ediff-adjust buffer-A buffer-B t)
- adjust-p))
- (if adjust-p (ediff-update-diffs)))))
-
-(defun vlf-ediff-adjust (buf-A buf-B &optional end)
- "Additionally adjust buffer borders for BUF-A and BUF-B.
-Adjust beginning if END is nil. Return t if refining is needed,
-nil otherwise."
- (let* ((diff-num (if end (1- ediff-number-of-differences) 0))
- (diff-A (ediff-get-diff-overlay diff-num 'A))
- (diff-B (ediff-get-diff-overlay diff-num 'B))
- diff-A-str diff-B-str adjust-p)
- (with-current-buffer buf-A
- (setq adjust-p (if end (= (overlay-end diff-A) (point-max))
- (= (overlay-start diff-A) (point-min)))
- diff-A-str (and adjust-p (buffer-substring-no-properties
- (overlay-start diff-A)
- (overlay-end diff-A))))
- (set-buffer buf-B)
- (setq adjust-p (and adjust-p
- (if end (= (overlay-end diff-B) (point-max))
- (= (overlay-start diff-B) (point-min))))
- diff-B-str (and adjust-p (buffer-substring-no-properties
- (overlay-start diff-B)
- (overlay-end diff-B))))
- (if adjust-p
- (let ((len-A (length diff-A-str))
- (len-B (length diff-B-str))
- (adjust-func (if end 'vlf-ediff-adjust-end
- 'vlf-ediff-adjust-start)))
- (cond
- ((< len-A len-B)
- (or (funcall adjust-func diff-A-str diff-B-str buf-B)
- (setq adjust-p nil)))
- ((< len-B len-A)
- (or (funcall adjust-func diff-B-str diff-A-str buf-A)
- (setq adjust-p nil)))
- (t (setq adjust-p nil))))))
- adjust-p))
-
-(defun vlf-ediff-adjust-start (diff-short diff-long vlf-buffer)
- "Remove difference between DIFF-SHORT and DIFF-LONG from beginning\
-of VLF-BUFFER."
- (when (string-suffix-p diff-short diff-long)
- (set-buffer vlf-buffer)
- (vlf-move-to-chunk (+ vlf-start-pos
- (length (encode-coding-string
- (substring diff-long 0
- (- (length diff-long)
- (length diff-short)))
- buffer-file-coding-system t)))
- vlf-end-pos)))
-
-(defun vlf-ediff-adjust-end (diff-short diff-long vlf-buffer)
- "Remove difference between DIFF-SHORT and DIFF-LONG from the end of\
-VLF-BUFFER."
- (when (string-prefix-p diff-short diff-long)
- (set-buffer vlf-buffer)
- (vlf-move-to-chunk vlf-start-pos
- (- vlf-end-pos
- (length (encode-coding-string
- (substring diff-long
- (length diff-short))
- buffer-file-coding-system t))))))
-
-(unless (fboundp 'string-suffix-p)
- (defun string-suffix-p (suffix string &optional ignore-case)
- "Return non-nil if SUFFIX is a suffix of STRING.
-If IGNORE-CASE is non-nil, the comparison is done without paying
-attention to case differences."
- (let ((start-pos (- (length string) (length suffix))))
- (and (>= start-pos 0)
- (eq t (compare-strings suffix nil nil string start-pos nil
- ignore-case))))))
-
-(provide 'vlf-ediff)
-
-;;; vlf-ediff.el ends here
diff --git a/packages/vlf/vlf-follow.el b/packages/vlf/vlf-follow.el
deleted file mode 100644
index 52f35cd..0000000
--- a/packages/vlf/vlf-follow.el
+++ /dev/null
@@ -1,85 +0,0 @@
-;;; vlf-follow.el --- VLF chunk follows point functionality -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Keywords: large files, follow, recenter
-;; Author: Andrey Kotlarski <m00naticus@gmail.com>
-;; URL: https://github.com/m00natic/vlfi
-
-;; This file 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 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; This package provides `vlf-toggle-follow' command which toggles
-;; continuous recenter of chunk around current point.
-
-;;; Code:
-
-(require 'vlf)
-
-(defvar vlf-follow-timer nil
- "Contains timer if vlf buffer is set to continuously recenter.")
-(make-variable-buffer-local 'vlf-follow-timer)
-(put 'vlf-follow-timer 'permanent-local t)
-
-(defun vlf-recenter (vlf-buffer)
- "Recenter chunk around current point in VLF-BUFFER."
- (and vlf-follow-timer
- (eq (current-buffer) vlf-buffer)
- (or (pos-visible-in-window-p (point-min))
- (pos-visible-in-window-p (point-max)))
- (let ((current-pos (+ vlf-start-pos (position-bytes (point))))
- (half-batch (/ vlf-batch-size 2)))
- (if (buffer-modified-p)
- (progn
- (let ((edit-end (+ (position-bytes (point-max))
- vlf-start-pos)))
- (vlf-move-to-chunk (min vlf-start-pos
- (- current-pos half-batch))
- (max edit-end
- (+ current-pos half-batch))))
- (goto-char (byte-to-position (- current-pos
- vlf-start-pos))))
- (vlf-move-to-batch (- current-pos half-batch))
- (and (< half-batch current-pos)
- (< half-batch (- vlf-file-size current-pos))
- (goto-char (byte-to-position (- current-pos
- vlf-start-pos))))))))
-
-(defun vlf-stop-follow ()
- "Stop continuous recenter."
- (when vlf-follow-timer
- (cancel-timer vlf-follow-timer)
- (setq vlf-follow-timer nil)))
-
-(defun vlf-start-follow (interval)
- "Continuously recenter chunk around point every INTERVAL seconds."
- (setq vlf-follow-timer (run-with-idle-timer interval interval
- 'vlf-recenter
- (current-buffer)))
- (add-hook 'kill-buffer-hook 'vlf-stop-follow nil t))
-
-(defun vlf-toggle-follow ()
- "Toggle continuous chunk recenter around current point."
- (interactive)
- (if vlf-mode
- (if vlf-follow-timer
- (progn (vlf-stop-follow)
- (message "Following stopped"))
- (vlf-start-follow (read-number "Number of seconds: " 1)))))
-
-(provide 'vlf-follow)
-
-;;; vlf-follow.el ends here
diff --git a/packages/vlf/vlf-occur.el b/packages/vlf/vlf-occur.el
deleted file mode 100644
index 717513e..0000000
--- a/packages/vlf/vlf-occur.el
+++ /dev/null
@@ -1,481 +0,0 @@
-;;; vlf-occur.el --- Occur-like functionality for VLF -*- lexical-binding: t
-*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Keywords: large files, indexing, occur
-;; Author: Andrey Kotlarski <m00naticus@gmail.com>
-;; URL: https://github.com/m00natic/vlfi
-
-;; This file 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 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; This package provides the `vlf-occur' command which builds
-;; index of search occurrences in large file just like occur.
-
-;;; Code:
-
-(require 'vlf)
-
-(defvar vlf-occur-vlf-file nil "VLF file that is searched.")
-(make-variable-buffer-local 'vlf-occur-vlf-file)
-
-(defvar vlf-occur-vlf-buffer nil "VLF buffer that is scanned.")
-(make-variable-buffer-local 'vlf-occur-vlf-buffer)
-
-(defvar vlf-occur-regexp)
-(make-variable-buffer-local 'vlf-occur-regexp)
-
-(defvar vlf-occur-hexl nil "Is `hexl-mode' active?")
-(make-variable-buffer-local 'vlf-occur-hexl)
-
-(defvar vlf-occur-lines 0 "Number of lines scanned by `vlf-occur'.")
-(make-variable-buffer-local 'vlf-occur-lines)
-
-(defvar tramp-verbose)
-(defvar hexl-bits)
-
-(defvar vlf-occur-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "n" 'vlf-occur-next-match)
- (define-key map "p" 'vlf-occur-prev-match)
- (define-key map "\C-m" 'vlf-occur-visit)
- (define-key map "\M-\r" 'vlf-occur-visit-new-buffer)
- (define-key map [mouse-1] 'vlf-occur-visit)
- (define-key map "o" 'vlf-occur-show)
- (define-key map [remap save-buffer] 'vlf-occur-save)
- map)
- "Keymap for command `vlf-occur-mode'.")
-
-(define-derived-mode vlf-occur-mode special-mode "VLF[occur]"
- "Major mode for showing occur matches of VLF opened files."
- (add-hook 'write-file-functions 'vlf-occur-save nil t))
-
-(defun vlf-occur-next-match ()
- "Move cursor to next match."
- (interactive)
- (if (eq (get-text-property (point) 'face) 'match)
- (goto-char (next-single-property-change (point) 'face)))
- (goto-char (or (text-property-any (point) (point-max) 'face 'match)
- (text-property-any (point-min) (point)
- 'face 'match))))
-
-(defun vlf-occur-prev-match ()
- "Move cursor to previous match."
- (interactive)
- (if (eq (get-text-property (point) 'face) 'match)
- (goto-char (previous-single-property-change (point) 'face)))
- (while (not (eq (get-text-property (point) 'face) 'match))
- (goto-char (or (previous-single-property-change (point) 'face)
- (point-max)))))
-
-(defun vlf-occur-show (&optional event)
- "Visit current `vlf-occur' link in a vlf buffer but stay in the \
-occur buffer. If original VLF buffer has been killed,
-open new VLF session each time.
-EVENT may hold details of the invocation."
- (interactive (list last-nonmenu-event))
- (let ((occur-buffer (if event
- (window-buffer (posn-window
- (event-end event)))
- (current-buffer))))
- (vlf-occur-visit event)
- (pop-to-buffer occur-buffer)))
-
-(defun vlf-occur-visit-new-buffer ()
- "Visit `vlf-occur' link in new vlf buffer."
- (interactive)
- (let ((current-prefix-arg t))
- (vlf-occur-visit)))
-
-(defun vlf-occur-visit (&optional event)
- "Visit current `vlf-occur' link in a vlf buffer.
-With prefix argument or if original VLF buffer has been killed,
-open new VLF session.
-EVENT may hold details of the invocation."
- (interactive (list last-nonmenu-event))
- (when event
- (set-buffer (window-buffer (posn-window (event-end event))))
- (goto-char (posn-point (event-end event))))
- (let* ((pos (point))
- (pos-relative (- pos (previous-single-char-property-change
- pos 'vlf-match)))
- (chunk-start (get-text-property pos 'chunk-start)))
- (if chunk-start
- (let ((chunk-end (get-text-property pos 'chunk-end))
- (file (if (file-exists-p vlf-occur-vlf-file)
- vlf-occur-vlf-file
- (setq vlf-occur-vlf-file
- (read-file-name
- (concat vlf-occur-vlf-file
- " doesn't exist, locate it: ")))))
- (vlf-buffer vlf-occur-vlf-buffer)
- (not-hexl (not vlf-occur-hexl))
- (occur-buffer (current-buffer))
- (match-pos (+ (get-text-property pos 'line-pos)
- pos-relative)))
- (cond (current-prefix-arg
- (let ((original-occur-buffer vlf-occur-vlf-buffer))
- (setq vlf-buffer (vlf file t))
- (if (buffer-live-p original-occur-buffer)
- (vlf-tune-copy-profile original-occur-buffer)))
- (or not-hexl (hexl-mode))
- (switch-to-buffer occur-buffer))
- ((not (buffer-live-p vlf-buffer))
- (unless (catch 'found
- (dolist (buf (buffer-list))
- (set-buffer buf)
- (and vlf-mode
- (equal file buffer-file-name)
- (eq (not (derived-mode-p 'hexl-mode))
- not-hexl)
- (setq vlf-buffer buf)
- (throw 'found t))))
- (setq vlf-buffer (vlf file t))
- (or not-hexl (hexl-mode)))
- (switch-to-buffer occur-buffer)
- (setq vlf-occur-vlf-buffer vlf-buffer)))
- (pop-to-buffer vlf-buffer)
- (vlf-move-to-chunk chunk-start chunk-end)
- (goto-char match-pos)))))
-
-(defun vlf-occur-other-buffer (regexp)
- "Make whole file occur style index for REGEXP branching to new buffer.
-Prematurely ending indexing will still show what's found so far."
- (let ((vlf-buffer (current-buffer))
- (file buffer-file-name)
- (file-size vlf-file-size)
- (batch-size vlf-batch-size)
- (is-hexl (derived-mode-p 'hexl-mode)))
- (with-temp-buffer
- (setq buffer-file-name file
- buffer-file-truename file
- buffer-undo-list t
- vlf-file-size file-size)
- (set-buffer-modified-p nil)
- (set (make-local-variable 'vlf-batch-size) batch-size)
- (when vlf-tune-enabled
- (vlf-tune-copy-profile vlf-buffer)
- (vlf-tune-batch (if is-hexl
- '(:hexl :raw)
- '(:insert :encode)) t))
- (vlf-mode 1)
- (if is-hexl (hexl-mode))
- (goto-char (point-min))
- (vlf-build-occur regexp vlf-buffer)
- (if vlf-tune-enabled
- (vlf-tune-copy-profile (current-buffer) vlf-buffer)))))
-
-(defun vlf-occur (regexp)
- "Make whole file occur style index for REGEXP.
-Prematurely ending indexing will still show what's found so far."
- (interactive (list (read-regexp "List lines matching regexp"
- (if regexp-history
- (car regexp-history)))))
- (run-hook-with-args 'vlf-before-batch-functions 'occur)
- (if (or (buffer-modified-p)
- (consp buffer-undo-list)
- (< vlf-batch-size vlf-start-pos))
- (vlf-occur-other-buffer regexp)
- (let ((start-pos vlf-start-pos)
- (end-pos vlf-end-pos)
- (pos (point))
- (batch-size vlf-batch-size))
- (vlf-tune-batch (if (derived-mode-p 'hexl-mode)
- '(:hexl :raw)
- '(:insert :encode)) t)
- (vlf-move-to-batch 0)
- (goto-char (point-min))
- (unwind-protect (vlf-build-occur regexp (current-buffer))
- (vlf-move-to-chunk start-pos end-pos)
- (goto-char pos)
- (setq vlf-batch-size batch-size))))
- (run-hook-with-args 'vlf-after-batch-functions 'occur))
-
-(defun vlf-build-occur (regexp vlf-buffer)
- "Build occur style index for REGEXP over VLF-BUFFER."
- (let* ((tramp-verbose (if (and (boundp 'tramp-verbose)
- tramp-verbose)
- (min tramp-verbose 1)))
- (case-fold-search t)
- (line 1)
- (last-match-line 0)
- (total-matches 0)
- (first-line-offset 0)
- (first-line-incomplete nil)
- (match-start-point (point-min))
- (match-end-point match-start-point)
- (last-match-insert-point nil)
- (occur-buffer (generate-new-buffer
- (concat "*VLF-occur " (file-name-nondirectory
- buffer-file-name)
- "*")))
- (is-hexl (derived-mode-p 'hexl-mode))
- (end-of-file nil)
- (time (float-time))
- (tune-types (if is-hexl '(:hexl :raw)
- '(:insert :encode)))
- (reporter (make-progress-reporter
- (concat "Building index for " regexp "...")
- vlf-start-pos vlf-file-size)))
- (with-current-buffer occur-buffer
- (setq buffer-undo-list t))
- (unwind-protect
- (progn
- (while (not end-of-file)
- (if (re-search-forward regexp nil t)
- (progn
- (setq line (+ line -1
- (count-lines match-start-point
- (1+ (match-beginning 0))))
- match-start-point (match-beginning 0)
- match-end-point (match-end 0))
- (let* ((chunk-start vlf-start-pos)
- (chunk-end vlf-end-pos)
- (line-pos (save-excursion
- (goto-char match-start-point)
- (line-beginning-position)))
- (line-text (buffer-substring
- line-pos (line-end-position))))
- (if (/= line-pos (point-min))
- (setq first-line-offset 0
- first-line-incomplete nil))
- (with-current-buffer occur-buffer
- (unless (= line last-match-line) ;new match line
- (insert "\n:") ; insert line number
- (let* ((column-point (1- (point)))
- (overlay-pos column-point)
- (overlay (make-overlay
- overlay-pos
- (1+ overlay-pos))))
- (overlay-put overlay 'before-string
- (propertize
- (number-to-string line)
- 'face 'shadow))
- (overlay-put overlay 'vlf-match t)
- (setq last-match-insert-point column-point
- first-line-offset 0)))
- (when (or first-line-incomplete
- (/= line last-match-line))
- (insert (propertize
- (if first-line-incomplete
- (substring line-text
- first-line-incomplete)
- line-text)
- 'chunk-start chunk-start
- 'chunk-end chunk-end
- 'mouse-face '(highlight)
- 'line-pos line-pos
- 'help-echo
- (format "Move to line %d"
- line)))
- (setq first-line-incomplete nil))
- (setq last-match-line line
- total-matches (1+ total-matches))
- (let ((line-start (+ last-match-insert-point
- first-line-offset 1
- (- line-pos))))
- (add-text-properties ; mark match
- (+ line-start match-start-point)
- (+ line-start match-end-point)
- (list 'face 'match
- 'help-echo (format "Move to match %d"
- total-matches)))))))
- (setq end-of-file (= vlf-end-pos vlf-file-size))
- (unless end-of-file
- (let ((start
- (if is-hexl
- (progn
- (goto-char (point-max))
- (forward-line -10)
- (setq line
- (+ line
- (if (< match-end-point (point))
- (count-lines match-start-point
- (point))
- (goto-char match-end-point)
- (1- (count-lines match-start-point
- match-end-point)))))
- (- vlf-end-pos (* (- 10 (forward-line 10))
- hexl-bits)))
- (let* ((pmax (point-max))
- (batch-step (min 1024 (/ vlf-batch-size
- 10)))
- (batch-point
- (max match-end-point
- (or
- (byte-to-position
- (- vlf-batch-size batch-step))
- (progn
- (goto-char pmax)
- (let ((last
(line-beginning-position)))
- (if (= last (point-min))
- (1- (point))
- last)))))))
- (goto-char batch-point)
- (setq first-line-offset
- (- batch-point (line-beginning-position))
- line
- (+ line
- (count-lines match-start-point
- batch-point)
- (if (< 0 first-line-offset) -1 0)))
- ;; last match is on the last line?
- (goto-char match-end-point)
- (forward-line)
- (setq first-line-incomplete
- (if (= (point) pmax)
- (- pmax match-end-point)))
- (vlf-byte-position batch-point)))))
- (vlf-tune-batch tune-types)
- (setq vlf-end-pos start) ;not to adjust start
- (vlf-move-to-chunk start (+ start vlf-batch-size)))
- (setq match-start-point (point-min)
- match-end-point match-start-point)
- (goto-char match-end-point)
- (progress-reporter-update reporter vlf-start-pos))))
- (progress-reporter-done reporter))
- (set-buffer-modified-p nil)
- (if (zerop total-matches)
- (progn (kill-buffer occur-buffer)
- (message "No matches for \"%s\" (%f secs)"
- regexp (- (float-time) time)))
- (let ((file buffer-file-name)
- (dir default-directory))
- (with-current-buffer occur-buffer
- (insert "\n")
- (goto-char (point-min))
- (insert (propertize
- (format "%d matches from %d lines for \"%s\" \
-in file: %s" total-matches line regexp file)
- 'face 'underline))
- (set-buffer-modified-p nil)
- (forward-char 2)
- (vlf-occur-mode)
- (setq default-directory dir
- vlf-occur-vlf-file file
- vlf-occur-vlf-buffer vlf-buffer
- vlf-occur-regexp regexp
- vlf-occur-hexl is-hexl
- vlf-occur-lines line)))
- (display-buffer occur-buffer)
- (message "Occur finished for \"%s\" (%f secs)"
- regexp (- (float-time) time))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; save, load vlf-occur data
-
-(defun vlf-occur-save (file)
- "Serialize `vlf-occur' results to FILE which can later be reloaded."
- (interactive (list (or buffer-file-name
- (read-file-name "Save vlf-occur results in: "
- nil nil nil
- (concat
- (file-name-nondirectory
- vlf-occur-vlf-file)
- ".vlfo")))))
- (setq buffer-file-name file)
- (let ((vlf-occur-save-buffer
- (generate-new-buffer (concat "*VLF-occur-save "
- (file-name-nondirectory file)
- "*"))))
- (with-current-buffer vlf-occur-save-buffer
- (setq buffer-file-name file
- buffer-undo-list t)
- (insert ";; -*- eval: (vlf-occur-load) -*-\n"))
- (prin1 (list vlf-occur-vlf-file vlf-occur-regexp vlf-occur-hexl
- vlf-occur-lines)
- vlf-occur-save-buffer)
- (save-excursion
- (goto-char (point-min))
- (let ((pmax (point-max)))
- (while (/= pmax (goto-char (next-single-char-property-change
- (1+ (point)) 'vlf-match)))
- (let* ((pos (1+ (point)))
- (line (get-char-property (1- pos) 'before-string)))
- (if line
- (prin1 (list (string-to-number line)
- (get-text-property pos 'chunk-start)
- (get-text-property pos 'chunk-end)
- (get-text-property pos 'line-pos)
- (buffer-substring-no-properties
- pos (1- (next-single-char-property-change
- pos 'vlf-match))))
- vlf-occur-save-buffer))))))
- (with-current-buffer vlf-occur-save-buffer
- (save-buffer))
- (kill-buffer vlf-occur-save-buffer))
- t)
-
-;;;###autoload
-(defun vlf-occur-load ()
- "Load serialized `vlf-occur' results from current buffer."
- (interactive)
- (goto-char (point-min))
- (let* ((vlf-occur-data-buffer (current-buffer))
- (header (read vlf-occur-data-buffer))
- (vlf-file (nth 0 header))
- (regexp (nth 1 header))
- (all-lines (nth 3 header))
- (file buffer-file-name)
- (vlf-occur-buffer
- (generate-new-buffer (concat "*VLF-occur "
- (file-name-nondirectory file)
- "*"))))
- (switch-to-buffer vlf-occur-buffer)
- (setq buffer-file-name file
- buffer-undo-list t)
- (goto-char (point-min))
- (let ((match-count 0)
- (form 0))
- (while (setq form (ignore-errors (read vlf-occur-data-buffer)))
- (goto-char (point-max))
- (insert "\n:")
- (let* ((overlay-pos (1- (point)))
- (overlay (make-overlay overlay-pos (1+ overlay-pos)))
- (line (number-to-string (nth 0 form)))
- (pos (point)))
- (overlay-put overlay 'before-string
- (propertize line 'face 'shadow))
- (overlay-put overlay 'vlf-match t)
- (insert (propertize (nth 4 form) 'chunk-start (nth 1 form)
- 'chunk-end (nth 2 form)
- 'mouse-face '(highlight)
- 'line-pos (nth 3 form)
- 'help-echo (concat "Move to line "
- line)))
- (goto-char pos)
- (while (re-search-forward regexp nil t)
- (add-text-properties
- (match-beginning 0) (match-end 0)
- (list 'face 'match 'help-echo
- (format "Move to match %d"
- (setq match-count (1+ match-count))))))))
- (kill-buffer vlf-occur-data-buffer)
- (goto-char (point-min))
- (insert (propertize
- (format "%d matches from %d lines for \"%s\" in file: %s"
- match-count all-lines regexp vlf-file)
- 'face 'underline)))
- (set-buffer-modified-p nil)
- (vlf-occur-mode)
- (setq vlf-occur-vlf-file vlf-file
- vlf-occur-regexp regexp
- vlf-occur-hexl (nth 2 header)
- vlf-occur-lines all-lines)))
-
-(provide 'vlf-occur)
-
-;;; vlf-occur.el ends here
diff --git a/packages/vlf/vlf-search.el b/packages/vlf/vlf-search.el
deleted file mode 100644
index 2cf4450..0000000
--- a/packages/vlf/vlf-search.el
+++ /dev/null
@@ -1,355 +0,0 @@
-;;; vlf-search.el --- Search functionality for VLF -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Keywords: large files, search
-;; Author: Andrey Kotlarski <m00naticus@gmail.com>
-;; URL: https://github.com/m00natic/vlfi
-
-;; This file 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 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; This package provides search utilities for dealing with large files
-;; in constant memory.
-
-;;; Code:
-
-(require 'vlf)
-
-(defvar hexl-bits)
-(defvar tramp-verbose)
-
-(defun vlf-re-search (regexp count backward
- &optional reporter time highlight)
- "Search for REGEXP COUNT number of times forward or BACKWARD.
-Use existing REPORTER and start TIME if given.
-Highlight match if HIGHLIGHT is non nil.
-Return t if search has been at least partially successful."
- (if (<= count 0)
- (error "Count must be positive"))
- (run-hook-with-args 'vlf-before-batch-functions 'search)
- (or reporter (setq reporter (make-progress-reporter
- (concat "Searching for " regexp "...")
- (if backward
- (- vlf-file-size vlf-end-pos)
- vlf-start-pos)
- vlf-file-size)))
- (or time (setq time (float-time)))
- (let* ((tramp-verbose (if (and (boundp 'tramp-verbose)
- tramp-verbose)
- (min tramp-verbose 1)))
- (case-fold-search t)
- (match-chunk-start vlf-start-pos)
- (match-chunk-end vlf-end-pos)
- (match-start-pos (point))
- (match-end-pos match-start-pos)
- (last-match-pos match-start-pos)
- (to-find count)
- (is-hexl (derived-mode-p 'hexl-mode))
- (tune-types (if is-hexl '(:hexl :raw)
- '(:insert :encode)))
- (font-lock font-lock-mode))
- (font-lock-mode 0)
- (vlf-with-undo-disabled
- (unwind-protect
- (catch 'end-of-file
- (if backward
- (while (not (zerop to-find))
- (cond ((re-search-backward regexp nil t)
- (setq to-find (1- to-find)
- match-chunk-start vlf-start-pos
- match-chunk-end vlf-end-pos
- match-start-pos (match-beginning 0)
- match-end-pos (match-end 0)
- last-match-pos match-start-pos))
- ((zerop vlf-start-pos)
- (throw 'end-of-file nil))
- (t (let ((end
- (if is-hexl
- (progn
- (goto-char (point-min))
- (forward-line 10)
- (if (< last-match-pos (point))
- (goto-char last-match-pos))
- (+ vlf-start-pos
- (* (- 10 (forward-line -10))
- hexl-bits)))
- (vlf-byte-position
- (min 1024 (/ (point-max) 10)
- last-match-pos)))))
- (vlf-tune-batch tune-types)
- (setq vlf-start-pos end) ;don't adjust end
- (vlf-move-to-chunk (- end vlf-batch-size)
- end))
- (let ((pmax (point-max)))
- (goto-char pmax)
- (setq last-match-pos pmax))
- (progress-reporter-update
- reporter (- vlf-file-size
- vlf-start-pos)))))
- (while (not (zerop to-find))
- (cond ((re-search-forward regexp nil t)
- (setq to-find (1- to-find)
- match-chunk-start vlf-start-pos
- match-chunk-end vlf-end-pos
- match-start-pos (match-beginning 0)
- match-end-pos (match-end 0)
- last-match-pos match-end-pos))
- ((>= vlf-end-pos vlf-file-size)
- (throw 'end-of-file nil))
- (t (let* ((pmax (point-max))
- (start
- (if is-hexl
- (progn
- (goto-char pmax)
- (forward-line -10)
- (if (< (point) last-match-pos)
- (goto-char last-match-pos))
- (- vlf-end-pos
- (* (- 10 (forward-line 10))
- hexl-bits)))
- (vlf-byte-position
- (max (- pmax 1024)
- (- pmax (/ pmax 10))
- last-match-pos)))))
- (vlf-tune-batch tune-types)
- (setq vlf-end-pos start) ;don't adjust start
- (vlf-move-to-chunk start (+ start
- vlf-batch-size)))
- (let ((pmin (point-min)))
- (goto-char pmin)
- (setq last-match-pos pmin))
- (progress-reporter-update reporter
- vlf-end-pos)))))
- (progress-reporter-done reporter))
- (set-buffer-modified-p nil)
- (if font-lock (font-lock-mode 1))
- (let ((result
- (if backward
- (vlf-goto-match match-chunk-start match-chunk-end
- match-start-pos match-end-pos
- count to-find time highlight)
- (vlf-goto-match match-chunk-start match-chunk-end
- match-end-pos match-start-pos
- count to-find time highlight))))
- (run-hook-with-args 'vlf-after-batch-functions 'search)
- result)))))
-
-(defun vlf-goto-match (match-chunk-start match-chunk-end
- match-start-pos match-end-pos
- count to-find time
- highlight)
- "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\
-MATCH-START-POS and MATCH-END-POS.
-According to COUNT and left TO-FIND, show if search has been
-successful. Use start TIME to report how much it took.
-Highlight match if HIGHLIGHT is non nil.
-Return nil if nothing found."
- (vlf-move-to-chunk match-chunk-start match-chunk-end)
- (goto-char match-start-pos)
- (setq vlf-batch-size (vlf-tune-optimal-load
- (if (derived-mode-p 'hexl-mode)
- '(:hexl :raw)
- '(:insert :encode))))
- (if (= count to-find)
- (progn (message "Not found (%f secs)" (- (float-time) time))
- nil)
- (let ((success (zerop to-find))
- (overlay (make-overlay match-start-pos match-end-pos)))
- (overlay-put overlay 'face 'match)
- (if success
- (message "Match found (%f secs)" (- (float-time) time))
- (message "Moved to the %d match which is last (%f secs)"
- (- count to-find) (- (float-time) time)))
- (if highlight
- (unwind-protect (sit-for 1)
- (delete-overlay overlay))
- (delete-overlay overlay)))
- t))
-
-(defun vlf-re-search-forward (regexp count)
- "Search forward for REGEXP prefix COUNT number of times.
-Search is performed chunk by chunk in `vlf-batch-size' memory."
- (interactive (if (vlf-no-modifications)
- (list (read-regexp "Search whole file"
- (if regexp-history
- (car regexp-history)))
- (or current-prefix-arg 1))))
- (let ((batch-size vlf-batch-size)
- success)
- (unwind-protect
- (setq success (vlf-re-search regexp count nil nil nil t))
- (or success (setq vlf-batch-size batch-size)))))
-
-(defun vlf-re-search-backward (regexp count)
- "Search backward for REGEXP prefix COUNT number of times.
-Search is performed chunk by chunk in `vlf-batch-size' memory."
- (interactive (if (vlf-no-modifications)
- (list (read-regexp "Search whole file backward"
- (if regexp-history
- (car regexp-history)))
- (or current-prefix-arg 1))))
- (let ((batch-size vlf-batch-size)
- success)
- (unwind-protect
- (setq success (vlf-re-search regexp count t nil nil t))
- (or success (setq vlf-batch-size batch-size)))))
-
-(defun vlf-goto-line (n)
- "Go to line N. If N is negative, count from the end of file."
- (interactive (if (vlf-no-modifications)
- (list (read-number "Go to line: "))))
- (if (derived-mode-p 'hexl-mode)
- (vlf-goto-line-hexl n)
- (run-hook-with-args 'vlf-before-batch-functions 'goto-line)
- (vlf-verify-size)
- (let ((tramp-verbose (if (and (boundp 'tramp-verbose)
- tramp-verbose)
- (min tramp-verbose 1)))
- (start-pos vlf-start-pos)
- (end-pos vlf-end-pos)
- (batch-size vlf-batch-size)
- (pos (point))
- (font-lock font-lock-mode)
- (time (float-time))
- (success nil))
- (font-lock-mode 0)
- (vlf-tune-batch '(:raw))
- (unwind-protect
- (if (< 0 n)
- (let ((start 0)
- (end (min vlf-batch-size vlf-file-size))
- (reporter (make-progress-reporter
- (concat "Searching for line "
- (number-to-string n) "...")
- 0 vlf-file-size))
- (inhibit-read-only t))
- (setq n (1- n))
- (vlf-with-undo-disabled
- ;; (while (and (< (- end start) n)
- ;; (< n (- vlf-file-size start)))
- ;; (erase-buffer)
- ;; (vlf-tune-insert-file-contents-literally start end)
- ;; (goto-char (point-min))
- ;; (while (re-search-forward "[\n\C-m]" nil t)
- ;; (setq n (1- n)))
- ;; (vlf-verify-size)
- ;; (vlf-tune-batch '(:raw))
- ;; (setq start end
- ;; end (min vlf-file-size (+ start
- ;; vlf-batch-size)))
- ;; (progress-reporter-update reporter start))
- (when (< n (- vlf-file-size end))
- (vlf-tune-batch '(:insert :encode))
- (vlf-move-to-chunk start (+ start vlf-batch-size))
- (goto-char (point-min))
- (setq success
- (or (zerop n)
- (when (vlf-re-search "[\n\C-m]" n nil
- reporter time)
- (forward-char) t))))))
- (let ((end vlf-file-size)
- (reporter (make-progress-reporter
- (concat "Searching for line -"
- (number-to-string n) "...")
- 0 vlf-file-size))
- (inhibit-read-only t))
- (setq n (- n))
- (vlf-with-undo-disabled
- ;; (let ((start (max 0 (- vlf-file-size vlf-batch-size))))
- ;; (while (and (< (- end start) n) (< n end))
- ;; (erase-buffer)
- ;; (vlf-tune-insert-file-contents-literally start end)
- ;; (goto-char (point-max))
- ;; (while (re-search-backward "[\n\C-m]" nil t)
- ;; (setq n (1- n)))
- ;; (vlf-tune-batch '(:raw))
- ;; (setq end start
- ;; start (max 0 (- end vlf-batch-size)))
- ;; (progress-reporter-update reporter
- ;; (- vlf-file-size end))))
- (when (< n end)
- (vlf-tune-batch '(:insert :encode))
- (vlf-move-to-chunk (- end vlf-batch-size) end)
- (goto-char (point-max))
- (setq success (vlf-re-search "[\n\C-m]" n t
- reporter time))))))
- (if font-lock (font-lock-mode 1))
- (unless success
- (vlf-with-undo-disabled
- (vlf-move-to-chunk start-pos end-pos))
- (goto-char pos)
- (setq vlf-batch-size batch-size)
- (message "Unable to find line"))
- (run-hook-with-args 'vlf-after-batch-functions 'goto-line)))))
-
-(defun vlf-goto-line-hexl (n)
- "Go to line N. If N is negative, count from the end of file.
-Assume `hexl-mode' is active."
- (vlf-tune-load '(:hexl :raw))
- (if (< n 0)
- (let ((hidden-bytes (+ vlf-file-size (* n hexl-bits))))
- (setq hidden-bytes (- hidden-bytes (mod hidden-bytes
- vlf-batch-size)))
- (vlf-move-to-batch hidden-bytes)
- (goto-char (point-max))
- (forward-line (+ (round (- vlf-file-size
- (min vlf-file-size
- (+ hidden-bytes
- vlf-batch-size)))
- hexl-bits)
- n)))
- (let ((hidden-bytes (1- (* n hexl-bits))))
- (setq hidden-bytes (- hidden-bytes (mod hidden-bytes
- vlf-batch-size)))
- (vlf-move-to-batch hidden-bytes)
- (goto-char (point-min))
- (forward-line (- n 1 (/ hidden-bytes hexl-bits))))))
-
-(defun vlf-query-replace (regexp to-string &optional delimited backward)
- "Query replace over whole file matching REGEXP with TO-STRING.
-Third arg DELIMITED (prefix arg if interactive), if non-nil, replace
-only matches surrounded by word boundaries. A negative prefix arg means
-replace BACKWARD."
- (interactive (let ((common (query-replace-read-args
- (concat "Query replace over whole file"
- (if current-prefix-arg
- (if (eq current-prefix-arg '-)
- " backward"
- " word")
- "")
- " regexp")
- t)))
- (list (nth 0 common) (nth 1 common) (nth 2 common)
- (nth 3 common))))
- (let ((not-automatic t))
- (while (vlf-re-search regexp 1 backward)
- (cond (not-automatic
- (query-replace-regexp regexp to-string delimited
- nil nil backward)
- (if (eq 'automatic (lookup-key query-replace-map
- (vector last-input-event)))
- (setq not-automatic nil)))
- (backward (while (re-search-backward regexp nil t)
- (replace-match to-string)))
- (t (while (re-search-forward regexp nil t)
- (replace-match to-string))))
- (if (buffer-modified-p)
- (save-buffer)))))
-
-(provide 'vlf-search)
-
-;;; vlf-search.el ends here
diff --git a/packages/vlf/vlf-setup.el b/packages/vlf/vlf-setup.el
deleted file mode 100644
index aa061d0..0000000
--- a/packages/vlf/vlf-setup.el
+++ /dev/null
@@ -1,160 +0,0 @@
-;;; vlf-setup.el --- VLF integration with other packages -*- lexical-binding:
t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Keywords: large files, integration
-;; Author: Andrey Kotlarski <m00naticus@gmail.com>
-;; URL: https://github.com/m00natic/vlfi
-
-;; This file 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 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; This package enables VLF play seamlessly with rest of Emacs.
-
-;;; Code:
-
-(defgroup vlf nil "View Large Files in Emacs."
- :prefix "vlf-" :group 'files)
-
-(defcustom vlf-batch-size 1000000
- "Defines how large each batch of file data initially is (in bytes)."
- :group 'vlf :type 'integer)
-
-(defcustom vlf-application 'ask
- "Determines when `vlf' will be offered on opening files.
-Possible values are: nil to never use it;
-`ask' offer `vlf' when file size is beyond `large-file-warning-threshold';
-`dont-ask' automatically use `vlf' for large files;
-`always' use `vlf' for all files."
- :group 'vlf :type '(radio (const :format "%v " nil)
- (const :format "%v " ask)
- (const :format "%v " dont-ask)
- (const :format "%v" always)))
-
-(defcustom vlf-forbidden-modes-list
- '(archive-mode tar-mode jka-compr git-commit-mode image-mode
- doc-view-mode doc-view-mode-maybe ebrowse-tree-mode)
- "Major modes which VLF will not be automatically applied to."
- :group 'vlf :type '(list symbol))
-
-(defvar dired-mode-map)
-(declare-function dired-get-file-for-visit "dired")
-
-(unless (fboundp 'file-size-human-readable)
- (defun file-size-human-readable (file-size)
- "Print FILE-SIZE in MB."
- (format "%.3fMB" (/ file-size 1048576.0))))
-
-(defun vlf-determine-major-mode (filename)
- "Determine major mode from FILENAME."
- (let ((name filename)
- (remote-id (file-remote-p filename))
- mode)
- ;; Remove backup-suffixes from file name.
- (setq name (file-name-sans-versions name))
- ;; Remove remote file name identification.
- (and (stringp remote-id)
- (string-match (regexp-quote remote-id) name)
- (setq name (substring name (match-end 0))))
- (setq mode
- (if (memq system-type '(windows-nt cygwin))
- ;; System is case-insensitive.
- (let ((case-fold-search t))
- (assoc-default name auto-mode-alist 'string-match))
- ;; System is case-sensitive.
- (or ;; First match case-sensitively.
- (let ((case-fold-search nil))
- (assoc-default name auto-mode-alist 'string-match))
- ;; Fallback to case-insensitive match.
- (and auto-mode-case-fold
- (let ((case-fold-search t))
- (assoc-default name auto-mode-alist
- 'string-match))))))
- (if (and mode (consp mode))
- (cadr mode)
- mode)))
-
-(autoload 'vlf "vlf" "View Large FILE in batches." t)
-
-(defadvice abort-if-file-too-large (around vlf-if-file-too-large
- compile activate)
- "If file SIZE larger than `large-file-warning-threshold', \
-allow user to view file with `vlf', open it normally, or abort.
-OP-TYPE specifies the file operation being performed over FILENAME."
- (cond
- ((or (not size) (zerop size)))
- ((or (not vlf-application)
- (not filename)
- (memq (vlf-determine-major-mode filename)
- vlf-forbidden-modes-list))
- ad-do-it)
- ((eq vlf-application 'always)
- (vlf filename)
- (error ""))
- ((and large-file-warning-threshold
- (< large-file-warning-threshold size)
- (< vlf-batch-size size))
- (if (eq vlf-application 'dont-ask)
- (progn (vlf filename)
- (error ""))
- (let ((char nil))
- (while (not (memq (setq char
- (read-event
- (propertize
- (format
- "File %s is large (%s): \
-%s normally (o), %s with vlf (v) or abort (a)"
- (if filename
- (file-name-nondirectory filename)
- "")
- (file-size-human-readable size)
- op-type op-type)
- 'face 'minibuffer-prompt)))
- '(?o ?O ?v ?V ?a ?A))))
- (cond ((memq char '(?v ?V))
- (vlf filename)
- (error ""))
- ((memq char '(?a ?A))
- (error "Aborted"))))))))
-
-;; disable for some functions
-(defmacro vlf-disable-for-function (func file)
- "Build advice to disable VLF during execution of FUNC\
-defined in FILE."
- `(eval-after-load ,file
- '(defadvice ,func (around ,(intern (concat "vlf-"
- (symbol-name func)))
- compile activate)
- "Temporarily disable `vlf-mode'."
- (let ((vlf-application nil))
- ad-do-it))))
-
-(vlf-disable-for-function tags-verify-table "etags")
-(vlf-disable-for-function tag-find-file-of-tag-noselect "etags")
-(vlf-disable-for-function helm-etags-create-buffer "helm-tags")
-
-;; dired
-(defun dired-vlf ()
- "In Dired, visit the file on this line in VLF mode."
- (interactive)
- (vlf (dired-get-file-for-visit)))
-
-(eval-after-load "dired"
- '(define-key dired-mode-map "V" 'dired-vlf))
-
-(provide 'vlf-setup)
-
-;;; vlf-setup.el ends here
diff --git a/packages/vlf/vlf-tune.el b/packages/vlf/vlf-tune.el
deleted file mode 100644
index df92551..0000000
--- a/packages/vlf/vlf-tune.el
+++ /dev/null
@@ -1,464 +0,0 @@
-;;; vlf-tune.el --- VLF tuning operations -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Keywords: large files, batch size, performance
-;; Author: Andrey Kotlarski <m00naticus@gmail.com>
-;; URL: https://github.com/m00natic/vlfi
-
-;; This file 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 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; This package provides wrappers for basic chunk operations that add
-;; profiling and automatic tuning of `vlf-batch-size'.
-
-;;; Code:
-
-(defgroup vlf nil "View Large Files in Emacs."
- :prefix "vlf-" :group 'files)
-
-(defcustom vlf-batch-size 1000000
- "Defines how large each batch of file data initially is (in bytes)."
- :group 'vlf :type 'integer)
-(put 'vlf-batch-size 'permanent-local t)
-
-(defcustom vlf-tune-enabled t
- "Whether to allow automatic change of batch size.
-If nil, completely disable. If `stats', maintain measure statistics,
-but don't change batch size. If t, measure and change."
- :group 'vlf :type '(choice (const :tag "Enabled" t)
- (const :tag "Just statistics" stats)
- (const :tag "Disabled" nil)))
-
-(defvar vlf-file-size 0 "Total size in bytes of presented file.")
-(make-variable-buffer-local 'vlf-file-size)
-(put 'vlf-file-size 'permanent-local t)
-
-(defun vlf-tune-ram-size ()
- "Try to determine RAM size in bytes."
- (if (executable-find "free")
- (let* ((free (shell-command-to-string "free"))
- (match-from (string-match "[[:digit:]]+" free)))
- (if match-from
- (* 1000 (string-to-number (substring free match-from
- (match-end 0))))))))
-
-(defcustom vlf-tune-max (max (let ((ram-size (vlf-tune-ram-size)))
- (if ram-size
- (/ ram-size 20)
- 0))
- (or large-file-warning-threshold
- (eval (car (get 'large-file-warning-threshold
- 'standard-value)))))
- "Maximum batch size in bytes when auto tuning.
-Avoid increasing this after opening file with VLF."
- :group 'vlf :type 'integer)
-
-(defcustom vlf-tune-step (/ vlf-tune-max 10000)
- "Step used for tuning in bytes.
-Avoid decreasing this after opening file with VLF."
- :group 'vlf :type 'integer)
-
-(defcustom vlf-tune-load-time 1.0
- "How many seconds should batch take to load for best user experience."
- :group 'vlf :type 'float)
-
-(defvar vlf-tune-insert-bps nil
- "Vector of bytes per second insert measurements.")
-(make-variable-buffer-local 'vlf-tune-insert-bps)
-(put 'vlf-tune-insert-bps 'permanent-local t)
-
-(defvar vlf-tune-insert-raw-bps nil
- "Vector of bytes per second non-decode insert measurements.")
-(make-variable-buffer-local 'vlf-tune-insert-raw-bps)
-(put 'vlf-tune-insert-raw-bps 'permanent-local t)
-
-(defvar vlf-tune-encode-bps nil
- "Vector of bytes per second encode measurements.")
-(make-variable-buffer-local 'vlf-tune-encode-bps)
-(put 'vlf-tune-encode-bps 'permanent-local t)
-
-(defvar vlf-tune-write-bps nil
- "Vector of bytes per second write measurements.")
-
-(defvar vlf-tune-hexl-bps nil
- "Vector of bytes per second hexlify measurements.")
-
-(defvar vlf-tune-dehexlify-bps nil
- "Vector of bytes per second dehexlify measurements.")
-
-(defvar vlf-start-pos)
-(defvar hexl-bits)
-(defvar hexl-max-address)
-(declare-function hexl-line-displen "hexl")
-(declare-function dehexlify-buffer "hexl")
-
-(defun vlf-tune-copy-profile (from-buffer &optional to-buffer)
- "Copy specific profile vectors of FROM-BUFFER to TO-BUFFER.
-If TO-BUFFER is nil, copy to current buffer."
- (let (insert-bps insert-raw-bps encode-bps)
- (with-current-buffer from-buffer
- (setq insert-bps vlf-tune-insert-bps
- insert-raw-bps vlf-tune-insert-raw-bps
- encode-bps vlf-tune-encode-bps))
- (if to-buffer
- (with-current-buffer to-buffer
- (setq vlf-tune-insert-bps insert-bps
- vlf-tune-insert-raw-bps insert-raw-bps
- vlf-tune-encode-bps encode-bps))
- (setq vlf-tune-insert-bps insert-bps
- vlf-tune-insert-raw-bps insert-raw-bps
- vlf-tune-encode-bps encode-bps))))
-
-(defun vlf-tune-closest-index (size)
- "Get closest measurement index corresponding to SIZE."
- (let ((step (float vlf-tune-step)))
- (max 0 (1- (min (round size step) (round vlf-tune-max step))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; profiling
-
-(defun vlf-tune-initialize-measurement ()
- "Initialize measurement vector."
- (make-vector (1- (/ vlf-tune-max vlf-tune-step)) nil))
-
-(defmacro vlf-tune-add-measurement (vec size time)
- "Add at an appropriate position in VEC new SIZE TIME measurement.
-VEC is a vector of (mean time . count) elements ordered by size."
- `(when (and vlf-tune-enabled (not (zerop ,size)))
- (or ,vec (setq ,vec (vlf-tune-initialize-measurement)))
- (let* ((idx (vlf-tune-closest-index ,size))
- (existing (aref ,vec idx)))
- (aset ,vec idx (if (consp existing)
- (let ((count (1+ (cdr existing)))) ;recalculate mean
- (cons (/ (+ (* (1- count) (car existing))
- (/ ,size ,time))
- count)
- count))
- (cons (/ ,size ,time) 1))))))
-
-(defmacro vlf-time (&rest body)
- "Get timing consed with result of BODY execution."
- `(if vlf-tune-enabled
- (let* ((time (float-time))
- (result (progn ,@body)))
- (cons (- (float-time) time) result))
- (let ((result (progn ,@body)))
- (cons nil result))))
-
-(defun vlf-tune-insert-file-contents (start end)
- "Extract decoded file bytes START to END and save time it takes."
- (let ((result (vlf-time (insert-file-contents buffer-file-name
- nil start end))))
- (vlf-tune-add-measurement vlf-tune-insert-bps
- (- end start) (car result))
- (cdr result)))
-
-(defun vlf-tune-insert-file-contents-literally (start end &optional file)
- "Insert raw file bytes START to END and save time it takes.
-FILE if given is filename to be used, otherwise `buffer-file-name'."
- (let ((result (vlf-time (insert-file-contents-literally
- (or file buffer-file-name) nil start end))))
- (vlf-tune-add-measurement vlf-tune-insert-raw-bps
- (- end start) (car result))
- (cdr result)))
-
-(defun vlf-tune-encode-length (start end)
- "Get length of encoded region START to END and save time it takes."
- (let ((result (vlf-time (length (encode-coding-region
- start end
- buffer-file-coding-system t)))))
- (vlf-tune-add-measurement vlf-tune-encode-bps
- (cdr result) (car result))
- (cdr result)))
-
-(defun vlf-tune-write (start end append visit size &optional file-name)
- "Save buffer and save time it takes.
-START, END, APPEND, VISIT have same meaning as in `write-region'.
-SIZE is number of bytes that are saved.
-FILE-NAME if given is to be used instead of `buffer-file-name'."
- (let* ((file (or file-name buffer-file-name))
- (time (car (vlf-time (write-region start end file append
- visit)))))
- (or (file-remote-p file) ;writing to remote files can include network
copying
- (vlf-tune-add-measurement vlf-tune-write-bps size time))))
-
-(defun vlf-hexl-adjust-addresses ()
- "Adjust hexl address indicators according to `vlf-start-pos'."
- (let ((pos (point))
- (address vlf-start-pos))
- (goto-char (point-min))
- (while (re-search-forward "^[[:xdigit:]]+" nil t)
- (replace-match (format "%08x" address))
- (setq address (+ address hexl-bits)))
- (goto-char pos)))
-
-(defun vlf-tune-hexlify ()
- "Activate `hexl-mode' and save time it takes."
- (let* ((no-adjust (zerop vlf-start-pos))
- (time (car (vlf-time (hexlify-buffer)
- (or no-adjust
- (vlf-hexl-adjust-addresses))))))
- (setq hexl-max-address (+ (* (/ (1- (buffer-size))
- (hexl-line-displen)) 16) 15))
- (or no-adjust
- (vlf-tune-add-measurement vlf-tune-hexl-bps
- hexl-max-address time))))
-
-(defun vlf-tune-dehexlify ()
- "Exit `hexl-mode' and save time it takes."
- (let ((time (car (vlf-time (dehexlify-buffer)))))
- (vlf-tune-add-measurement vlf-tune-dehexlify-bps
- hexl-max-address time)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; tuning
-
-(defun vlf-tune-approximate-nearby (vec index)
- "VEC has value for INDEX, approximate to closest available."
- (let ((val 0)
- (left-idx (1- index))
- (right-idx (1+ index))
- (min-idx (max 0 (- index 5)))
- (max-idx (min (+ index 6)
- (1- (/ (min vlf-tune-max
- (/ (1+ vlf-file-size) 2))
- vlf-tune-step)))))
- (while (and (zerop val) (or (<= min-idx left-idx)
- (< right-idx max-idx)))
- (if (<= min-idx left-idx)
- (let ((left (aref vec left-idx)))
- (cond ((consp left) (setq val (car left)))
- ((numberp left) (setq val left)))))
- (if (< right-idx max-idx)
- (let ((right (aref vec right-idx)))
- (if (consp right)
- (setq right (car right)))
- (and (numberp right) (not (zerop right))
- (setq val (if (zerop val)
- right
- (/ (+ val right) 2))))))
- (setq left-idx (1- left-idx)
- right-idx (1+ right-idx)))
- val))
-
-(defmacro vlf-tune-get-value (vec index &optional dont-approximate)
- "Get value from VEC for INDEX.
-If missing, approximate from nearby measurement,
-unless DONT-APPROXIMATE is t."
- `(if ,vec
- (let ((val (aref ,vec ,index)))
- (cond ((consp val) (car val))
- ((null val)
- ,(if dont-approximate
- `(aset ,vec ,index 0)
- `(vlf-tune-approximate-nearby ,vec ,index)))
- ((zerop val) ;index has been tried before, yet still no value
- ,(if dont-approximate
- `(aset ,vec ,index
- (vlf-tune-approximate-nearby ,vec ,index))
- `(vlf-tune-approximate-nearby ,vec ,index)))
- (t val)))
- most-positive-fixnum))
-
-(defmacro vlf-tune-get-vector (key)
- "Get vlf-tune vector corresponding to KEY."
- `(cond ((eq ,key :insert) vlf-tune-insert-bps)
- ((eq ,key :raw) vlf-tune-insert-raw-bps)
- ((eq ,key :encode) vlf-tune-encode-bps)
- ((eq ,key :write) vlf-tune-write-bps)
- ((eq ,key :hexl) vlf-tune-hexl-bps)
- ((eq ,key :dehexlify) vlf-tune-dehexlify-bps)))
-
-(defun vlf-tune-assess (type coef index &optional approximate)
- "Get measurement value according to TYPE, COEF and INDEX.
-If APPROXIMATE is t, do approximation for missing values."
- (* coef (or (if approximate
- (vlf-tune-get-value (vlf-tune-get-vector type)
- index)
- (vlf-tune-get-value (vlf-tune-get-vector type)
- index t))
- 0)))
-
-(defun vlf-tune-score (types index &optional approximate time-max)
- "Calculate cumulative speed over TYPES for INDEX.
-If APPROXIMATE is t, do approximation for missing values.
-If TIME-MAX is non nil, return cumulative time instead of speed.
-If it is number, stop as soon as cumulative time gets equal or above."
- (catch 'result
- (let ((time 0)
- (size (* (1+ index) vlf-tune-step))
- (cut-time (numberp time-max)))
- (dolist (el types (if time-max time
- (/ size time)))
- (let ((bps (if (consp el)
- (vlf-tune-assess (car el) (cadr el) index
- approximate)
- (vlf-tune-assess el 1.0 index approximate))))
- (if (zerop bps)
- (throw 'result nil)
- (setq time (+ time (/ size bps)))
- (and cut-time (<= time-max time)
- (throw 'result nil))))))))
-
-(defun vlf-tune-conservative (types &optional index)
- "Adjust `vlf-batch-size' to best nearby value over TYPES.
-INDEX if given, specifies search independent of current batch size."
- (if (eq vlf-tune-enabled t)
- (let* ((half-max (/ (1+ vlf-file-size) 2))
- (idx (or index (vlf-tune-closest-index vlf-batch-size)))
- (curr (if (< half-max (* idx vlf-tune-step)) t
- (vlf-tune-score types idx))))
- (if curr
- (let ((prev (if (zerop idx) t
- (vlf-tune-score types (1- idx)))))
- (if prev
- (let ((next (if (or (eq curr t)
- (< half-max (* (1+ idx)
- vlf-tune-step)))
- t
- (vlf-tune-score types (1+ idx)))))
- (cond ((null next)
- (setq vlf-batch-size (* (+ 2 idx)
- vlf-tune-step)))
- ((eq curr t)
- (or (eq prev t)
- (setq vlf-batch-size
- (* idx vlf-tune-step))))
- (t (let ((best-idx idx))
- (and (numberp prev) (< curr prev)
- (setq curr prev
- best-idx (1- idx)))
- (and (numberp next) (< curr next)
- (setq best-idx (1+ idx)))
- (setq vlf-batch-size
- (* (1+ best-idx)
- vlf-tune-step))))))
- (setq vlf-batch-size (* idx vlf-tune-step))))
- (setq vlf-batch-size (* (1+ idx) vlf-tune-step))))))
-
-(defun vlf-tune-binary (types min max)
- "Adjust `vlf-batch-size' to optimal value using binary search, \
-optimizing over TYPES.
-MIN and MAX specify interval of indexes to search."
- (let ((sum (+ min max)))
- (if (< (- max min) 3)
- (vlf-tune-conservative types (/ sum 2))
- (let* ((left-idx (round (+ sum (* 2 min)) 4))
- (left (vlf-tune-score types left-idx)))
- (if left
- (let* ((right-idx (round (+ sum (* 2 max)) 4))
- (right (vlf-tune-score types right-idx)))
- (cond ((null right)
- (setq vlf-batch-size (* (1+ right-idx)
- vlf-tune-step)))
- ((< left right)
- (vlf-tune-binary types (/ (1+ sum) 2) max))
- (t (vlf-tune-binary types min (/ sum 2)))))
- (setq vlf-batch-size (* (1+ left-idx) vlf-tune-step)))))))
-
-(defun vlf-tune-linear (types max-idx)
- "Adjust `vlf-batch-size' to optimal known value using linear search.
-Optimize over TYPES up to MAX-IDX."
- (let ((best-idx 0)
- (best-bps 0)
- (idx 0))
- (while (< idx max-idx)
- (let ((bps (vlf-tune-score types idx t)))
- (and bps (< best-bps bps)
- (setq best-idx idx
- best-bps bps)))
- (setq idx (1+ idx)))
- (setq vlf-batch-size (* (1+ best-idx) vlf-tune-step))))
-
-(defun vlf-tune-batch (types &optional linear file)
- "Adjust `vlf-batch-size' to optimal value optimizing on TYPES.
-TYPES is alist of elements that may be of form (type coef) or
-non list values in which case coeficient is assumed 1.
-Types can be :insert, :raw, :encode, :write, :hexl or :dehexlify.
-If LINEAR is non nil, use brute-force. In case requested measurement
-is missing, stop search and set `vlf-batch-size' to this value.
-FILE if given is filename to be used, otherwise `buffer-file-name'.
-Suitable for multiple batch operations."
- (if (eq vlf-tune-enabled t)
- (let ((max-idx (1- (/ (min vlf-tune-max
- (/ (1+ vlf-file-size) 2))
- vlf-tune-step))))
- (if linear
- (vlf-tune-linear types max-idx)
- (let ((batch-size vlf-batch-size))
- (cond ((file-remote-p (or file buffer-file-name))
- (vlf-tune-conservative types))
- ((<= 1 max-idx)
- (if (< max-idx 3)
- (vlf-tune-conservative types (/ max-idx 2))
- (vlf-tune-binary types 0 max-idx))))
- (if (= batch-size vlf-batch-size) ;local maxima?
- (vlf-tune-linear types max-idx)))))))
-
-(defun vlf-tune-optimal-load (types &optional min-idx max-idx)
- "Get best batch size according to existing measurements over TYPES.
-Best considered where primitive operations total is closest to
-`vlf-tune-load-time'. If MIN-IDX and MAX-IDX are given,
-confine search to this region."
- (if (eq vlf-tune-enabled t)
- (progn
- (setq min-idx (max 0 (or min-idx 0))
- max-idx (min (or max-idx vlf-tune-max)
- (1- (/ (min vlf-tune-max
- (/ (1+ vlf-file-size) 2))
- vlf-tune-step))))
- (let* ((idx min-idx)
- (best-idx idx)
- (best-time-diff vlf-tune-load-time)
- (all-less t)
- (all-more t))
- (while (and (not (zerop best-time-diff)) (< idx max-idx))
- (let ((time-diff (vlf-tune-score types idx t
- (+ vlf-tune-load-time
- best-time-diff))))
- (if time-diff
- (progn
- (setq time-diff (if (< vlf-tune-load-time time-diff)
- (progn (setq all-less nil)
- (- time-diff
- vlf-tune-load-time))
- (setq all-more nil)
- (- vlf-tune-load-time time-diff)))
- (if (< time-diff best-time-diff)
- (setq best-idx idx
- best-time-diff time-diff)))
- (setq all-less nil)))
- (setq idx (1+ idx)))
- (* vlf-tune-step (1+ (cond ((or (zerop best-time-diff)
- (eq all-less all-more))
- best-idx)
- (all-less max-idx)
- (t min-idx))))))
- vlf-batch-size))
-
-(defun vlf-tune-load (types &optional region)
- "Adjust `vlf-batch-size' slightly to better load time.
-Optimize on TYPES on the nearby REGION. Use 2 if REGION is nil."
- (when (eq vlf-tune-enabled t)
- (or region (setq region 2))
- (let ((idx (vlf-tune-closest-index vlf-batch-size)))
- (setq vlf-batch-size (vlf-tune-optimal-load types (- idx region)
- (+ idx 1 region))))))
-
-(provide 'vlf-tune)
-
-;;; vlf-tune.el ends here
diff --git a/packages/vlf/vlf-write.el b/packages/vlf/vlf-write.el
deleted file mode 100644
index d5c87d5..0000000
--- a/packages/vlf/vlf-write.el
+++ /dev/null
@@ -1,202 +0,0 @@
-;;; vlf-write.el --- Saving functionality for VLF -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Keywords: large files, saving
-;; Author: Andrey Kotlarski <m00naticus@gmail.com>
-;; URL: https://github.com/m00natic/vlfi
-
-;; This file 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 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; This package provides the `vlf-write' command which takes care of
-;; saving changes where only part of file is viewed and updated.
-
-;;; Code:
-
-(require 'vlf-base)
-
-(defcustom vlf-save-in-place 'ask
- "Should VLF save in place when additional adjustment of file content\
-is needed."
- :group 'vlf :type '(choice (const :tag "Always when applicable" t)
- (const :tag "Ask when applicable" 'ask)
- (const :tag "Never" nil)))
-
-(defun vlf-write ()
- "Write current chunk to file. Always return true to disable save.
-If changing size of chunk, shift remaining file content."
- (interactive)
- (when (and (buffer-modified-p)
- (or (verify-visited-file-modtime (current-buffer))
- (y-or-n-p "File has changed since visited or saved.\
- Save anyway? ")))
- (widen)
- (run-hook-with-args 'vlf-before-batch-functions 'write)
- (let ((hexl (derived-mode-p 'hexl-mode)))
- (when hexl
- (if (consp buffer-undo-list)
- (setq buffer-undo-list nil))
- (vlf-tune-dehexlify))
- (if (zerop vlf-file-size) ;new file
- (progn (vlf-tune-write nil nil vlf-start-pos t
- (vlf-tune-encode-length (point-min)
- (point-max)))
- (if hexl (vlf-tune-hexlify))
- (setq vlf-file-size (vlf-get-file-size
- buffer-file-truename)
- vlf-end-pos vlf-file-size))
- (let* ((region-length (vlf-tune-encode-length (point-min)
- (point-max)))
- (size-change (- vlf-end-pos vlf-start-pos
- region-length)))
- (if (zerop size-change)
- (progn (vlf-tune-write nil nil vlf-start-pos t
- (- vlf-end-pos vlf-start-pos))
- (if hexl (vlf-tune-hexlify)))
- (let ((pos (point))
- (font-lock font-lock-mode)
- (batch-size vlf-batch-size)
- time)
- (font-lock-mode 0)
- (if (or (file-remote-p buffer-file-name)
- (if (eq vlf-save-in-place 'ask)
- (y-or-n-p "File content needs be adjusted\
- till end. Use temporary copy of the whole file (slower but safer)? ")
- (not vlf-save-in-place)))
- (let ((file-tmp (make-temp-file "vlf")))
- (setq time (float-time))
- (copy-file buffer-file-name file-tmp t t t t)
- (if (< 0 size-change)
- (vlf-file-shift-back size-change region-length
- file-tmp)
- (vlf-file-shift-forward (- size-change)
- region-length file-tmp))
- (rename-file file-tmp buffer-file-name t))
- (setq time (float-time))
- (if (< 0 size-change)
- (vlf-file-shift-back size-change region-length)
- (vlf-file-shift-forward (- size-change)
- region-length)))
- (if font-lock (font-lock-mode 1))
- (setq vlf-batch-size batch-size)
- (vlf-move-to-chunk-2 vlf-start-pos
- (if (< (- vlf-end-pos vlf-start-pos)
- vlf-batch-size)
- (+ vlf-start-pos vlf-batch-size)
- vlf-end-pos))
- (goto-char pos)
- (message "Save took %f seconds" (- (float-time) time)))))))
- (run-hook-with-args 'vlf-after-batch-functions 'write))
- t)
-
-(defun vlf-file-shift-back (size-change write-size &optional file)
- "Shift file contents SIZE-CHANGE bytes back.
-WRITE-SIZE is byte length of saved chunk.
-FILE if given is filename to be used, otherwise `buffer-file-name'."
- (vlf-tune-write nil nil vlf-start-pos (if file nil t) write-size file)
- (let ((read-start-pos vlf-end-pos)
- (coding-system-for-write 'no-conversion)
- (reporter (make-progress-reporter "Adjusting file content..."
- vlf-end-pos
- vlf-file-size)))
- (vlf-with-undo-disabled
- (while (vlf-shift-batch read-start-pos (- read-start-pos
- size-change)
- file)
- (setq read-start-pos (+ read-start-pos vlf-batch-size))
- (progress-reporter-update reporter read-start-pos))
- ;; pad end with space
- (erase-buffer)
- (vlf-verify-size t file)
- (insert-char 32 size-change))
- (vlf-tune-write nil nil (- vlf-file-size size-change)
- (if file nil t) size-change file)
- (progress-reporter-done reporter)))
-
-(defun vlf-shift-batch (read-pos write-pos file)
- "Read `vlf-batch-size' bytes from READ-POS and write them \
-back at WRITE-POS using FILE.
-Return nil if EOF is reached, t otherwise."
- (erase-buffer)
- (vlf-verify-size t file)
- (vlf-tune-batch '(:raw :write) nil file) ;insert speed over temp write file
may defer wildly
- (let ((read-end (min (+ read-pos vlf-batch-size) vlf-file-size))) ;compared
to the original file
- (vlf-tune-insert-file-contents-literally read-pos read-end file)
- (vlf-tune-write nil nil write-pos 0 (- read-end read-pos) file)
- (< read-end vlf-file-size)))
-
-(defun vlf-file-shift-forward (size-change write-size &optional file)
- "Shift file contents SIZE-CHANGE bytes forward.
-WRITE-SIZE is byte length of saved chunk.
-FILE if given is filename to be used, otherwise `buffer-file-name'.
-Done by saving content up front and then writing previous batch."
- (vlf-tune-batch '(:raw :write) nil file)
- (let ((read-size (max vlf-batch-size size-change))
- (read-pos vlf-end-pos)
- (write-pos vlf-start-pos)
- (reporter (make-progress-reporter "Adjusting file content..."
- vlf-start-pos
- vlf-file-size)))
- (vlf-with-undo-disabled
- (when (vlf-shift-batches read-size read-pos write-pos
- write-size t file)
- (vlf-tune-batch '(:raw :write) nil file)
- (setq write-pos (+ read-pos size-change)
- read-pos (+ read-pos read-size)
- write-size read-size
- read-size (max vlf-batch-size size-change))
- (progress-reporter-update reporter write-pos)
- (let ((coding-system-for-write 'no-conversion))
- (while (vlf-shift-batches read-size read-pos write-pos
- write-size nil file)
- (vlf-tune-batch '(:raw :write) nil file)
- (setq write-pos (+ read-pos size-change)
- read-pos (+ read-pos read-size)
- write-size read-size
- read-size (max vlf-batch-size size-change))
- (progress-reporter-update reporter write-pos)))))
- (progress-reporter-done reporter)))
-
-(defun vlf-shift-batches (read-size read-pos write-pos write-size
- hide-read file)
- "Append READ-SIZE bytes of file starting at READ-POS.
-Then write initial buffer content to file at WRITE-POS.
-WRITE-SIZE is byte length of saved chunk.
-If HIDE-READ is non nil, temporarily hide literal read content.
-FILE if given is filename to be used, otherwise `buffer-file-name'.
-Return nil if EOF is reached, t otherwise."
- (vlf-verify-size t file)
- (let ((read-more (< read-pos vlf-file-size))
- (start-write-pos (point-min))
- (end-write-pos (point-max)))
- (when read-more
- (goto-char end-write-pos)
- (vlf-tune-insert-file-contents-literally
- read-pos (min vlf-file-size (+ read-pos read-size)) file))
- ;; write
- (if hide-read ; hide literal region if user has to choose encoding
- (narrow-to-region start-write-pos end-write-pos))
- (vlf-tune-write start-write-pos end-write-pos write-pos
- (or (and (not read-more) (not file)) 0)
- write-size file)
- (delete-region start-write-pos end-write-pos)
- (if hide-read (widen))
- read-more))
-
-(provide 'vlf-write)
-
-;;; vlf-write.el ends here
diff --git a/packages/vlf/vlf.el b/packages/vlf/vlf.el
deleted file mode 100644
index 41322a4..0000000
--- a/packages/vlf/vlf.el
+++ /dev/null
@@ -1,364 +0,0 @@
-;;; vlf.el --- View Large Files -*- lexical-binding: t -*-
-
-;; Copyright (C) 2006, 2012-2018 Free Software Foundation, Inc.
-
-;; Version: 1.7.2
-;; Keywords: large files, utilities
-;; Maintainer: Andrey Kotlarski <m00naticus@gmail.com>
-;; Authors: 2006 Mathias Dahl <mathias.dahl@gmail.com>
-;; 2012 Sam Steingold <sds@gnu.org>
-;; 2013-2017 Andrey Kotlarski <m00naticus@gmail.com>
-;; URL: https://github.com/m00natic/vlfi
-
-;; This file 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 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; This package provides the M-x vlf command, which visits part of
-;; large file without loading it entirely. The buffer uses VLF mode,
-;; which provides several commands for moving around, searching,
-;; comparing and editing selected part of file.
-;; To have it offered when opening large files:
-;; (require 'vlf-setup)
-
-;; This package was inspired by a snippet posted by Kevin Rodgers,
-;; showing how to use `insert-file-contents' to extract part of a
-;; file.
-
-;;; Code:
-
-(require 'vlf-base)
-
-(defcustom vlf-before-batch-functions nil
- "Hook that runs before multiple batch operations.
-One argument is supplied that specifies current action. Possible
-values are: `write', `ediff', `occur', `search', `goto-line'."
- :group 'vlf :type 'hook)
-
-(defcustom vlf-after-batch-functions nil
- "Hook that runs after multiple batch operations.
-One argument is supplied that specifies current action. Possible
-values are: `write', `ediff', `occur', `search', `goto-line'."
- :group 'vlf :type 'hook)
-
-(defcustom vlf-batch-size-remote 1024
- "Defines size (in bytes) of a batch of file data when accessed remotely."
- :group 'vlf :type 'integer)
-
-(defvar hexl-bits)
-
-(autoload 'vlf-write "vlf-write" "Write current chunk to file." t)
-(autoload 'vlf-re-search-forward "vlf-search"
- "Search forward for REGEXP prefix COUNT number of times." t)
-(autoload 'vlf-re-search-backward "vlf-search"
- "Search backward for REGEXP prefix COUNT number of times." t)
-(autoload 'vlf-goto-line "vlf-search" "Go to line." t)
-(autoload 'vlf-query-replace "vlf-search"
- "Query replace regexp over whole file." t)
-(autoload 'vlf-occur "vlf-occur"
- "Make whole file occur style index for REGEXP." t)
-(autoload 'vlf-toggle-follow "vlf-follow"
- "Toggle continuous chunk recenter around current point." t)
-(autoload 'vlf-stop-follow "vlf-follow" "Stop continuous recenter." t)
-(autoload 'vlf-ediff-buffers "vlf-ediff"
- "Run batch by batch ediff over VLF buffers." t)
-
-(defvar vlf-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "n" 'vlf-next-batch)
- (define-key map "p" 'vlf-prev-batch)
- (define-key map " " 'vlf-next-batch-from-point)
- (define-key map "+" 'vlf-change-batch-size)
- (define-key map "-"
- (lambda () "Decrease vlf batch size by factor of 2."
- (interactive)
- (vlf-change-batch-size t)))
- (define-key map "s" 'vlf-re-search-forward)
- (define-key map "r" 'vlf-re-search-backward)
- (define-key map "%" 'vlf-query-replace)
- (define-key map "o" 'vlf-occur)
- (define-key map "[" 'vlf-beginning-of-file)
- (define-key map "]" 'vlf-end-of-file)
- (define-key map "j" 'vlf-jump-to-chunk)
- (define-key map "l" 'vlf-goto-line)
- (define-key map "e" 'vlf-ediff-buffers)
- (define-key map "f" 'vlf-toggle-follow)
- (define-key map "g" 'vlf-revert)
- map)
- "Keymap for `vlf-mode'.")
-
-(defvar vlf-prefix-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-v" vlf-mode-map)
- map)
- "Prefixed keymap for `vlf-mode'.")
-
-(define-minor-mode vlf-mode
- "Mode to browse large files in."
- :group 'vlf :keymap vlf-prefix-map
- :lighter (:eval (format " VLF[%d/%d](%s)"
- (ceiling vlf-end-pos vlf-batch-size)
- (ceiling vlf-file-size vlf-batch-size)
- (file-size-human-readable vlf-file-size)))
- (cond (vlf-mode
- (set (make-local-variable 'require-final-newline) nil)
- (add-hook 'write-file-functions 'vlf-write nil t)
- (set (make-local-variable 'revert-buffer-function)
- 'vlf-revert)
- (make-local-variable 'vlf-batch-size)
- (setq vlf-file-size (vlf-get-file-size buffer-file-truename)
- vlf-start-pos 0
- vlf-end-pos 0)
- (let* ((pos (position-bytes (point)))
- (start (* (/ pos vlf-batch-size) vlf-batch-size)))
- (goto-char (byte-to-position (- pos start)))
- (vlf-move-to-batch start))
- (add-hook 'after-change-major-mode-hook 'vlf-keep-alive t t)
- (vlf-keep-alive))
- ((or (not large-file-warning-threshold)
- (< vlf-file-size large-file-warning-threshold)
- (y-or-n-p (format "Load whole file (%s)? "
- (file-size-human-readable
- vlf-file-size))))
- (kill-local-variable 'revert-buffer-function)
- (vlf-stop-follow)
- (kill-local-variable 'require-final-newline)
- (remove-hook 'write-file-functions 'vlf-write t)
- (remove-hook 'after-change-major-mode-hook
- 'vlf-keep-alive t)
- (if (derived-mode-p 'hexl-mode)
- (let ((line (/ (1+ vlf-start-pos) hexl-bits))
- (pos (point)))
- (if (consp buffer-undo-list)
- (setq buffer-undo-list nil))
- (vlf-with-undo-disabled
- (let ((inhibit-read-only t))
- (insert-file-contents-literally buffer-file-name
- t nil nil t)
- (hexlify-buffer)))
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (forward-line line)
- (forward-char pos))
- (let ((pos (+ vlf-start-pos (position-bytes (point))))
- (inhibit-read-only t))
- (vlf-with-undo-disabled
- (insert-file-contents buffer-file-name t nil nil t))
- (goto-char (byte-to-position pos)))))
- (t (setq vlf-mode t))))
-
-(defun vlf-keep-alive ()
- "Keep `vlf-mode' on major mode change."
- (if (derived-mode-p 'hexl-mode)
- (set (make-local-variable 'revert-buffer-function) 'vlf-revert))
- (setq vlf-mode t))
-
-;;;###autoload
-(defun vlf (file &optional minimal)
- "View Large FILE in batches. When MINIMAL load just a few bytes.
-You can customize number of bytes displayed by customizing
-`vlf-batch-size'.
-Return newly created buffer."
- (interactive (list (read-file-name "File to open: ") nil))
- (let ((vlf-buffer (generate-new-buffer "*vlf*")))
- (set-buffer vlf-buffer)
- (set-visited-file-name file)
- (set-buffer-modified-p nil)
- (cond (minimal
- (set (make-local-variable 'vlf-batch-size) 1024))
- ((file-remote-p file)
- (set (make-local-variable 'vlf-batch-size) vlf-batch-size-remote)))
- (vlf-mode 1)
- (when minimal ;restore batch size to default value
- (kill-local-variable 'vlf-batch-size)
- (make-local-variable 'vlf-batch-size))
- (switch-to-buffer vlf-buffer)
- vlf-buffer))
-
-(defun vlf-next-batch (append)
- "Display the next batch of file data.
-When prefix argument is supplied and positive
- jump over APPEND number of batches.
-When prefix argument is negative
- append next APPEND number of batches to the existing buffer."
- (interactive "p")
- (vlf-verify-size)
- (vlf-tune-load (if (derived-mode-p 'hexl-mode)
- '(:hexl :raw)
- '(:insert :encode)))
- (let* ((end (min (+ vlf-end-pos (* vlf-batch-size (abs append)))
- vlf-file-size))
- (start (if (< append 0)
- vlf-start-pos
- (- end vlf-batch-size))))
- (vlf-move-to-chunk start end)))
-
-(defun vlf-prev-batch (prepend)
- "Display the previous batch of file data.
-When prefix argument is supplied and positive
- jump over PREPEND number of batches.
-When prefix argument is negative
- append previous PREPEND number of batches to the existing buffer."
- (interactive "p")
- (if (zerop vlf-start-pos)
- (error "Already at BOF"))
- (vlf-tune-load (if (derived-mode-p 'hexl-mode)
- '(:hexl :raw)
- '(:insert :encode)))
- (let* ((start (max 0 (- vlf-start-pos (* vlf-batch-size (abs prepend)))))
- (end (if (< prepend 0)
- vlf-end-pos
- (+ start vlf-batch-size))))
- (vlf-move-to-chunk start end)))
-
-;; scroll auto batching
-(defadvice scroll-up (around vlf-scroll-up
- activate compile)
- "Slide to next batch if at end of buffer in `vlf-mode'."
- (if (and vlf-mode (pos-visible-in-window-p (point-max)))
- (progn (vlf-next-batch 1)
- (goto-char (point-min)))
- ad-do-it))
-
-(defadvice scroll-down (around vlf-scroll-down
- activate compile)
- "Slide to previous batch if at beginning of buffer in `vlf-mode'."
- (if (and vlf-mode (pos-visible-in-window-p (point-min)))
- (progn (vlf-prev-batch 1)
- (goto-char (point-max)))
- ad-do-it))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; hexl mode integration
-
-(eval-after-load "hexl"
- '(progn
- (defadvice hexl-save-buffer (around vlf-hexl-save
- activate compile)
- "Prevent hexl save if `vlf-mode' is active."
- (if vlf-mode
- (vlf-write)
- ad-do-it))
-
- (defadvice hexl-scroll-up (around vlf-hexl-scroll-up
- activate compile)
- "Slide to next batch if at end of buffer in `vlf-mode'."
- (if (and vlf-mode (pos-visible-in-window-p (point-max))
- (or (not (numberp arg)) (< 0 arg)))
- (progn (vlf-next-batch 1)
- (goto-char (point-min)))
- ad-do-it))
-
- (defadvice hexl-scroll-down (around vlf-hexl-scroll-down
- activate compile)
- "Slide to previous batch if at beginning of buffer in `vlf-mode'."
- (if (and vlf-mode (pos-visible-in-window-p (point-min)))
- (progn (vlf-prev-batch 1)
- (goto-char (point-max)))
- ad-do-it))
-
- (defadvice hexl-mode-exit (around vlf-hexl-mode-exit
- activate compile)
- "Exit `hexl-mode' gracefully in case `vlf-mode' is active."
- (if (and vlf-mode (not (buffer-modified-p)))
- (vlf-with-undo-disabled
- (erase-buffer)
- ad-do-it
- (vlf-move-to-chunk-2 vlf-start-pos vlf-end-pos))
- ad-do-it))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; utilities
-
-(defun vlf-change-batch-size (decrease)
- "Change the buffer-local value of `vlf-batch-size'.
-Normally, the value is doubled;
-with the prefix argument DECREASE it is halved."
- (interactive "P")
- (vlf-set-batch-size (if decrease (/ vlf-batch-size 2)
- (* vlf-batch-size 2))))
-
-(defun vlf-set-batch-size (size)
- "Set batch to SIZE bytes and update chunk."
- (interactive
- (list (read-number "Size in bytes: "
- (vlf-tune-optimal-load
- (if (derived-mode-p 'hexl-mode)
- '(:hexl :raw)
- '(:insert :encode))))))
- (setq vlf-batch-size size)
- (vlf-move-to-batch vlf-start-pos))
-
-(defun vlf-beginning-of-file ()
- "Jump to beginning of file content."
- (interactive)
- (vlf-tune-load (if (derived-mode-p 'hexl-mode)
- '(:hexl :raw)
- '(:insert :encode)))
- (vlf-move-to-batch 0))
-
-(defun vlf-end-of-file ()
- "Jump to end of file content."
- (interactive)
- (vlf-verify-size)
- (vlf-tune-load (if (derived-mode-p 'hexl-mode)
- '(:hexl :raw)
- '(:insert :encode)))
- (vlf-move-to-batch vlf-file-size))
-
-(defun vlf-revert (&optional _auto noconfirm)
- "Revert current chunk. Ignore _AUTO.
-Ask for confirmation if NOCONFIRM is nil."
- (interactive)
- (when (or noconfirm
- (yes-or-no-p (format "Revert buffer from file %s? "
- buffer-file-name)))
- (set-buffer-modified-p nil)
- (vlf-move-to-chunk-2 vlf-start-pos vlf-end-pos)))
-
-(defun vlf-jump-to-chunk (n)
- "Go to to chunk N."
- (interactive "nGoto to chunk: ")
- (vlf-tune-load (if (derived-mode-p 'hexl-mode)
- '(:hexl :raw)
- '(:insert :encode)))
- (vlf-move-to-batch (* (1- n) vlf-batch-size)))
-
-(defun vlf-no-modifications ()
- "Ensure there are no buffer modifications."
- (if (buffer-modified-p)
- (error "Save or discard your changes first")
- t))
-
-(defun vlf-move-to-batch (start)
- "Move to batch determined by START.
-Adjust according to file start/end and show `vlf-batch-size' bytes."
- (vlf-verify-size)
- (let* ((start (max 0 start))
- (end (min (+ start vlf-batch-size) vlf-file-size)))
- (if (= vlf-file-size end) ; re-adjust start
- (setq start (max 0 (- end vlf-batch-size))))
- (vlf-move-to-chunk start end)))
-
-(defun vlf-next-batch-from-point ()
- "Display batch of file data starting from current point."
- (interactive)
- (let ((start (+ vlf-start-pos (position-bytes (point)) -1)))
- (vlf-move-to-chunk start (+ start vlf-batch-size)))
- (goto-char (point-min)))
-
-(provide 'vlf)
-
-;;; vlf.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master 2e76655: Convert the last :subtrees listed in externals-list,
Stefan Monnier <=