From 238b24ca30f2e642d808cd7b41e84e362db3a2d5 Mon Sep 17 00:00:00 2001 From: Don Armstrong <don@donarmstrong.com> Date: Fri, 17 Jul 2015 19:42:52 -0500 Subject: [PATCH] remove ecasound and emacs wiki --- emacs_el/ecasound.el | 2321 ------------------------ emacs_el/emacs-wiki.el | 3930 ---------------------------------------- 2 files changed, 6251 deletions(-) delete mode 100644 emacs_el/ecasound.el delete mode 100644 emacs_el/emacs-wiki.el diff --git a/emacs_el/ecasound.el b/emacs_el/ecasound.el deleted file mode 100644 index 895ee0c..0000000 --- a/emacs_el/ecasound.el +++ /dev/null @@ -1,2321 +0,0 @@ -;;; ecasound.el --- Interactive and programmatic interface to Ecasound - -;; Copyright (C) 2001, 2002 Mario Lang - -;; Author: Mario Lang <mlang@delysid.org> -;; Keywords: audio, ecasound, eci, comint, process, pcomplete -;; Version: 0.8.2 - -;; 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 2, 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 file implements several aspects of ecasound use: -;; -;; * A derived-major-mode, from comint mode for an inferior ecasound -;; process (ecasound-aim-mode). Complete with context sensitive -;; completion and interactive features to control the current process -;; using ECI. -;; -;; * Ecasound Control Interface (ECI) library for programmatic control -;; of a Ecasound process. This allows you to write Ecasound batch -;; jobs in Emacs-Lisp with Lisp functions and return values. Have a -;; look at eci-example and ecasound-normalize. -;; -;; * ecasound-ewf-mode, a mode for editing .ewf files. -;; -;; -;; Usage: -;; -;; You need at least ecasound 2.2.0 for this file to work properly. -;; -;; Put ecasound.el in your load-path and require it in your .emacs. -;; Set `ecasound-program' to the path to your ecasound executable. -;; -;; (setq load-path (cons "/home/user/elisp") -;; (require 'ecasound) -;; (setq ecasound-program "/home/user/bin/ecasound" -;; eci-program "/home/user/bin/ecasound") -;; -;; To set ecasound startup options use -;; -;; M-x ecasound-customize-startup RET -;; -;; Then use M-x ecasound RET to invoke an inferior ecasound process. -;; -;; For programmatic use of the ECI API, have a look at `eci-init', -;; `eci-command' and in general the eci-* namespace. -;; -;; Compatibility: -;; -;; This file only works with GNU Emacs 21. I've invested some minimal efforts -;; to get it working with XEmacs, but have so far failed to succeed. -;; Motivation isn't very high to get it working with XEmacs since I personally -;; never use it. So if you would like to use ecasound.el under XEmacs, you -;; will have ttodo -;; M-x toggle-debug-on-error RET -;; and see what you can figure out. I'm happy to receive useful suggestions. -;; -;; Todo: -;; -;; * Find a better way to do status info fetching... -;; * Add more conditions to the menu. -;; * Use map-xxx-list data in the ecasound-copp widget. This means we -;; need to merge cop-status and map-cop-list data somehow or have -;; the cop-editor fetch hints from map-cop/ladpsa/preset-list. -;; * Make `ecasound-signalview' faster, and allow to invoke it on already -;; opened sessions. -;; * Fix the case where ecasound sends output *after* the prompt. -;; This is tricky! Fixed for internal parsing, probably will leave -;; like that for interactive use, not worth the trouble... -;; * Copy documentation for ECI commands into eci-* docstrings and menu -;; :help keywords. -;; * Expand the menu. -;; * Bind most important interactive functions in ecasound-iam-mode-map -;; (which layout to use?) - -;;; History: -;; -;; Version: 0.8.2 -;; -;; * Added quite some missing docstrings. -;; * New variable `ecasound-last-command-alist'. Use that to do fancy stuff -;; to certain commands return values. -;; * New variable `ecasound-type-alist'. Normally you should not need to -;; change this, but it's nice to have it configurable. -;; * New function `eci-is-valid-p'. Rationale is that nil as return -;; value of a ECI command should indicate an error. So this function -;; with a -p suffix to use as a predicate. -;; * New variable `ecasound-parent' holds the parent buffer in a daemon buffer. -;; * New variables ecasound-timer-flag&interval. -;; * Renamed `eci-output-filter' to `ecasound-output-filter'. -;; * New variable ecasound-mode|header-line-format. -;; * `ecasound-cop-edit' now uses cop-set instead of -;; cop-select+copp-select+copp-set to update values. -;; * Fixed multiple-argument handling. They are separated with ',', not -;; with a space. -;; * New variable ecasound-sending-command, used to prevent the background -;; timer from coliding with other ECI requests. -;; -;; Version: 0.8.1 -;; -;; * Make ai|ao|cs-forward|rewind use ai|ao|cs-selected in the prompt -;; string of the interactive spec. -;; * New keymaps ecasound-audioin|audioout-map. -;; Now you can be very quick: -;; M-x ecasound RET M-i a <select file> RET M-o d start RET -;; * New menu ecasound-iam-ai|ao-menu. -;; * defeci for ai|ao-add|forward|iselect|list|rewind|select|selected -;; * Deleted `ecasound-buffer-name' and `eci-buffer-name' and replaced -;; calls to `make-comint-in-buffer' with `make-comint'. -;; * Extended defeci's :cache and :cache-doc to defvar the variable. -;; * Cleaned up some old alias definitions. -;; -;; Version: 0.8.0 -;; -;; * New custom type ecasound-args, which is now used for `ecasound-arguments' -;; and `eci-arguments'. -;; * If :cache is specified, also try to find a cached version in daemon-buffer -;; if available. -;; * Added :alias keyword to defeci. Delete defecialias. -;; * Added ":pcomplete doc" to several defeci calls. -;; * ecasound-cop|ctrl-add deleted and merged with the interactive spec of -;; eci-cop|ctrl-add. Now if prefix arg (C-u) is given, prompt for plain -;; string, otherwise prompt with completion. Also changed binding -;; in ChainOp menu. -;; * `ecasound-messages': variable deleted. -;; * `ecasound-arguments': Now handles -d:nnn properly. -;; * Many other minor tweaks and fixes. -;; -;; Version: 0.7.9 -;; -;; * Cleanup and extend `defeci', now handles keyword :cache and :pcomplete. -;; Lots of `defeci'-caller updates, and additions. -;; * Extended `ecasound-arguments' customize defition to handle --daemon, -;; --daemon-port:nnn, -n:name and -b:size. New interactive function -;; `ecasound-customize-startup', also bound in "Ecasound menu." -;; * Added status-information fetching via timer-function. Puts -;; info in mode-line as well as header-line. (warning, this feature is still -;; a bit unstable.) -;; * New macro `eci-hide-output' used to redirect action to `ecasound-daemon' -;; if possible. Several completion-fascilities updated to use it. -;; * Various other fixes. -;; -;; Version: 0.7.8 -;; -;; * Fix bug in "cop-add -el:" completion. -;; * Made `ecasound-format-arg' a bit prettier. -;; * Add --daemon support. If --daemon is set in `ecasound-arguments', -;; ecasound-iam-mode will take advantage of that and initialize a -;; `ecasound-daemon' channel, as well as a periodic timer to update the -;; mode-line. M-: (display-buffer ecasound-daemon) RET to view its contents. -;; -;; Version: 0.7.7 -;; -;; * Fixed hangup if a Stringlist ('S') returned a empty list. -;; * Added keybindings. See C-h m for details. Still alot missing. -;; * Added cs-forward and cs-rewind. Can be used interactively, or -;; prompt for value. With no prefix arg, prompts for value, with -;; prefix arg, uses that. Example: C-u M-c M-s f forwards the chainsetup -;; by 4 seconds, M-9 M-c M-s f forwards nine seconds ... -;; * Fixed field-no-longer-editable bug when +/- is used in -;; ecasound-cop-editor (thanks Per). This also makes the slider useful again. -;; * Got rid of ecasound-prompt assumptions in `eci-parse' and `eci-command'. -;; * Make the eci-command family work with --daemon tcp/ip connections. -;; (no code for initialising daemon stuff yet, but eci-* commands -;; work fine with tcp/ip conns (tested manually). -;; * `eci-parse' deleted and merged with `eci-output-filter'. -;; -;; Version: 0.7.6 -;; -;; * Various minor bugfixes and enhancements. -;; * Implemented ecasignalview as `ecasound-signalview' directly in Lisp. -;; This is another demonstration that ECI was really a Good Thing(tm)! -;; * Changed defeci to make it look more like a defun. -;; * Removed eci-process-*-register handling completely. Rationale is -;; that the map-*-list stuff is actually much more uniform and offers more -;; info. -;; * Rewrote `pcomplete/ecasound-iam-mode/cop-add' to use map-*-list. -;; * Rewrote `ecasound-ctrl-add' using map-ctrl-list instead of ctrl-register -;; and `ecasound-read-copp'. -;; * Rewrote `ecasound-cop-add' using map-cop|ladspa|preset-list. -;; * New function `eci-process-map-list' which processes the new map-xxx-list -;; output into a wellformed Lisp list. -;; * `ecasound-iam-commands' is now filled using int-cmd-list. -;; * cop-map-list handling. Used in `ecasound-cop-add' now. New function -;; `ecasound-read-copp' uses the now available default value. -;; -;; Version: 0.7.5 -;; -;; * Added ctrl-register parsing support and `ecasound-ctrl-add'. -;; * Added preset-register support (so far only for cop-add completion) -;; * Fixed cop-status parsing bug which caused `ecasound-cop-edit' to not -;; work in some cases. -;; * New macro defeci which handles defining ECI commands in lisp. -;; * Several other minor tweaks and fixes. -;; -;; Version: 0.7.4 -;; -;; * Fixed `eci-command' once again, it blocked for nearly every call... :( -;; * Fixed ecasound-cop-add in the ladspa case. -;; -;; Version: 0.7.3 -;; -;; * Fixed missing require. -;; -;; Version: 0.7.2 -;; -;; * Integrated ladspa-register into ecasound-cop-add -;; Now we've a very huge list to select from using completion. -;; * Some little cleanups. -;; * Fixed ecasound-cop-add to actually add the ':' between name and args. -;; * Removed the slider widget for now from the :format property of -;; ecasound-copp. -;; * Added `ecasound-messages' for a nice customisable interface to -;; loglevels, strangely, cvs version doesnt seem to recognize -;; -d:%d -;; -;; Version: 0.7.1 -;; -;; * Created a slider widget. It's not flawless, but it works! -;; - -;;; Code: - -(require 'cl) -(require 'comint) -(require 'easymenu) -(require 'pcomplete) -(require 'widget) -(require 'wid-edit) - -(defgroup ecasound nil - "Ecasound is a software package designed for multitrack audio processing. -It can be used for simple tasks like audio playback, recording and format -conversions, as well as for multitrack effect processing, mixing, recording -and signal recycling. Ecasound supports a wide range of audio inputs, outputs -and effect algorithms. Effects and audio objects can be combined in various -ways, and their parameters can be controlled by operator objects like -oscillators and MIDI-CCs. - -Variables in this group affect inferior ecasound processes started from -within Emacs using the command `ecasound'. - -See the subgroup `eci' for settings which affect the programmatic interface -to ECI." - :prefix "ecasound-" - :group 'processes) - -(define-widget 'ecasound-cli-arg 'string - "A Custom Widget for a command-line argument." - :format "%t: %v%d" - :string-match 'ecasound-cli-arg-string-match - :match 'ecasound-cli-arg-match - :value-to-internal - (lambda (widget value) - (when (widget-apply widget :string-match value) - (match-string 1 value))) - :value-to-external - (lambda (widget value) - (format (widget-apply widget :arg-format) value))) - -(defun ecasound-cli-arg-match (widget value) - (when (stringp value) - (widget-apply widget :string-match value))) - -(defun ecasound-cli-arg-string-match (widget value) - (string-match - (format (concat "^" (regexp-quote (widget-get widget :arg-format))) - (concat "\\(" (widget-get widget :pattern) "\\)")) - value)) - -(define-widget 'ecasound-daemon-port 'ecasound-cli-arg - "A Custom Widget for the --daemon-port:port argument." - :pattern ".*" - :arg-format "--daemon-port:%s") - -(define-widget 'ecasound-chainsetup-name 'ecasound-cli-arg - "A Custom Widget for the -n:chainsetup argument." - :arg-format "-n:%s" - :doc "Sets the name of chainsetup. -If not specified, defaults either to \"command-line-setup\" or to the file -name from which chainsetup was loaded. Whitespaces are not allowed." - :format "%t: %v%h" - :pattern ".*" - :tag "Chainsetup name") - -(define-widget 'ecasound-buffer-size 'ecasound-cli-arg - "A Custom Widget for the -b:buffer size argument." - :arg-format "-b:%s" - :doc "Sets the size of buffer in samples (must be an exponent of 2). -This is quite an important option. For real-time processing, you should set -this as low as possible to reduce the processing delay. Some machines can -handle buffer values as low as 64 and 128. In some circumstances (for -instance when using oscillator envelopes) small buffer sizes will make -envelopes act more smoothly. When not processing in real-time (all inputs -and outputs are normal files), values between 512 - 4096 often give better -results." - :format "%t: %v%h" - :pattern "[0-9]+" - :tag "Buffer size") - -(define-widget 'ecasound-debug-level 'set - "Custom widget for the -d:nnn argument." - :arg-format "-d:%s" - :args '((const :tag "Errors" 1) - (const :tag "Info" 2) - (const :tag "Subsystems" 4) - (const :tag "Module names" 8) - (const :tag "User objects" 16) - (const :tag "System objects" 32) - (const :tag "Functions" 64) - (const :tag "Continuous" 128) - (const :tag "EIAM return values" 256)) - :doc "Set the debug level" - :match 'ecasound-cli-arg-match - :pattern "[0-9]+" - :string-match 'ecasound-cli-arg-string-match - :tag "Debug level" - :value-to-external - (lambda (widget value) - (format (widget-get widget :arg-format) - (number-to-string (apply #'+ (widget-apply widget :value-get))))) - :value-to-internal - (lambda (widget value) - (when (widget-apply widget :string-match value) - (let ((level (string-to-number (match-string 1 value))) - (levels (nreverse - (mapcar (lambda (elt) (car (last elt))) - (widget-get widget :args))))) - (if (or (> level (apply #'+ levels)) (< level 0)) - (error "Invalid debug level %d" level) - (delq nil - (mapcar (lambda (elem) - (when (eq (/ level elem) 1) - (setq level (- level elem)) - elem)) levels))))))) - -(define-widget 'ecasound-args 'set - "" - :args '((const :tag "Start ecasound in interactive mode" "-c") - (const :tag "Print all debug information to stderr" - :doc "(unbuffered, plain output without ncurses)" - "-D") - (ecasound-debug-level) - (list :format "%v" :inline t - (const :tag "Allow remote connections:" "--daemon") - (ecasound-daemon-port :tag "Daemon port" "--daemon-port:2868")) - (ecasound-buffer-size "-b:1024") - (ecasound-chainsetup-name "-n:eca-el-setup") - (const :tag "Truncate outputs" :format "%t\n%h" - :doc "All output objects are opened in overwrite mode. -Any existing files will be truncated." - "-x") - (const :tag "Open outputs for updating" - :doc "Ecasound opens all outputs - if target format allows it - in readwrite mode." - "-X") - (repeat :tag "Others" :inline t (string :tag "Argument")))) - -(defcustom ecasound-arguments '("-c" "-d:259" "--daemon" "--daemon-port:2868" - "-n:eca-el-setup") - "*Command line arguments used when starting an ecasound process." - :group 'ecasound - :type 'ecasound-args) - -(defun ecasound-daemon-port () - "Return the port number defined in `ecasound-arguments'." - (let ((elem (member* "^--daemon-port:\\(.*\\)" ecasound-arguments - :test #'string-match))) - (if elem - (match-string 1 (car elem))))) - -(defun ecasound-customize-startup () - "Customize ecasound startup arguments." - (interactive) - (customize-variable 'ecasound-arguments)) - -(defcustom ecasound-program "/home/mlang/bin/ecasound" - "*Ecasound's executable. -This program is executed when the user invokes \\[ecasound]." - :group 'ecasound - :type 'file) - -(defcustom ecasound-prompt-regexp "^ecasound[^>]*> " - "Regexp to use to match the prompt." - :group 'ecasound - :type 'regexp) - -(defcustom ecasound-parse-cleanup-buffer t - "*Indicates if `ecasound-output-filter' should cleanup the buffer. -This means the loglevel, msgsize and return type will get removed if -parsed successfully." - :group 'ecasound - :type 'boolean) - -(defcustom ecasound-error-hook nil - "*Called whenever a ECI error happens." - :group 'ecasound - :type 'hook) - -(defcustom ecasound-message-hook '(ecasound-print-message) - "*Hook called whenever a message except loglevel 256 (eci) is received. -Arguments are LOGLEVEL and STRING." - :group 'ecasound - :type 'hook) - -(defun ecasound-print-message (level msg) - "Simple function which prints every message regardless which loglevel. -Argument LEVEL is the debug level." - (message "Ecasound (%d): %s" level msg)) - -(defface ecasound-error-face '((t (:foreground "White" :background "Red"))) - "Face used to highlight errors." - :group 'ecasound) - -(defcustom ecasound-timer-flag t - "*If non-nil, fetch status information in background." - :group 'ecasound - :type 'boolean) - -(defcustom ecasound-timer-interval 2 - "*Defines how often status information should be fetched." - :group 'ecasound - :type 'number) - -(defcustom ecasound-mode-line-format - '("-" - mode-line-frame-identification - mode-line-buffer-identification - eci-engine-status " " - ecasound-mode-string - " %[(" - (:eval (mode-line-mode-name)) - mode-line-process - minor-mode-alist - "%n" - ")%]--" - (line-number-mode "L%l--") - (column-number-mode "C%c--") - (-3 . "%p") - "-%-") - "*Mode Line Format used in `ecasound-iam-mode'." - :group 'ecasound - :type '(repeat - (choice - string - variable - (cons integer string) - (list :tag "Evaluate" (const :value :eval) sexp) - (repeat sexp)))) - -(defcustom ecasound-header-line-format nil - "*If non-nil, defines the header line format for `ecasound-iam-mode' buffers." - :group 'ecasound - :type 'sexp) - -(defvar ecasound-sending-command nil - "Non-nil if `eci-command' is running.") - -(make-variable-buffer-local - (defvar ecasound-daemon nil - "If non-nil, this variable holds the buffer object of a daemon channel.")) - -(make-variable-buffer-local - (defvar ecasound-parent nil - "If non-nil, this variable holds the buffer object of a daemon parent.")) - -(make-variable-buffer-local - (defvar ecasound-daemon-timer nil)) - -(defvar ecasound-chain-map nil - "Keymap used for Chain operations.") -(define-prefix-command 'ecasound-chain-map) -(define-key 'ecasound-chain-map "a" 'eci-c-add) -(define-key 'ecasound-chain-map "c" 'eci-c-clear) -(define-key 'ecasound-chain-map "d" 'eci-c-deselect) -(define-key 'ecasound-chain-map "m" 'eci-c-mute) -(define-key 'ecasound-chain-map "x" 'eci-c-remove) -(define-key 'ecasound-chain-map (kbd "M-s") 'ecasound-cs-map) -(define-key 'ecasound-chain-map (kbd "M-o") 'ecasound-cop-map) -(defvar ecasound-cop-map nil - "Keymap used for Chain operator operations.") -(define-prefix-command 'ecasound-cop-map) -(define-key 'ecasound-cop-map "a" 'eci-cop-add) -(define-key 'ecasound-cop-map "i" 'eci-cop-select) -(define-key 'ecasound-cop-map "l" 'eci-cop-list) -(define-key 'ecasound-cop-map "s" 'eci-cop-status) -(define-key 'ecasound-cop-map "x" 'eci-cop-remove) -(defvar ecasound-audioin-map nil - "Keymap used for audio input objects.") -(define-prefix-command 'ecasound-audioin-map) -(define-key 'ecasound-audioin-map "a" 'eci-ai-add) -(define-key 'ecasound-audioin-map "f" 'eci-ai-forward) -(define-key 'ecasound-audioin-map "r" 'eci-ai-rewind) -(define-key 'ecasound-audioin-map "x" 'eci-ai-remove) -(defvar ecasound-audioout-map nil - "Keymap used for audio output objects.") -(define-prefix-command 'ecasound-audioout-map) -(define-key 'ecasound-audioout-map "a" 'eci-ao-add) -(define-key 'ecasound-audioout-map "d" 'eci-ao-add-default) -(define-key 'ecasound-audioout-map "f" 'eci-ao-forward) -(define-key 'ecasound-audioout-map "r" 'eci-ao-rewind) -(define-key 'ecasound-audioout-map "x" 'eci-ao-remove) -(defvar ecasound-cs-map nil - "Keymap used for Chainsetup operations.") -(define-prefix-command 'ecasound-cs-map) -(define-key 'ecasound-cs-map "a" 'eci-cs-add) -(define-key 'ecasound-cs-map "c" 'eci-cs-connect) -(define-key 'ecasound-cs-map "d" 'eci-cs-disconnect) -(define-key 'ecasound-cs-map "f" 'eci-cs-forward) -(define-key 'ecasound-cs-map "r" 'eci-cs-rewind) -(define-key 'ecasound-cs-map "t" 'eci-cs-toogle-loop) - -(defvar ecasound-iam-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map comint-mode-map) - (define-key map "\t" 'pcomplete) - (define-key map (kbd "M-c") 'ecasound-chain-map) - (define-key map (kbd "M-i") 'ecasound-audioin-map) - (define-key map (kbd "M-o") 'ecasound-audioout-map) - (define-key map (kbd "M-\"") 'eci-command) - map)) - -(easy-menu-define - ecasound-iam-cs-menu ecasound-iam-mode-map - "Chainsetup menu." - (list "Chainsetup" - ["Add..." eci-cs-add t] - ["Load..." eci-cs-load t] - ["Save" eci-cs-save t] - ["Save As..." eci-cs-save-as t] - ["List" eci-cs-list t] - ["Select" eci-cs-select t] - ["Select via index" eci-cs-index-select t] - "-" - ["Selected" eci-cs-selected t] - ["Valid?" eci-cs-is-valid t] - ["Connect" eci-cs-connect (eci-cs-is-valid-p)] - ["Disconnect" eci-cs-disconnect t] - ["Get position" eci-cs-get-position t] - ["Get length" eci-cs-get-length t] - ["Get length in samples" eci-cs-get-length-samples t] - ["Forward..." eci-cs-forward t] - ["Rewind..." eci-cs-rewind t] - )) -(easy-menu-add ecasound-iam-cs-menu ecasound-iam-mode-map) -(easy-menu-define - ecasound-iam-c-menu ecasound-iam-mode-map - "Chain menu." - (list "Chain" - ["Add..." eci-c-add t] - ["Select..." eci-c-select t] - ["Select All" eci-c-select-all t] - ["Deselect..." eci-c-deselect (> (length (eci-c-selected)) 0)] - ["Selected" eci-c-selected t] - ["Mute" eci-c-mute t] - ["Clear" eci-c-clear t] - )) -(easy-menu-add ecasound-iam-c-menu ecasound-iam-mode-map) -(easy-menu-define - ecasound-iam-cop-menu ecasound-iam-mode-map - "Chain Operator menu." - (list "ChainOp" - ["Add..." eci-cop-add (> (length (eci-c-selected)) 0)] - ["Select..." eci-cop-select t] - ["Edit..." ecasound-cop-edit t] - "-" - ["Select parameter..." eci-copp-select t] - ["Get parameter value" eci-copp-get t] - ["Set parameter value..." eci-copp-set t] - )) -(easy-menu-add ecasound-iam-c-menu ecasound-iam-mode-map) -(easy-menu-define - ecasound-iam-ai-menu ecasound-iam-mode-map - "Audio Input Object menu." - (list "AudioIn" - ["Add..." eci-ai-add (> (length (eci-c-selected)) 0)] - ["List" eci-ai-list t] - ["Select..." eci-ai-select t] - ["Index select..." eci-ai-index-select t] - "-" - ["Attach" eci-ai-attach t] - ["Remove" eci-ai-remove t] - ["Forward..." eci-ai-forward t] - ["Rewind..." eci-ai-rewind t] - )) -(easy-menu-add ecasound-iam-ai-menu ecasound-iam-mode-map) -(easy-menu-define - ecasound-iam-ao-menu ecasound-iam-mode-map - "Audio Output Object menu." - (list "AudioOut" - ["Add..." eci-ao-add (> (length (eci-c-selected)) 0)] - ["Add default" eci-ao-add-default (> (length (eci-c-selected)) 0)] - ["List" eci-ao-list t] - ["Select..." eci-ao-select t] - ["Index select..." eci-ao-index-select t] - "-" - ["Attach" eci-ao-attach t] - ["Remove" eci-ao-remove t] - ["Forward..." eci-ao-forward t] - ["Rewind..." eci-ao-rewind t] - )) -(easy-menu-add ecasound-iam-ao-menu ecasound-iam-mode-map) - -(easy-menu-define - ecasound-menu global-map - "Ecasound menu." - (list "Ecasound" - ["Get session" ecasound t] - "-" - ["Normalize..." ecasound-normalize t] - ["Signalview..." ecasound-signalview t] - "-" - ["Customize startup..." ecasound-customize-startup t] - )) -(easy-menu-add ecasound-menu global-map) - -(make-variable-buffer-local - (defvar ecasound-mode-string nil)) - -(define-derived-mode ecasound-iam-mode comint-mode "EIAM" - "Special mode for ecasound processes in interactive mode." - (set (make-local-variable 'comint-prompt-regexp) - (set (make-local-variable 'paragraph-start) - ecasound-prompt-regexp)) - (add-hook 'comint-output-filter-functions 'ecasound-output-filter nil t) - (add-hook 'comint-input-filter-functions 'eci-input-filter nil t) - (ecasound-iam-setup-pcomplete) - (setq mode-line-format ecasound-mode-line-format)) - -(defun ecasound-mode-line-cop-list (handle) - (let ((list (eci-cop-list handle)) - (sel (1- (eci-cop-selected handle))) - (str "")) - (dotimes (i (length list) str) - (setq str (format "%s%s%s%s" - str - (if (= i sel) "*" "") - (nth i list) - (if (= i (length list)) "" ",")))))) - -(defsubst ecasound-daemon-p () - "Predicate used to determine if there is an active daemon channel." - (and (buffer-live-p ecasound-daemon) - (eq (process-status ecasound-daemon) 'open))) - -(defun ecasound-kill-timer () - "Cancels the background timer. -Use this if you want to stop background information fetching." - (interactive) - (when ecasound-daemon-timer - (cancel-timer ecasound-daemon-timer))) - -(defun ecasound-kill-daemon () - "Terminate the daemon channel." - (interactive) - (ecasound-kill-timer) - (when (ecasound-daemon-p) - (kill-buffer ecasound-daemon))) - -(defun ecasound-update-mode-line (buffer) - (when (and (buffer-live-p buffer) - (get-buffer-window buffer 'visible)) - (unless ecasound-sending-command - (with-current-buffer buffer - (when (ecasound-daemon-p) - (eci-engine-status ecasound-daemon) - (setq ecasound-mode-string - (list - " [" (ecasound-position-to-string - (eci-cs-get-position ecasound-daemon)) - "/" (ecasound-position-to-string - (eci-cs-get-length ecasound-daemon)) - "]" - ) - header-line-format - (list - (eci-cs-selected ecasound-daemon) - " [" (if (eci-cs-is-valid-p ecasound-daemon) - "valid" - "N/A") "]: (" - (mapconcat 'identity (eci-c-list ecasound-daemon) ",") - ") " - (mapconcat 'identity - (eci-c-selected ecasound-daemon) ",")))))))) - -(defun ecasound-setup-timer () - (when (and ecasound-timer-flag (ecasound-daemon-p)) - (setq ecasound-daemon-timer - (run-with-timer - 0 ecasound-timer-interval - 'ecasound-update-mode-line - (current-buffer))))) - -(make-variable-buffer-local - (defvar eci-int-output-mode-wellformed-flag nil - "Indicates if int-output-mode-wellformed was successfully initialized.")) - -(make-variable-buffer-local - (defvar eci-engine-status nil - "If non-nil, a string describing the engine-status.")) - -(make-variable-buffer-local - (defvar eci-cs-selected nil - "If non-nil, a string describing the selected chain setup.")) - -;;;###autoload -(defun ecasound (&optional buffer) - "Run an inferior ecasound, with I/O through BUFFER. -BUFFER defaults to `*ecasound*'. -Interactively, a prefix arg means to prompt for BUFFER. -If BUFFER exists but ecasound process is not running, make new ecasound -process using `ecasound-arguments'. -If BUFFER exists and ecasound process is running, just switch to BUFFER. -The buffer is put in ecasound mode, giving commands for sending input and -completing IAM commands. See `ecasound-iam-mode'. - -\(Type \\[describe-mode] in the ecasound buffer for a list of commands.)" - (interactive - (list - (and current-prefix-arg - (read-buffer "Ecasound buffer: " "*ecasound*")))) - (when (null buffer) - (setq buffer "*ecasound*")) - (if (not (comint-check-proc buffer)) - (pop-to-buffer - (save-excursion - (set-buffer - (apply 'make-comint - "ecasound" - ecasound-program - nil - ecasound-arguments)) - (ecasound-iam-mode) - ;; Flush process output - (while (accept-process-output - (get-buffer-process (current-buffer)) - 1)) - (if (consp ecasound-program) - ;; If we're connecting via tcp/ip, we're most probably connecting - ;; to a daemon-mode ecasound session. - (setq comint-input-sender 'ecasound-network-send - eci-int-output-mode-wellformed-flag t) - (let ((eci-hide-output nil)) - (if (not (eq (eci-command "int-output-mode-wellformed") t)) - (message "Failed to initialize properly")))) - (when (member "--daemon" ecasound-arguments) - (ecasound-setup-daemon)) - (current-buffer))) - (pop-to-buffer buffer))) - -(defun ecasound-setup-daemon () - (let ((cb (current-buffer))) - (if (ecasound-daemon-p) - (error "Ecasound Daemon %S already initialized" ecasound-daemon) - (setq ecasound-daemon - (save-excursion - (set-buffer - (make-comint - "ecasound-daemon" - (cons "localhost" (ecasound-daemon-port)))) - (ecasound-iam-mode) - (setq comint-input-sender 'ecasound-network-send - eci-int-output-mode-wellformed-flag t - ecasound-parent cb) - (set (make-variable-buffer-local 'comint-highlight-prompt) nil) - (setq comint-output-filter-functions '(ecasound-output-filter)) - (current-buffer))) - (if (ecasound-daemon-p) - (progn (add-hook 'kill-buffer 'ecasound-kill-daemon nil t) - (ecasound-setup-timer)) - (message "Ecasound daemon initialisation failed"))))) - -(defun ecasound-delete-last-in-and-output () - "Delete the region of text generated by the last in and output. -This is usually used to hide ECI requests from the user." - (delete-region - (save-excursion (goto-char comint-last-input-end) (forward-line -1) - (unless (looking-at ecasound-prompt-regexp) - (error "Assumed ecasound-prompt")) - (point)) - comint-last-output-start)) - -(make-variable-buffer-local - (defvar eci-last-command nil - "Last command sent to the ecasound process.")) - -(make-variable-buffer-local - (defvar ecasound-last-parse-start nil - "Where to start parsing if output is received. -This marker is advanced everytime a successful parse happens.")) - -(defun eci-input-filter (string) - "Track commands sent to ecasound. -Argument STRING is the input sent." - (when (string-match "^[[:space:]]*\\([a-zA-Z-]+\\)[\n\t ]+" string) - (setq eci-last-command (match-string-no-properties 1 string) - ;; This is a precaution, but it makes sense - ecasound-last-parse-start (point)) - (when (or (string= eci-last-command "quit") - (string= eci-last-command "q")) - ;; Prevents complete hangup, still a bit mysterius - (ecasound-kill-daemon)))) - -(defun ecasound-network-send (proc string) - "Function for sending to PROC input STRING via network." - (comint-send-string proc string) - (comint-send-string proc " \n")) - -(defcustom ecasound-last-command-alist - '(("int-output-mode-wellformed" . - (setq eci-int-output-mode-wellformed-flag t)) - ("int-cmd-list" . - (setq ecasound-iam-commands value)) - ("map-cop-list" . - (setq eci-map-cop-list (eci-process-map-list value))) - ("map-ladspa-list" . - (setq eci-map-ladspa-list (eci-process-map-list value))) - ("map-ctrl-list" . - (setq eci-map-ctrl-list (eci-process-map-list value))) - ("map-preset-list" . - (setq eci-map-preset-list (eci-process-map-list value))) - ("cop-status" . - (eci-process-cop-status value)) - ("engine-status" . - (setq eci-engine-status value)) - ("cs-selected" . - (setq eci-cs-selected value))) - "*Alist of command/expression pairs. -If `ecasound-last-command' is one of the alist keys, the value of that entry -will be evaluated with the variable VALUE bound to the commands -result value." - :group 'ecasound - :type '(alist :key-type (string :tag "Command") - :value-type (sexp :tag "Lisp Expression"))) - -(defcustom ecasound-type-alist - '(("-" . t) - ("i" . (string-to-number value)) - ("li" . (string-to-number value)) - ("f" . (string-to-number value)) - ("s" . value) - ("S" . (split-string value ",")) - ("e" . (progn (run-hook-with-args 'ecasound-error-hook value) nil))) - "*Alist defining ECI type conversion. -Each key is a type, and the values are Lisp expressions. During evaluation -the variables TYPE and VALUE are bound respectively." - :group 'ecasound - :type '(alist :key-type (string :tag "Type") - :value-type (sexp :tag "Lisp Expression"))) - -(defun ecasound-process-result (type value) - "Process ecasound result. -This function is called if `ecasound-output-filter' detected an ECI reply. -Argument TYPE the ECI type as a string and argument VALUE is the value as -a string. -This function uses `ecasound-type-alist' and `ecasound-last-command-alist' -to decide how to transform its arguments." - (let ((tcode (member* type ecasound-type-alist :test 'string= :key 'car)) - (lcode (member* eci-last-command ecasound-last-command-alist - :test 'string= :key 'car))) - (if tcode - (setq value (eval (cdar tcode))) - (error "Return type '%s' not defined in `ecasound-type-alist'" type)) - (setq eci-return-value value - eci-return-type type - eci-result - (if lcode - (eval (cdar lcode)) - value)))) - -(make-variable-buffer-local - (defvar eci-return-type nil - "The return type of the last received return value as a string.")) - -(make-variable-buffer-local - (defvar eci-return-value nil - "The last received return value as a string.")) - -(make-variable-buffer-local - (defvar eci-result nil - "The last received return value as a Lisp Object.")) - -(defun ecasound-output-filter (string) - "Parse ecasound process output. -This function should be used on `comint-output-filter-functions' hook. -STRING is the string originally received and inserted into the buffer." - (let ((start (or ecasound-last-parse-start (point-min))) - (end (process-mark (get-buffer-process (current-buffer))))) - (when (< start end) - (save-excursion - (let (type value (end (copy-marker end))) - (goto-char start) - (while (re-search-forward - "\\([0-9]\\{1,3\\}\\) \\([0-9]\\{1,5\\}\\)\\( \\(.*\\)\\)?\n" - end t) - (let* ((loglevel (string-to-number (match-string 1))) - (msgsize (string-to-number (match-string 2))) - (return-type (match-string-no-properties 4)) - (msg (buffer-substring-no-properties - (point) - (progn - (if (> (- (point-max) (point)) msgsize) - (progn - (forward-char msgsize) - (if (not (save-match-data - (looking-at - "\\(\n\n\\| \n \n\\)"))) - (error "Malformed ECI message") - (point))) - (point-max)))))) - (when (= msgsize (length msg)) - (if (and (= loglevel 256) - (string= return-type "e")) - (add-text-properties - (match-end 0) (point) - (list 'face 'ecasound-error-face))) - (when ecasound-parse-cleanup-buffer - (delete-region (match-beginning 0) (if (= msgsize 0) - (point) - (match-end 0))) - (delete-char 1)) - (setq ecasound-last-parse-start (point)) - (if (not (= loglevel 256)) - (run-hook-with-args 'ecasound-message-hook loglevel msg) - (setq value msg - type (if (string-match "\\(.*\\) " return-type) - (match-string 1 return-type) - return-type)))))) - (when type - (ecasound-process-result type value))))))) - -(defmacro defeci (name &optional args doc &rest body) - "Defines an ECI command. -Argument NAME is used for the function name with eci- as prefix. -Optional argument ARGS specifies the arguments this ECI command has. -Optional argument DOC is the docstring used for the defined function. -BODY can start with keyword arguments to indicated certain special cases. The -following keyword arguments are implemented: - :cache VARNAME The command should try to find a cached version of the result - in VARNAME. - :pcomplete VALUE The command can provide programmable completion. Possible - values are the symbol DOC, which indicates that pcomplete - should echo the docstring of the eci command. Alternatively - you can provide a sexp which is used for the pcomplete - definition." - (let ((sym (intern (format "eci-%S" name))) - (pcmpl-sym (intern (format "pcomplete/ecasound-iam-mode/%S" name))) - (cmd `(eci-command - ,(if args - `(format ,(format "%S %s" - name (mapconcat #'caddr args ",")) - ,@(mapcar - (lambda (arg) - `(if (or (stringp ,(car arg)) - (numberp ,(car arg))) - ,(car arg) - (mapconcat #'identity ,(car arg) ","))) - args)) - (format "%S" name)) - buffer-or-process)) - cache cache-doc pcmpl aliases) - (while (keywordp (car body)) - (case (pop body) - (:cache (setq cache (pop body))) - (:cache-doc (setq cache-doc (pop body))) - (:pcomplete (setq pcmpl (pop body))) - (:alias (setq aliases (pop body))) - (t (pop body)))) - (when (and (not (eq aliases nil)) - (not (consp aliases))) - (setq aliases (list aliases))) - `(progn - ,(if cache - `(make-variable-buffer-local - (defvar ,cache ,@(if cache-doc (list nil cache-doc) (list nil))))) - (defun ,sym - ,(if args (append (mapcar #'car args) `(&optional buffer-or-process)) - `(&optional buffer-or-process)) - ,(if doc doc "") - ,(if args `(interactive - ,(if (let (done) - (mapcar (lambda (x) (when x (setq done t))) - (mapcar #'stringp (mapcar #'cadr args))) - done) - (mapconcat #'identity (mapcar #'cadr args) "\n") - `(list ,@(mapcar #'cadr args)))) - `(interactive)) - ,@(cond - ((and cache (eq body nil)) - `((let ((cached (with-current-buffer - (ecasound-find-buffer buffer-or-process) - ,(or cache (and (ecasound-daemon-p) - (with-current-buffer - ecasound-daemon - ,cache)))))) - (if cached - cached - ,cmd)))) - ((eq body nil) - `(,cmd)) - (t body))) - ,@(mapcar - (lambda (alias) `(defalias ',(intern (format "eci-%S" alias)) - ',sym)) aliases) - ,(when pcmpl - `(progn - ,(if (and (eq pcmpl 'doc) (stringp doc) (not (string= doc ""))) - `(defun ,pcmpl-sym () - (message ,doc) - (throw 'pcompleted t)) - `(defun ,pcmpl-sym () - ,pcmpl)) - ,@(mapcar - (lambda (alias) - `(defalias ',(intern (format "pcomplete/ecasound-iam-mode/%S" alias)) - ',pcmpl-sym)) - aliases)))))) - -(defeci map-cop-list () - "Returns a list of registered chain operators." - :cache eci-map-cop-list - :cache-doc "If non-nil, contains the chainop object map. -It has the form - ((NAME PREFIX DESCR ((ARGNAME DESCR DEFAULT LOW HIGH TYPE) ...)) ...) - -Use `eci-map-cop-list' to fill this variable with data.") - -(defeci map-ctrl-list () - "Returns a list of registered controllers." - :cache eci-map-ctrl-list - :cache-doc "If non-nil, contains the chainop controller object map. -It has the form - ((NAME PREFIX DESCR ((ARGNAME DESCR DEFAULT LOW HIGH TYPE) ...)) ...) - -Use `eci-map-ctrl-list' to fill this list with data.") - -(defeci map-ladspa-list () - "Returns a list of registered LADSPA plugins." - :cache eci-map-ladspa-list - :cache-doc "If non-nil, contains the LADSPA object map. -It has the form - ((NAME PREFIX DESCR ((ARGNAME DESCR DEFAULT LOW HIGH TYPE) ...)) ...) - -Use `eci-map-ladspa-list' to fill this list with data.") - -(defeci map-preset-list () - "Returns a list of registered effect presets." - :cache eci-map-preset-list - :cache-doc "If non-nil, contains the preset object map. -It has the form - ((NAME PREFIX DESCR ((ARGNAME DESCR DEFAULT LOW HIGH TYPE) ...)) ...) - -Use `eci-map-preset-list' to fill this list with data.") - -;;; Ecasound-iam-mode pcomplete functions - -(defun ecasound-iam-setup-pcomplete () - "Setup buffer-local functions for pcomplete in `ecasound-iam-mode'." - (set (make-local-variable 'pcomplete-command-completion-function) - (lambda () - (pcomplete-here (if ecasound-iam-commands - ecasound-iam-commands - (eci-hide-output eci-int-cmd-list))))) - (set (make-local-variable 'pcomplete-command-name-function) - (lambda () - (pcomplete-arg 'first))) - (set (make-local-variable 'pcomplete-parse-arguments-function) - 'ecasound-iam-pcomplete-parse-arguments)) - -(defun ecasound-iam-pcomplete-parse-arguments () - "Parse arguments in the current region. -\" :,\" are considered for splitting." - (let ((begin (save-excursion (comint-bol nil) (point))) - (end (point)) - begins args) - (save-excursion - (goto-char begin) - (while (< (point) end) - (skip-chars-forward " \t\n,:") - (setq begins (cons (point) begins)) - (let ((skip t)) - (while skip - (skip-chars-forward "^ \t\n,:") - (if (eq (char-before) ?\\) - (skip-chars-forward " \t\n,:") - (setq skip nil)))) - (setq args (cons (buffer-substring-no-properties - (car begins) (point)) - args))) - (cons (reverse args) (reverse begins))))) - -(defun ecasound-input-file-or-device () - "Return a list of possible completions for input device name." - (append (delq - nil - (mapcar - (lambda (elt) - (when (string-match - (concat "^" (regexp-quote pcomplete-stub)) elt) - elt)) - (list "alsa" "alsahw" "alsalb" "alsaplugin" - "arts" "loop" "null" "stdin"))) - (pcomplete-entries))) - -;;;; IAM commands - -(defun eci-map-find-args (arg map) - "Return the argument specification for ARG in MAP." - (let (result) - (while map - (if (string= (nth 1 (car map)) arg) - (setq result (nthcdr 3 (car map)) - map nil) - (setq map (cdr map)))) - result)) - -(defun ecasound-echo-arg (arg) - "Display a chain operator parameter description from a eci-map-*-list -variable." - (if arg - (let ((type (nth 5 arg))) - (message "%s%s%s, default %S%s%s" - (car arg) - (if type (format " (%S)" type) "") - (if (and (not (string= (nth 1 arg) "")) - (not (string= (car arg) (nth 1 arg)))) - (format " (%s)" (nth 1 arg)) - "") - (nth 2 arg) - (if (nth 4 arg) (format " min %S" (nth 4 arg)) "") - (if (nth 3 arg) (format " max %S" (nth 3 arg)) ""))) - (message "No help available"))) - - -;;; ECI --- The Ecasound Control Interface - -(defgroup eci nil - "Ecasound Control Interface." - :group 'ecasound) - -(defcustom eci-program (or (getenv "ECASOUND") "ecasound") - "*Program to invoke when doing `eci-init'." - :group 'eci - :type '(choice string (cons string string))) - -(defcustom eci-arguments '("-c" "-D" "-d:256") - "*Arguments used by `eci-init'." - :group 'eci - :type 'ecasound-args) - -(defvar eci-hide-output nil - "If non-nil, `eci-command' will remove the output generated.") - -(defmacro eci-hide-output (&rest eci-call) - "Hide the output of this ECI-call. -If a daemon-channel is active, use that, otherwise set `eci-hide-output' to t. -Argument ECI-CALL is a symbol followed by its aruments if any." - `(if (ecasound-daemon-p) - ,(append eci-call (list 'ecasound-daemon)) - (let ((eci-hide-output t)) - ,eci-call))) - -(defun eci-init () - "Initialize a programmatic ECI session. -Every call to this function results in a new sub-process being created -according to `eci-program' and `eci-arguments'. Returns the newly -created buffer. -The caller is responsible for terminating the subprocess at some point." - (save-excursion - (set-buffer - (apply 'make-comint - "eci-ecasound" - eci-program - nil - eci-arguments)) - (ecasound-iam-mode) - (while (accept-process-output (get-buffer-process (current-buffer)) 1)) - (if (eci-command "int-output-mode-wellformed") - (current-buffer)))) - -(defun eci-interactive-startup () - "Used to interactively startup a ECI session using `eci-init'. -This will mostly be used for testing sessions and is equivalent -to `ecasound'." - (interactive) - (switch-to-buffer (eci-init))) - -(defun ecasound-find-buffer (buffer-or-process) - (cond - ((bufferp buffer-or-process) - buffer-or-process) - ((processp buffer-or-process) - (process-buffer buffer-or-process)) - ((and (eq major-mode 'ecasound-iam-mode) - (comint-check-proc (current-buffer))) - (current-buffer)) - (t (error "Could not determine suitable ecasound buffer")))) - -(defun ecasound-find-parent (buffer-or-process) - (with-current-buffer (ecasound-find-buffer buffer-or-process) - (if ecasound-parent - ecasound-parent - (current-buffer)))) - -(defun eci-command (command &optional buffer-or-process) - "Send a ECI command to a ECI host process. -COMMAND is the string to be sent, without a newline character. -If BUFFER-OR-PROCESS is nil, first look for a ecasound process in the current -buffer, then for a ecasound buffer with the name *ecasound*, -otherwise use the buffer or process supplied. -Return the string we received in reply to the command except -`eci-int-output-mode-wellformed-flag' is set, which means we can parse the -output via `eci-parse' and return a meaningful value." - (interactive "sECI Command: ") - (let* ((buf (ecasound-find-buffer buffer-or-process)) - (proc (get-buffer-process buf)) - (ecasound-sending-command t)) - (with-current-buffer buf - (let ((moving (= (point) (point-max)))) - (setq eci-result 'waiting) - (goto-char (process-mark proc)) - (insert command) - (let (comint-eol-on-send) - (comint-send-input)) - (let ((here (point)) result) - (while (eq eci-result 'waiting) - (accept-process-output proc 0 30)) - (setq result - (if eci-int-output-mode-wellformed-flag - eci-result - ;; Backward compatibility. Just return the string - (buffer-substring-no-properties here (save-excursion - ; Strange hack to avoid fields - (forward-char -1) - (beginning-of-line) - (if (not (= here (point))) - (forward-char -1)) - (point))))) - (if moving (goto-char (point-max))) - (when (and eci-hide-output result) - (ecasound-delete-last-in-and-output)) - result))))) - -(defsubst eci-error-p () - "Predicate which can be used to check if the last command produced an error." - (string= eci-return-type "e")) - -;;; ECI commands implemented as lisp functions - -(defeci int-cmd-list () - "" - :cache ecasound-iam-commands - :cache-doc "Available Ecasound IAM commands.") - -(defeci run) - -(defeci start) - -(defeci cs-add ((chainsetup "sChainsetup to add: " "%s")) - "Adds a new chainsetup with name `name`." - :pcomplete doc) - -(defeci cs-connect () - "Connect currently selected chainsetup to engine." - :pcomplete doc) - -(defeci cs-connected () - "Returns the name of currently connected chainsetup." - :pcomplete doc) - -(defeci cs-disconnect () - "Disconnect currently connected chainsetup." - :pcomplete doc) - -(defeci cs-forward - ((seconds - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (read-minibuffer (format "Time in seconds to forward %s: " - (eci-hide-output eci-cs-selected)))) "%f"))) - -(defeci cs-get-length () - "" - :alias get-length) - -(defeci cs-get-length-samples () - "" - :alias get-length-samples) - -(defeci cs-get-position () - "" - :alias (cs-getpos getpos get-position)) - -(defeci cs-index-select ((index "nChainsetup index: " "%d")) - "" - :alias cs-iselect) - -(defeci cs-is-valid () - "Whether currently selected chainsetup is valid (=can be connected)?" - :pcomplete doc - (let ((val (eci-command "cs-is-valid" buffer-or-process))) - (if (interactive-p) - (message (format "Chainsetup is%s valid" (if (= val 0) "" " not")))) - val)) - -(defun eci-cs-is-valid-p (&optional buffer-or-process) - "Predicate function used to determine chain setup validity." - (case (eci-cs-is-valid buffer-or-process) - (1 t) - (0 nil) - (otherwise (error "Unexcpected return value from cs-is-valid")))) - -(defeci cs-list () - "Returns a list of all chainsetups." - :pcomplete doc - (let ((val (eci-command "cs-list" buffer-or-process))) - (if (interactive-p) - (message (concat "Available chainsetups: " - (mapconcat #'identity val ", ")))) - val)) - -(defeci cs-load ((filename "fChainsetup filename: " "%s")) - "Adds a new chainsetup by loading it from file FILENAME. -FILENAME is then the selected chainsetup." - :pcomplete (pcomplete-here (pcomplete-entries))) - -(defeci cs-remove () - "Removes currently selected chainsetup." - :pcomplete doc) - -(defeci cs-rewind - ((seconds - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (read-minibuffer "Time in seconds to rewind chainsetup: ")) "%f")) - "Rewinds the current chainsetup position by `time-in-seconds` seconds." - :pcomplete doc - :alias (rewind rw)) - -(defeci cs-save) - -(defeci cs-save-as ((filename "FChainsetup filename: " "%s")) - "Saves currently selected chainsetup to file FILENAME." - :pcomplete (pcomplete-here (pcomplete-entries))) - -(defeci cs-selected () - "Returns the name of currently selected chainsetup." - :pcomplete doc - (let ((val (with-current-buffer (ecasound-find-parent buffer-or-process) - (setq eci-cs-selected (eci-command "cs-selected" - buffer-or-process))))) - (if (interactive-p) - (message (format "Selected chainsetup: %s" val))) - val)) - -(defeci cs-status) - -(defeci c-add ((chains "sChain(s) to add: " "%s")) - "Adds a set of chains. Added chains are automatically selected. -If argument CHAINS is a list, its elements are concatenated with ','.") - -(defeci c-clear () - "Clear selected chains by removing all chain operators and controllers. -Doesn't change how chains are connected to inputs and outputs." - :pcomplete doc) - -(defun ecasound-read-list (prompt list) - "Interactively prompt for a number of inputs until empty string. -PROMPT is used as prompt and LIST is a list of choices to choose from." - (let ((avail list) - result current) - (while - (and avail - (not - (string= - (setq current (completing-read prompt (mapcar #'list avail))) - ""))) - (setq result (cons current result) - avail (delete current avail))) - (nreverse result))) - -(defeci c-deselect - ((chains (ecasound-read-list "Chain to deselect: " (eci-c-selected)) "%s")) - "Deselects chains." - :pcomplete (while (pcomplete-here (eci-c-selected)))) - -(defeci c-list () - "Returns a list of all chains.") - -(defeci c-mute () - "Toggle chain muting. When chain is muted, all data that goes -through is muted." - :pcomplete doc) - -(defeci c-select ((chains (ecasound-read-list "Chain: " (eci-c-list)) "%s")) - "Selects chains. Other chains are automatically deselected." - :pcomplete doc) - -(defeci c-selected () - "" - (let ((val (eci-command "c-selected" buffer-or-process))) - (if (interactive-p) - (if (null val) - (message "No selected chains") - (message (concat "Selected chains: " - (mapconcat #'identity val ", "))))) - val)) - -(defeci c-select-all () - "Selects all chains." - :pcomplete doc) - -(defeci cs-select - ((chainsetup - (completing-read "Chainsetup: " (mapcar #'list (eci-cs-list))) - "%s")) - "" - :pcomplete (pcomplete-here (eci-hide-output eci-cs-list))) - -(defeci ai-add - ((ifstring - (let ((file (read-file-name "Input filename: "))) - (if (file-exists-p file) - (expand-file-name file) - file)) - "%s")) - "Adds a new input object." - :pcomplete (pcomplete-here (ecasound-input-file-or-device))) - -(defeci ai-attach () - "Attaches the currently selected audio input object to all selected chains." - :pcomplete doc) - -(defeci ai-forward - ((seconds - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (read-minibuffer (format "Time in seconds to forward %s: " - (eci-hide-output eci-ai-selected)))) "%f")) - "Selected audio input object is forwarded by SECONDS. -Time should be given as a floating point value (eg. 0.001 is the same as 1ms)." - :pcomplete doc - :alias ai-fw) - -(defeci ai-rewind - ((seconds - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (read-minibuffer (format "Time in seconds to rewind %s: " - (eci-hide-output eci-ai-selected)))) "%f")) - "Selected audio input object is rewinded by SECONDS. -Time should be given as a floating point value (eg. 0.001 is the same as 1ms)." - :pcomplete doc - :alias ai-rw) - -(defeci ai-index-select ((index "nAudio Input index: " "%d")) - "Select some audio input object based on a short index. -Especially file names can be rather long. This command can be used to avoid -typing these long names when selecting audio objects. -INDEX is an integer value, where 1 refers to the first audio input. -You can use `eci-ai-list' to get a full list of currently available inputs." - :pcomplete doc - :alias ai-iselect) - -(defeci ai-list) - -(defeci ai-remove () - "Removes the currently selected audio input object from the chainsetup." - :pcomplete doc) -(defeci ao-remove () - "Removes the currently selected audio output object from the chainsetup." - :pcomplete doc) - -(defeci ai-select ((name "sAudio Input Object name: " "%s")) - "Selects an audio object. -NAME refers to the string used when creating the object. Note! All input -object names are required to be unique. Similarly all output names need to be -unique. However, it's possible that the same object name exists both as an -input and as an output." - :pcomplete (pcomplete-here (eci-hide-output eci-ai-list))) - -(defeci ai-selected () - "Returns the name of the currently selected audio input object." - :pcomplete doc) - -(defeci ao-add ((filename "FOutput filename: " "%s")) - "" - :pcomplete (pcomplete-here (ecasound-input-file-or-device))) - -(defeci ao-add-default) - -(defeci ao-attach () - "Attaches the currently selected audio output object to all selected chains." - :pcomplete doc) - -(defeci ao-forward - ((seconds - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (read-minibuffer (format "Time in seconds to forward %s: " - (eci-hide-output eci-ao-selected)))) "%f")) - "Selected audio output object is forwarded by SECONDS. -Time should be given as a floating point value (eg. 0.001 is the same as 1ms)." - :pcomplete doc - :alias ao-fw) - -(defeci ao-index-select ((index "nAudio Output index: " "%d")) - "Select some audio output object based on a short index. -Especially file names can be rather long. This command can be used to avoid -typing these long names when selecting audio objects. -INDEX is an integer value, where 1 refers to the first audio output. -You can use `eci-ao-list' to get a full list of currently available outputs." - :pcomplete doc - :alias ao-iselect) - -(defeci ao-list) - -(defeci ao-rewind - ((seconds - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (read-minibuffer (format "Time in seconds to rewind %s: " - (eci-hide-output eci-ai-selected)))) "%f")) - "Selected audio output object is rewinded by SECONDS. -Time should be given as a floating point value (eg. 0.001 is the same as 1ms)." - :pcomplete doc - :alias ai-rw) - -(defeci ao-select ((name "sAudio Output Object name: " "%s")) - "Selects an audio object. -NAME refers to the string used when creating the object. Note! All output -object names need to be unique. However, it's possible that the same object -name exists both as an input and as an output." - :pcomplete (pcomplete-here (eci-hide-output eci-ao-list))) - -(defeci ao-selected () - "Returns the name of the currently selected audio output object." - :pcomplete doc) - -(defeci engine-status () - "Returns a string describing the engine status -\(running, stopped, finished, error, not ready)." - :pcomplete doc - (with-current-buffer (ecasound-find-parent buffer-or-process) - (setq eci-engine-status (eci-command "engine-status" buffer-or-process)))) - -(defmacro ecasound-complete-cop-map (map) - (let ((m (intern (format "eci-map-%S-list" map)))) - `(progn - (cond - ((= pcomplete-last 2) - (pcomplete-next-arg) - (pcomplete-here - (sort (mapcar (lambda (elt) (nth 1 elt)) - (eci-hide-output ,m)) - #'string-lessp))) - ((> pcomplete-last 2) - (ecasound-echo-arg - (nth (- pcomplete-last 3) - (eci-map-find-args - (pcomplete-arg -1) (eci-hide-output ,m))))))))) - -(defeci cop-add - ((string - (if current-prefix-arg - (read-string "Chainop to add: " "-") - (let* ((cop - (completing-read - "Chain operator: " - (append (eci-hide-output eci-map-cop-list) - (eci-hide-output eci-map-ladspa-list) - (eci-hide-output eci-map-preset-list)))) - (entry (or (assoc cop (eci-map-cop-list)) - (assoc cop (eci-map-ladspa-list)) - (assoc cop (eci-map-preset-list)))) - (arg (nth 1 entry))) - (concat - (cond - ((assoc cop (eci-map-cop-list)) - (concat "-" arg ":")) - ((assoc cop (eci-map-ladspa-list)) - (concat "-el:" arg ",")) - ((assoc cop (eci-map-preset-list)) - (concat "-pn:" arg ","))) - (mapconcat #'ecasound-read-copp (nthcdr 3 entry) ",")))) - "%s")) - "" - :pcomplete - (progn - (cond - ((= pcomplete-last 1) - (pcomplete-here - (append - '("-el:" "-pn:") - (mapcar - (lambda (elt) - (concat "-" (nth 1 elt) ":")) - (eci-hide-output eci-map-cop-list))))) - ((string= (pcomplete-arg) "-el") - (ecasound-complete-cop-map ladspa)) - ((string= (pcomplete-arg) "-pn") - (ecasound-complete-cop-map preset)) - ((> pcomplete-last 1) - (ecasound-echo-arg - (nth (- pcomplete-last 2) - (eci-map-find-args - (substring (pcomplete-arg) 1) - (eci-hide-output eci-map-cop-list)))))) - (throw 'pcompleted t))) - -(defeci cop-list) - -(defeci cop-remove) - -(defeci cop-select - ((index "nChainop to select: " "%d"))) - -(defeci cop-selected) - -;; FIXME: Command seems to be broken in CVS. -(defeci cop-set ((cop "nChainop id: " "%d") - (copp "nParameter id: " "%d") - (value "nValue: " "%f")) - "Changes the value of a single chain operator parameter. -Unlike other chain operator commands, this can also be used during processing." - :pcomplete doc) - -(defeci ctrl-add - ((string - (if current-prefix-arg - (read-string "Controller to add: " "-") - (let ((ctrl (assoc - (completing-read - "Chain operator controller controller: " - (eci-hide-output eci-map-ctrl-list)) - (eci-hide-output eci-map-ctrl-list)))) - (concat "-" (nth 1 ctrl) ":" - (mapconcat #'ecasound-read-copp (nthcdr 3 ctrl) ",")))) - "%s"))) - -(defeci ctrl-select - ((index "nController to select: " "%d"))) - -(defeci copp-select - ((index "nChainop parameter to select: " "%d"))) - -(defeci copp-get) - -(defeci copp-set - ((value "nValue for Chain operator parameter: " "%f"))) - -;;;; ECI Examples - -(defun eci-example () - "Implements the example given in the ECI documentation." - (interactive) - (save-current-buffer - (set-buffer (eci-init)) - (display-buffer (current-buffer)) - (eci-cs-add "play_chainsetup") - (eci-c-add "1st_chain") - (call-interactively #'eci-ai-add) - (eci-ao-add "/dev/dsp") - (eci-cop-add "-efl:100") - (eci-cop-select 1) (eci-copp-select 1) - (eci-cs-connect) - (eci-command "start") - (sit-for 1) - (while (and (string= (eci-engine-status) "running") - (< (eci-get-position) 15)) - (eci-copp-set (+ (eci-copp-get) 500)) - (sit-for 1)) - (eci-command "stop") - (eci-cs-disconnect) - (message (concat "Chain operator status: " - (eci-command "cop-status"))))) - -(defun eci-make-temp-file-name (suffix) - (concat (make-temp-name - (expand-file-name "emacs-eci" temporary-file-directory)) - suffix)) - -(defun ecasound-read-from-minibuffer (prompt default) - (let ((result (read-from-minibuffer - (format "%s (default %S): " prompt default) - nil nil nil nil default))) - (if (and result (not (string= result ""))) - result - default))) - -(defconst ecasound-signalview-clipped-threshold (- 1.0 (/ 1.0 16384))) - -(defconst ecasound-signalview-bar-length 55) - -(defun ecasound-position-to-string (secs &optional long) - "Convert a floating point position value in SECS to a string. -If optional argument LONG is non-nil, produce a full 00:00.00 string, -otherwise ignore zeors as well as colons and dots on the left side." - (let ((str (format "%02d:%02d.%02d" - (/ secs 60) - (% (round (floor secs)) 60) - (* (- secs (floor secs)) 100)))) - (if long - str - (let ((idx 0) (len (1- (length str)))) - (while (and (< idx len) - (let ((ch (aref str idx))) - (or (eq ch ?0) (eq ch ?:) (eq ch ?.)))) - (incf idx)) - (substring str idx))))) - -(defun ecasound-signalview (bufsize format input output) - "Interactively view the singal of a audio stream. -After invokation, this function displays the signal level of the individual -channels in INPUT based on the information given in FORMAT." - (interactive - (list - (ecasound-read-from-minibuffer "Buffersize" "128") - (ecasound-read-from-minibuffer "Format" "s16_le,2,44100,i") - (let ((file (read-file-name "Input: "))) - (if (file-exists-p file) - (expand-file-name file) - file)) - (ecasound-read-from-minibuffer "Output" "null"))) - (let* (;; THis saves time - (ecasound-parse-cleanup-buffer nil) - (handle (eci-init)) - (channels (string-to-number (nth 1 (split-string format ",")))) - (chinfo (make-vector channels nil))) - (dotimes (ch channels) (aset chinfo ch (cons 0 0))) - (eci-cs-add "signalview" handle) - (eci-c-add "analysis" handle) - (eci-cs-set-audio-format format handle) - (eci-ai-add input handle) - (eci-ao-add output handle) - (eci-cop-add "-evp" handle) - (eci-cop-add "-ev" handle) - (set-buffer (get-buffer-create "*Ecasound-signalview*")) - (erase-buffer) - (dotimes (ch channels) - (insert "---\n")) - (setq header-line-format - (list (concat "Channel#" - (make-string (- ecasound-signalview-bar-length 3) 32) - "| max-value clipped"))) - (set (make-variable-buffer-local 'ecasignalview-position) "unknown") - (set (make-variable-buffer-local 'ecasignalview-engine-status) "unknown") - (setq mode-line-format - (list - (list - (- ecasound-signalview-bar-length 3) - (format "Input: %s, output: %s" input output) - 'ecasignalview-engine-status) - " | " 'ecasignalview-position)) - (switch-to-buffer-other-window (current-buffer)) - (eci-cs-connect handle) - (eci-start handle) - (sit-for 0.8) - (eci-cop-select 1 handle) - (while (string= (setq ecasignalview-engine-status - (eci-engine-status handle)) "running") - (let ((inhibit-quit t) (inhibit-redisplay t)) - (setq ecasignalview-position - (ecasound-position-to-string (eci-cs-get-position handle) t)) - (delete-region (point-min) (point-max)) - (dotimes (ch channels) - (insert (format "ch%d: " (1+ ch))) - (let ((val (progn (eci-copp-select (1+ ch) handle) - (eci-copp-get handle))) - (bl ecasound-signalview-bar-length)) - (insert - (concat - (make-string (round (* val bl)) ?*) - (make-string (- bl (round (* val bl))) ? ))) - (if (> val (car (aref chinfo ch))) - (setcar (aref chinfo ch) val)) - (if (> val ecasound-signalview-clipped-threshold) - (incf (cdr (aref chinfo ch)))) - (insert (format "| %.4f %d\n" (car (aref chinfo ch)) - (cdr (aref chinfo ch)))))) - (goto-char (point-min))) - (sit-for 0.1) - (fit-window-to-buffer)) - (goto-char (point-max)) - (let ((pos (point))) - (insert - (nth 2 - (nth 2 - (nthcdr 2 - (assoc "Volume analysis" - (assoc "analysis" - (eci-cop-status handle))))))) - (goto-char pos)) - (recenter channels) - (fit-window-to-buffer))) - -(defun ecasound-normalize (filename) - "Normalize a audio file using ECI." - (interactive "fFile to normalize: ") - (let ((tmpfile (eci-make-temp-file-name ".wav"))) - (unwind-protect - (with-current-buffer (eci-init) - (display-buffer (current-buffer)) (sit-for 1) - (eci-cs-add "analyze") (eci-c-add "1") - (eci-ai-add filename) (eci-ao-add tmpfile) - (eci-cop-add "-ev") - (message "Analyzing sample data...") - (eci-cs-connect) (eci-run) - (eci-cop-select 1) (eci-copp-select 2) - (let ((gainfactor (eci-copp-get))) - (eci-cs-disconnect) - (if (<= gainfactor 1) - (message "File already normalized!") - (eci-cs-add "apply") (eci-c-add "1") - (eci-ai-add tmpfile) (eci-ao-add filename) - (eci-cop-add "-ea:100") - (eci-cop-select 1) - (eci-copp-select 1) - (eci-copp-set (* gainfactor 100)) - (eci-cs-connect) (eci-run) (eci-cs-disconnect) - (message "Done")))) - (if (file-exists-p tmpfile) - (delete-file tmpfile))))) - -;;; Utility functions for converting strings to data-structures. - -(defvar eci-cop-status-header - "### Chain operator status (chainsetup '\\([^']+\\)') ###\n") - -(defun eci-process-cop-status (string) - (with-temp-buffer - (insert string) (goto-char (point-min)) - (when (re-search-forward eci-cop-status-header nil t) - (let (result) - (while (re-search-forward "Chain \"\\([^\"]+\\)\":\n" nil t) - (let ((c (match-string-no-properties 1)) chain) - (while (re-search-forward - "\t\\([0-9]+\\)\\. \\(.+\\): \\(.*\\)\n?" nil t) - (let ((n (string-to-number (match-string 1))) - (name (match-string-no-properties 2)) - (args - (mapcar - (lambda (elt) - (when (string-match - "\\[\\([0-9]+\\)\\] \\(.*\\) \\([0-9.-]+\\)$" - elt) - (list (match-string-no-properties 2 elt) - (string-to-number (match-string 1 elt)) - (string-to-number (match-string 3 elt))))) - (split-string - (match-string-no-properties 3) ", ")))) - (if (looking-at "\tStatus info:\n") - (setq args - (append - args - (list - (list - "Status info" nil - (buffer-substring - (progn (forward-line 1) (point)) - (or (re-search-forward "\n\n" nil t) - (point-max)))))))) - (setq chain (cons (append (list name n) args) chain)))) - (setq result (cons (reverse (append chain (list c))) result)))) - result)))) - -(defun eci-process-map-list (string) - "Parse the output of a map-xxx-list ECI command and return an alist. -STRING is the string returned by a map-xxx-list command." - (mapcar - (lambda (elt) - (append - (list (nth 1 elt) (nth 0 elt) (nth 2 elt)) - (let (res (count (string-to-number (nth 3 elt)))) - (setq elt (nthcdr 4 elt)) - (while (> count 0) - (setq - res - (cons - (list (nth 0 elt) (nth 1 elt) - (string-to-number (nth 2 elt)) ;; default value - (when (string= (nth 3 elt) "1") - (string-to-number (nth 4 elt))) - (when (string= (nth 5 elt) "1") - (string-to-number (nth 6 elt))) - (cond - ((string= (nth 7 elt) "1") - 'toggle) - ((string= (nth 8 elt) "1") - 'integer) - ((string= (nth 9 elt) "1") - 'logarithmic) - ((string= (nth 10 elt) "1") - 'output))) res) - elt (nthcdr 11 elt) - count (1- count))) - (reverse res)))) - (mapcar (lambda (str) (split-string str ",")) - (split-string string "\n")))) - -(defeci cs-set-audio-format - ((format (ecasound-read-from-minibuffer - "Audio format" "s16_le,2,44100,i") "%s")) - "Set the default sample parameters for currently selected chainsetup. -For example cd-quality audio would be \"16,2,44100\"." - :pcomplete doc) - -(defeci cop-register) -(defeci preset-register) -(defeci ctrl-register) - -(defeci cop-status) - -(defeci ladspa-register) - -(defun ecasound-read-copp (copp) - "Interactively read one chainop parameter." - (let* ((completion-ignore-case t) - (default (format "%S" (nth 2 copp))) - (answer - (read-from-minibuffer - (concat - (car copp) - " (default " default "): ") - nil nil nil nil - default))) - (if (and answer (not (string= answer ""))) - answer - default))) - -;;; ChainOp Editor - -(defvar ecasound-cop-edit-mode-map - (let ((map (make-keymap))) - (set-keymap-parent map widget-keymap) - map)) - -(define-derived-mode ecasound-cop-edit-mode fundamental-mode "COP-edit" - "A major mode for editing ecasound chain operators.") - -(defun ecasound-cop-edit () - "Edit the chain operator settings of the current session interactively. -This is done using the ecasound-cop widget." - (interactive) - (let ((cb (current-buffer)) - (chains (eci-cop-status))) - (switch-to-buffer-other-window (generate-new-buffer "*cop-edit*")) - (ecasound-cop-edit-mode) - (mapc - (lambda (chain) - (widget-insert (format "Chain %s:\n" (car chain))) - (mapc - (lambda (cop) - (apply 'widget-create 'ecasound-cop :buffer cb cop)) - (cdr chain))) - chains) - (widget-setup) - (goto-char (point-min)))) - -(define-widget 'ecasound-cop 'default - "A Chain Operator. -:children is a list of ecasound-copp widgets." - :convert-widget - (lambda (widget) - (let ((args (widget-get widget :args))) - (when args - (widget-put widget :tag (car args)) - (widget-put widget :cop-number (nth 1 args)) - (widget-put widget :args (cddr args)))) - widget) - :value-create - (lambda (widget) - (widget-put - widget :children - (mapcar - (lambda (copp-arg) - (apply 'widget-create-child-and-convert - widget '(ecasound-copp) copp-arg)) - (widget-get widget :args)))) - :format-handler - (lambda (widget escape) - (cond - ((eq escape ?i) - (widget-put - widget :cop-select - (widget-create-child-value - widget '(ecasound-cop-select) (widget-get widget :cop-number)))))) - :format "%i %t\n%v") - -(define-widget 'ecasound-cop-select 'link - "Select this chain operator parameter." - :help-echo "RET to select." - :button-prefix "" - :button-suffix "" - :format "%[%v.%]" - :action - (lambda (widget &rest ignore) - (let ((buffer (widget-get (widget-get widget :parent) :buffer))) - (eci-cop-select (widget-value widget) buffer)))) - -;;;; A Chain Operator Parameter Widget. - -; This is used as a component of the cop widget. - -(define-widget 'ecasound-copp 'number - "A Chain operator parameter." - :action 'ecasound-copp-action - :convert-widget 'ecasound-copp-convert - :format " %i %v (%t)\n" - :format-handler 'ecasound-copp-format-handler - :size 10) - -(defun ecasound-copp-convert (widget) - "Convert args." - (let ((args (widget-get widget :args))) - (when args - (widget-put widget :tag (car args)) - (widget-put widget :copp-number (nth 1 args)) - (widget-put widget :value (nth 2 args)) - (widget-put widget :args nil))) - widget) - -(defun ecasound-copp-format-handler (widget escape) - (cond - ((eq escape ?i) - (widget-put - widget - :copp-select - (widget-create-child-value - widget - '(ecasound-copp-select) - (widget-get widget :copp-number)))) - ((eq escape ?s) - (widget-put - widget - :slider - (widget-create-child-value - widget - '(slider) - (string-to-number (widget-get widget :value))))))) - -(defun ecasound-copp-action (widget &rest ignore) - "Sets WIDGETs value in its associated ecasound buffer." - (let ((buffer (widget-get (widget-get widget :parent) :buffer))) - (if (widget-apply widget :match (widget-value widget)) - (progn - (eci-cop-set (widget-get (widget-get widget :parent) :cop-number) - (widget-get widget :copp-number) - (widget-value widget) - buffer)) - (message "Invalid")))) - -(defvar ecasound-copp-select-keymap - (let ((map (copy-keymap widget-keymap))) - (define-key map "+" 'ecasound-copp-increase) - (define-key map "-" 'ecasound-copp-decrease) - map) - "Keymap used inside an copp.") - -(defun ecasound-copp-increase (pos &optional event) - (interactive "@d") - ;; BUG, if we do this, the field is suddently no longer editable, why??? - (let ((widget (widget-get (widget-at pos) :parent))) - (widget-value-set - widget - (+ (widget-value widget) 1)) - (widget-apply widget :action) - (widget-setup))) - -(defun ecasound-copp-decrease (pos &optional event) - (interactive "@d") - (let ((widget (widget-get (widget-at pos) :parent))) - (widget-value-set - widget - (- (widget-value widget) 1)) - (widget-apply widget :action) - (widget-setup))) - -(define-widget 'ecasound-copp-select 'link - "Select this chain operator parameter." - :help-echo "RET to select, +/- to set in steps." - :keymap ecasound-copp-select-keymap - :format "%[%v%]" - :action 'ecasound-copp-select-action) - -(defun ecasound-copp-select-action (widget &rest ignore) - "Selects WIDGET in its associated ecasound buffer." - (let ((buffer (widget-get (widget-get (widget-get widget :parent) :parent) - :buffer))) - (eci-copp-select (widget-get widget :value) buffer))) - -(define-widget 'slider 'default - "A slider." - :action 'widget-slider-action - :button-prefix "" - :button-suffix "" - :format "(%[%v%])" - :keymap - (let ((map (copy-keymap widget-keymap))) - (define-key map "\C-m" 'widget-slider-press) - (define-key map "+" 'widget-slider-increase) - (define-key map "-" 'widget-slider-decrease) - map) - :value-create 'widget-slider-value-create - :value-delete 'ignore - :value-get 'widget-value-value-get - :size 70 - :value 0) - -(defun widget-slider-press (pos &optional event) - "Invoke slider at POS." - (interactive "@d") - (let ((button (get-char-property pos 'button))) - (if button - (widget-apply-action - (widget-value-set - button - (- pos (overlay-start (widget-get button :button-overlay)))) - event) - (let ((command (lookup-key widget-global-map (this-command-keys)))) - (when (commandp command) - (call-interactively command)))))) - -(defun widget-slider-increase (pos &optional event) - "Increase slider at POS." - (interactive "@d") - (widget-slider-change pos #'+ 1 event)) - -(defun widget-slider-decrease (pos &optional event) - "Decrease slider at POS." - (interactive "@d") - (widget-slider-change pos #'- 1 event)) - -(defun widget-slider-change (pos function value &optional event) - "Change slider at POS by applying FUNCTION to old-value and VALUE." - (let ((button (get-char-property pos 'button))) - (if button - (widget-apply-action - (widget-value-set button (apply function (widget-value button) value)) - event) - (let ((command (lookup-key widget-global-map (this-command-keys)))) - (when (commandp command) - (call-interactively command)))))) - -(defun widget-slider-action (widget &rest ignore) - "Set the current :parent value to :value." - (widget-value-set (widget-get widget :parent) - (widget-value widget))) - -(defun widget-slider-value-create (widget) - "Create a sliders value." - (let ((size (widget-get widget :size)) - (value (string-to-int (format "%.0f" (widget-get widget :value)))) - (from (point))) - (insert-char ?\ value) - (insert-char ?\| 1) - (insert-char ?\ (- size value 1)))) - - -;;; Ecasound .ewf major mode - -(defgroup ecasound-ewf nil - "Ecasound .ewf file mode related variables and faces." - :prefix "ecasound-ewf-" - :group 'ecasound) - -(defcustom ecasound-ewf-output-device "/dev/dsp" - "*Default output device used for playing .ewf files." - :group 'ecasound-ewf - :type 'string) - -(defface ecasound-ewf-keyword-face '((t (:foreground "IndianRed"))) - "The face used for highlighting keywords." - :group 'ecasound-ewf) - -(defface ecasound-ewf-time-face '((t (:foreground "Cyan"))) - "The face used for highlighting time information." - :group 'ecasound-ewf) - -(defface ecasound-ewf-file-face '((t (:foreground "Green"))) - "The face used for highlighting the filname." - :group 'ecasound-ewf) - -(defface ecasound-ewf-boolean-face '((t (:foreground "Orange"))) - "The face used for highlighting boolean values." - :group 'ecasound-ewf) - -(defvar ecasound-ewf-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\t" 'pcomplete) - (define-key map "\C-c\C-p" 'ecasound-ewf-play) - map) - "Keymap for `ecasound-ewf-mode'.") - -(defvar ecasound-ewf-mode-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?# "<" st) - (modify-syntax-entry ?\n ">" st) - st) - "Syntax table for `ecasound-ewf-mode'.") - -(defvar ecasound-ewf-font-lock-keywords - '(("^\\s-*\\(source\\)[^=]+=\\s-*\\(.*\\)$" - (1 'ecasound-ewf-keyword-face) - (2 'ecasound-ewf-file-face)) - ("^\\s-*\\(offset\\)[^=]+=\\s-*\\([0-9.]+\\)$" - (1 'ecasound-ewf-keyword-face) - (2 'ecasound-ewf-time-face)) - ("^\\s-*\\(start-position\\)[^=]+=\\s-*\\([0-9.]+\\)$" - (1 'ecasound-ewf-keyword-face) - (2 'ecasound-ewf-time-face)) - ("^\\s-*\\(length\\)[^=]+=\\s-*\\([0-9.]+\\)$" - (1 'ecasound-ewf-keyword-face) - (2 'ecasound-ewf-time-face)) - ("^\\s-*\\(looping\\)[^=]+=\\s-*\\(true\\|false\\)$" - (1 'ecasound-ewf-keyword-face) - (2 'ecasound-ewf-boolean-face))) - "Keyword highlighting specification for `ecasound-ewf-mode'.") - -;;;###autoload -(define-derived-mode ecasound-ewf-mode fundamental-mode "EWF" - "A major mode for editing ecasound .ewf files." - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-start-skip) "#+\\s-*") - (set (make-local-variable 'font-lock-defaults) - '(ecasound-ewf-font-lock-keywords)) - (ecasound-ewf-setup-pcomplete)) - -;;; .ewf-mode pcomplete support - -(defun ecasound-ewf-keyword-completion-function () - (pcomplete-here - (list "source" "offset" "start-position" "length" "looping"))) - -(defun pcomplete/ecasound-ewf-mode/source () - (pcomplete-here (pcomplete-entries))) - -(defun pcomplete/ecasound-ewf-mode/offset () - (message "insert audio object at offset (seconds) [read,write]") - (throw 'pcompleted t)) - -(defun pcomplete/ecasound-ewf-mode/start-position () - (message "start offset inside audio object (seconds) [read]") - (throw 'pcompleted t)) - -(defun pcomplete/ecasound-ewf-mode/length () - (message "how much of audio object data is used (seconds) [read]") - (throw 'pcompleted t)) - -(defun pcomplete/ecasound-ewf-mode/looping () - (pcomplete-here (list "true" "false"))) - -(defun ecasound-ewf-parse-arguments () - "Parse whitespace separated arguments in the current region." - (let ((begin (save-excursion (beginning-of-line) (point))) - (end (point)) - begins args) - (save-excursion - (goto-char begin) - (while (< (point) end) - (skip-chars-forward " \t\n=") - (setq begins (cons (point) begins)) - (let ((skip t)) - (while skip - (skip-chars-forward "^ \t\n=") - (if (eq (char-before) ?\\) - (skip-chars-forward " \t\n=") - (setq skip nil)))) - (setq args (cons (buffer-substring-no-properties - (car begins) (point)) - args))) - (cons (reverse args) (reverse begins))))) - -(defun ecasound-ewf-setup-pcomplete () - (set (make-local-variable 'pcomplete-parse-arguments-function) - 'ecasound-ewf-parse-arguments) - (set (make-local-variable 'pcomplete-command-completion-function) - 'ecasound-ewf-keyword-completion-function) - (set (make-local-variable 'pcomplete-command-name-function) - (lambda () - (pcomplete-arg 'first))) - (set (make-local-variable 'pcomplete-arg-quote-list) - (list ? ))) - -;;; Interactive commands - -;; FIXME: Make it use ECI. -(defun ecasound-ewf-play () - (interactive) - (let ((ecasound-arguments (list "-c" - "-i" buffer-file-name - "-o" ecasound-ewf-output-device))) - (and (buffer-modified-p) - (y-or-n-p "Save file before playing? ") - (save-buffer)) - (ecasound "*Ecasound-ewf Player*"))) - -(add-to-list 'auto-mode-alist (cons "\\.ewf$" 'ecasound-ewf-mode)) - -;; Local variables: -;; mode: outline-minor -;; outline-regexp: ";;;;* \\|" -;; End: - -(provide 'ecasound) - -;;; ecasound.el ends here - diff --git a/emacs_el/emacs-wiki.el b/emacs_el/emacs-wiki.el deleted file mode 100644 index 99a7ef2..0000000 --- a/emacs_el/emacs-wiki.el +++ /dev/null @@ -1,3930 +0,0 @@ -;;; emacs-wiki.el --- Maintain a local Wiki using Emacs-friendly markup - -;; Copyright (C) 2001, 2002, 2003 John Wiegley (johnw AT gnu DOT org) - -;; Emacs Lisp Archive Entry -;; Filename: emacs-wiki.el -;; Version: 2.40 -;; Date: Sun 24-Nov-2002 -;; Keywords: hypermedia -;; Author: John Wiegley (johnw AT gnu DOT org) -;; Alex Schroeder (alex AT gnu DOT org) -;; Maintainer: Damien Elmes (emacswiki AT repose DOT cx) -;; Description: Maintain Emacs-friendly Wikis in a local directory -;; URL: http://repose.cx/emacs/wiki -;; Compatibility: Emacs20, Emacs21, XEmacs21 - -;; This file is not part of GNU Emacs. - -;; The canonical URL for this file is now: -;; http://repose.cx/emacs/wiki -;; Older copies and other modules which use emacs-wiki can be found at the -;; original author's page: -;; http://www.gci-net.com/users/j/johnw/EmacsResources.html - -;; This is free software; you can redistribute it and/or modify it under -;; the terms of the GNU General Public License as published by the Free -;; Software Foundation; either version 2, or (at your option) any later -;; version. -;; -;; This 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: - -;; Wiki is a concept, more than a thing. It is a way of creating -;; document pages using plain text markup and simplified hyperlinking. - -;; By typing a name in MixedCase, a hyperlink is automatically created -;; to the document "MixedCase". Pressing return on that name will -;; create the file if it doesn't exist, or visit it if it does. - -;; The markup used by emacs-wiki is intended to be very friendly to -;; people familiar with Emacs. Type C-h v emacs-wiki-publishing-markup -;; after this mode is loaded for how to get started. - -;; * Startup - -;; To begin using emacs-wiki, put this in your .emacs file: - -;; (load "emacs-wiki") - -;; Now you can type M-x emacs-wiki-find-file, give it a WikiName (or -;; just hit return) and start typing! - -;; You should also type M-x customize-group, and give the name -;; "emacs-wiki". Change it to suite your preferences. Each of the -;; options has its own documentation. - -;; * Keystroke summary - -;; Here is a summary of keystrokes available in every Wiki buffer: - -;; C-c C-a jump to an index of all the Wiki pages -;; C-c C-b show all pages that reference this page -;; C-c C-s search for a word in your Wiki pages -;; C-c C-f jump to another Wiki page; prompts for the name -;; C-c C-l highlight/refresh the current buffer -;; C-c C-p publish any Wiki pages that have changed as HTML -;; C-c C-r rename wiki link at point -;; C-c C-v change wiki project -;; C-c C-D delete wiki link at point (binding will only work on X) -;; C-c = diff this page against the last backup version -;; TAB move to the next Wiki reference -;; S-TAB move to the previous Wiki reference - -;; * Using pcomplete - -;; If you have pcomplete loaded, you can type M-TAB to complete Wiki -;; names. Hitting M-TAB twice or more time in succession, will cycle -;; through all of the possibilities. You can download pcomplete from -;; my Website: - -;; http://www.gci-net.com/~johnw/emacs.html - -;; * ChangeLog support - -;; If you use a ChangeLog (C-x 4 a) within one of your Wiki -;; directories, it will be used for notifying visitors to your wiki of -;; recent changes. - -;; * Changing title or stylesheet - -;; For convenience, if you want to change the visible title, or the -;; stylesheet, used by a certain Wiki page during HTML publishing, -;; just put: - -;; #title Hello there -;; #style hello.css - -;; at the top of the page. - -;; * <lisp> tricks - -;; <lisp></lisp> tags can be used, not only to evaluate forms for -;; insertion at that point, but to influence the publishing process in -;; many ways. Here's another way to change a page's stylesheet: - -;; <lisp> -;; (ignore -;; ;; use special.css for this Wiki page -;; (set (make-variable-buffer-local 'emacs-wiki-style-sheet) -;; "<link rel=\"stylesheet\" type=\"text/css\" href=\"special.css\">")) -;; </lisp> - -;; The 'ignore' is needed so nothing is inserted where the <lisp> tag -;; occurred. Also, there should be no blank lines before or after the -;; tag (to avoid empty paragraphs from being created). The best place -;; to put this would be at the very top or bottom of the page. - -;; * Sub-lists? - -;; There is no inherent support for sub-lists, since I couldn't think -;; of a simple way to do it. But if you really need them, here's a -;; trick you can use: - -;; - Hello -;; <ul> -;; <li>There -;; <li>My friend -;; </ul> - -;;; Thanks - -;; Alex Schroeder (alex AT gnu DOT org), current author of "wiki.el". -;; His latest version is here: -;; http://www.geocities.com/kensanata/wiki/WikiMode.html -;; -;; Frank Gerhardt (Frank.Gerhardt AT web DOT de), author of the original wiki-mode -;; His latest version is here: -;; http://www.s.netic.de/fg/wiki-mode/wiki.el -;; -;; Thomas Link (<t.link AT gmx DOT at) - -;;; Code: - -;; The parts of this code, and work to be done: -;; -;; * setup emacs-wiki major mode -;; * generate WikiName list -;; * utility functions to extract link parts -;; * open a page -;; * navigate links in the buffer -;; * visit a link -;; * search Wiki pages for text/backlinks -;; * index generation -;; * buffer highlighting (using font-lock) -;; * HTML publishing -;; - Allow for alternate markup tables: DocBook, xhtml, etc. -;; - <nop> used in a line of verse doesn't have effect -;; * HTTP serving (using httpd.el) -;; - Diffing (look at using highlight-changes-mode and htmlify.el) -;; - Editing (requires implementing POST method for httpd.el) - -(defvar emacs-wiki-version "$Id" - "The version of emacs-wiki currently loaded") - -(require 'derived) - -;; for caddr etc -;(eval-when-compile (require 'cl)) - -;; load pcomplete if it's available -(load "pcomplete" t t) - -(defvar emacs-wiki-under-windows-p (memq system-type '(ms-dos windows-nt))) - -;;; Options: - -(defgroup emacs-wiki nil - "Options controlling the behaviour of Emacs Wiki Mode. -Wiki is a concept, more than a thing. It is a way of creating -document pages using plain text markup and simplified hyperlinking. - -By typing a name in MixedCase, a hyperlink is automatically created -to the document \"MixedCase\". Pressing return on that name will -create the file if it doesn't exist, or visit it if it does. - -The markup used by emacs-wiki is intended to be very friendly to -people familiar with Emacs. See the documentation for the variable -`emacs-wiki-publishing-markup' for a full description." - :group 'hypermedia) - -(defcustom emacs-wiki-mode-hook - (append (if (featurep 'table) - '(table-recognize)) - (unless (featurep 'httpd) - '(emacs-wiki-use-font-lock))) - "A hook that is run when emacs-wiki mode is entered." - :type 'hook - :options '(emacs-wiki-use-font-lock - emacs-wiki-highlight-buffer - flyspell-mode - footnote-mode - highlight-changes-mode) - :group 'emacs-wiki) - -;;;###autoload -(defcustom emacs-wiki-directories '("~/Wiki") - "A list of directories where Wiki pages can be found." - :require 'emacs-wiki - :type '(repeat :tag "Wiki directories" directory) - :group 'emacs-wiki) - -(defcustom emacs-wiki-default-page "WelcomePage" - "Name of the default page used by \\[emacs-wiki-find-file]." - :type 'string - :group 'emacs-wiki) - -(defcustom emacs-wiki-file-ignore-regexp - "\\`\\(\\.?#.*\\|.*,v\\|.*~\\|\\.\\.?\\)\\'" - "A regexp matching files to be ignored in Wiki directories." - :type 'regexp - :group 'emacs-wiki) - -(defcustom emacs-wiki-ignored-extensions-regexp - "\\.\\(bz2\\|gz\\|[Zz]\\)\\'" - "A regexp of extensions to omit from the ending of Wiki page name." - :type 'string - :group 'emacs-wiki) - -(defcustom emacs-wiki-interwiki-names - '(("GnuEmacs" . "http://www.gnu.org/software/emacs/emacs.html") - ("TheEmacsWiki" . - (lambda (tag) - (concat "http://www.emacswiki.org/cgi-bin/wiki.pl?" - (or tag "SiteMap")))) - ("MeatballWiki" . - (lambda (tag) - (concat "http://www.usemod.com/cgi-bin/mb.pl?" - (or tag "MeatballWiki"))))) - "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))) - :group 'emacs-wiki) - -(defvar emacs-wiki-url-or-name-regexp nil - "Matches either a Wiki link or a URL. This variable is auto-generated.") - -(defvar emacs-wiki-url-or-name-regexp-group-count nil - "Matches either a Wiki link or a URL. This variable is auto-generated.") - -(defcustom emacs-wiki-extended-link-regexp - "\\[\\[\\([^] \t\n]+\\)\\]\\(\\[\\([^]\n]+\\)\\]\\)?\\]" - "Regexp used to match [[extended][links]]." - :type 'regexp - :group 'emacs-wiki) - -(defun emacs-wiki-count-chars (string char) - (let ((i 0) - (l (length string)) - (count 0)) - (while (< i l) - (if (eq char (aref string i)) - (setq count (1+ count))) - (setq i (1+ i))) - count)) - -(defun emacs-wiki-set-sym-and-url-regexp (sym value) - (setq emacs-wiki-url-or-name-regexp - (concat "\\(" - (if (eq sym 'emacs-wiki-name-regexp) - value - emacs-wiki-name-regexp) "\\|" - (if (eq sym 'emacs-wiki-name-regexp) - (if (boundp 'emacs-wiki-url-regexp) - emacs-wiki-url-regexp - "") - value) "\\)") - emacs-wiki-url-or-name-regexp-group-count - (- (emacs-wiki-count-chars - emacs-wiki-url-or-name-regexp ?\() 2)) - (set sym value)) - -(defcustom emacs-wiki-name-regexp - (concat "\\(" emacs-wiki-extended-link-regexp "\\|" - "\\<[A-Z][a-z]+\\([A-Z][a-z]+\\)+\\(#[A-Za-z0-9_%]+\\)?" "\\)") - "Regexp used to match WikiNames." - :type 'regexp - :set 'emacs-wiki-set-sym-and-url-regexp - :group 'emacs-wiki) - -(defcustom emacs-wiki-url-regexp - (concat "\\<\\(https?:/?/?\\|ftp:/?/?\\|gopher://\\|" - "telnet://\\|wais://\\|file:/\\|s?news:\\|" - "mailto:\\)" - "[^] \n \"'()<>[^`{}]*[^] \n \"'()<>[^`{}.,;]+") - "A regexp used to match URLs within a Wiki buffer." - :type 'regexp - :set 'emacs-wiki-set-sym-and-url-regexp - :group 'emacs-wiki) - -(defcustom emacs-wiki-browse-url-function 'browse-url - "Function to call to browse a URL." - :type 'function - :group 'emacs-wiki) - -(defcustom emacs-wiki-grep-command - "find %D -type f ! -name '*~' | xargs egrep -n -e \"\\<%W\\>\"" - "The name of the program to use when grepping for backlinks. -The string %D is replaced by `emacs-wiki-directories', space-separated. -The string %W is replaced with the name of the Wiki page. - -Note: I highly recommend using glimpse to search large Wikis. 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 -Wikis. Don't forget to add a user cronjob to update the index at -intervals." - :type 'string - :group 'emacs-wiki) - -(defvar emacs-wiki-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [(control ?c) (control ?a)] 'emacs-wiki-index) - (define-key map [(control ?c) (control ?f)] 'emacs-wiki-find-file) - (define-key map [(control ?c) (control ?b)] 'emacs-wiki-backlink) - (define-key map [(control ?c) (control ?s)] 'emacs-wiki-search) - (define-key map [(control ?c) (control ?p)] 'emacs-wiki-publish) - (define-key map [(control ?c) (control ?v)] 'emacs-wiki-change-project) - (define-key map [(control ?c) (control ?r)] - 'emacs-wiki-rename-link-at-point) - (define-key map [(control ?c) (control ?D)] - 'emacs-wiki-delete-link-at-point) - - (define-key map [(control ?c) (control ?l)] 'font-lock-mode) - - (define-key map [(control ?c) ?=] - (lambda () - (interactive) - (diff-backup buffer-file-name))) - - (define-key map [tab] 'emacs-wiki-next-reference) - (define-key map [(control ?i)] 'emacs-wiki-next-reference) - - (if (featurep 'xemacs) - (define-key map [(shift tab)] 'emacs-wiki-previous-reference) - (define-key map [(shift iso-lefttab)] 'emacs-wiki-previous-reference) - (define-key map [(shift control ?i)] 'emacs-wiki-previous-reference)) - - (when (featurep 'pcomplete) - (define-key map [(meta tab)] 'pcomplete) - (define-key map [(meta control ?i)] 'pcomplete)) - - map) - "Keymap used by Emacs Wiki mode.") - -(defvar emacs-wiki-local-map - (let ((map (make-sparse-keymap))) - (define-key map [return] 'emacs-wiki-follow-name-at-point) - (define-key map [(control ?m)] 'emacs-wiki-follow-name-at-point) - (if (featurep 'xemacs) - (define-key map [(button2)] 'emacs-wiki-follow-name-at-mouse) - (define-key map [mouse-2] 'emacs-wiki-follow-name-at-mouse) - (unless (eq emacs-major-version 21) - (set-keymap-parent map emacs-wiki-mode-map))) - map) - "Local keymap used by emacs-wiki while on a WikiName.") - -;; Code: - -(defvar emacs-wiki-project nil) - -;;;###autoload -(define-derived-mode emacs-wiki-mode text-mode "Wiki" - "An Emacs mode for maintaining a local Wiki database. - -Wiki is a hypertext and a content management system: Normal users are -encouraged to enhance the hypertext by editing and refactoring existing -wikis and by adding more. This is made easy by requiring a certain way -of writing the wikis. It is not as complicated as a markup language -such as HTML. The general idea is to write plain ASCII. - -Words with mixed case such as ThisOne are WikiNames. WikiNames are -links you can follow. If a wiki with that name exists, you will be -taken there. If such a does not exist, following the link will create -a new wiki for you to fill. WikiNames for non-existing wikis are -rendered as links with class \"nonexistent\", and are also displayed -in a warning color so that you can see wether following the link will -lead you anywhere or not. - -In order to follow a link, hit RET when point is on the link, or use -mouse-2. - -All wikis reside in the `emacs-wiki-directories'. - -\\{emacs-wiki-mode-map}" - (if emacs-wiki-project - (emacs-wiki-change-project emacs-wiki-project)) - ;; because we're not inheriting from normal-mode, we need to - ;; explicitly run file variables if the user wants to - (condition-case err - (hack-local-variables) - (error (message "File local-variables error: %s" - (prin1-to-string err)))) - ;; bootstrap the file-alist, if it's not been read in yet - (emacs-wiki-file-alist t) - ;; if pcomplete is available, set it up! - (when (featurep 'pcomplete) - (set (make-variable-buffer-local 'pcomplete-default-completion-function) - 'emacs-wiki-completions) - (set (make-variable-buffer-local 'pcomplete-command-completion-function) - 'emacs-wiki-completions) - (set (make-variable-buffer-local 'pcomplete-parse-arguments-function) - 'emacs-wiki-current-word))) - -(defsubst emacs-wiki-page-file (page &optional no-check-p) - "Return a filename if PAGE exists within the current Wiki." - (cdr (assoc page (emacs-wiki-file-alist no-check-p)))) - -(defsubst emacs-wiki-directory-part (path) - (directory-file-name (expand-file-name path))) - -(defun emacs-wiki-directories-member (&optional directories) - "Return non-nil if the current buffer is in `emacs-wiki-directories'." - (let ((here (emacs-wiki-directory-part default-directory)) - (d (or directories emacs-wiki-directories)) - yes) - (while d - (if (string= here (emacs-wiki-directory-part (if (consp (car d)) - (caar d) - (car d)))) - (setq yes (car d) d nil) - (setq d (cdr d)))) - yes)) - -(defun emacs-wiki-maybe (&optional check-only) - "Maybe turn Emacs Wiki mode on for this file." - (let ((projs emacs-wiki-projects) - (mode-func 'emacs-wiki-mode) - project yes) - (while (and (not yes) projs) - (let* ((projsyms (cdar projs)) - (pred (assq 'emacs-wiki-predicate projsyms)) - dirs) - (if pred - (setq yes (funcall (cdr pred))) - (setq dirs (assq 'emacs-wiki-directories projsyms)) - (if dirs - (setq yes (emacs-wiki-directories-member (cdr dirs))))) - (if yes - (setq project (caar projs) - mode-func (or (cdr (assq 'emacs-wiki-major-mode projsyms)) - mode-func)))) - (setq projs (cdr projs))) - (setq yes (or yes (emacs-wiki-directories-member))) - (if (and yes (not check-only)) - (let ((emacs-wiki-project project)) - (funcall mode-func))) - yes)) - -(add-hook 'find-file-hooks 'emacs-wiki-maybe) - -;;; Support WikiName completion using pcomplete - -(defun emacs-wiki-completions () - "Return a list of possible completions names for this buffer." - (while (pcomplete-here - (mapcar 'car (append (emacs-wiki-file-alist) - emacs-wiki-interwiki-names))))) - -(defun emacs-wiki-current-word () - (let ((end (point))) - (save-restriction - (save-excursion - (skip-chars-backward "^\\[ \t\n") - (narrow-to-region (point) end)) - (pcomplete-parse-buffer-arguments)))) - -;;; Return an list of known wiki names and the files they represent. - -(defsubst emacs-wiki-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))))) - -(defun emacs-wiki-page-name (&optional name) - "Return the canonical form of the Wiki page name. -All this means is that certain extensions, like .gz, are removed." - (save-match-data - (unless name - (setq name buffer-file-name)) - (if name - (let ((page (file-name-nondirectory name))) - (if (string-match emacs-wiki-ignored-extensions-regexp page) - (replace-match "" t t page) - page))))) - -(defun emacs-wiki-page-title (&optional name) - "Return the canonical form of the Wiki page name. -All this means is that certain extensions, like .gz, are removed." - (or emacs-wiki-current-page-title - (emacs-wiki-prettify-title (emacs-wiki-page-name name)))) - -(defvar emacs-wiki-file-alist nil) - -(defun emacs-wiki-file-alist (&optional no-check-p) - "Return possible Wiki filenames in `emacs-wiki-directories'. -On UNIX, this list is only updated if one of the directories' contents -have changed. On Windows, it is always reread from disk." - (let* ((file-alist (assoc emacs-wiki-current-project - emacs-wiki-file-alist)) - (dirs emacs-wiki-directories) - (d dirs) last-mod) - (unless (or emacs-wiki-under-windows-p no-check-p) - (while d - (let ((mod-time (nth 5 (file-attributes (car d))))) - (if (or (null last-mod) - (and mod-time (emacs-wiki-time-less-p last-mod mod-time))) - (setq last-mod mod-time))) - (setq d (cdr d)))) - (if (or (and no-check-p (cadr file-alist)) - (not (or emacs-wiki-under-windows-p - (null (cddr file-alist)) - (null last-mod) - (emacs-wiki-time-less-p (cddr file-alist) last-mod)))) - (cadr file-alist) - (if file-alist - (setcdr (cdr file-alist) last-mod) - (setq file-alist (cons emacs-wiki-current-project (cons nil last-mod)) - emacs-wiki-file-alist (cons file-alist emacs-wiki-file-alist))) - (save-match-data - (setcar - (cdr file-alist) - (let* ((names (list t)) - (lnames names)) - (while dirs - (if (file-readable-p (car dirs)) - (let ((files (directory-files (car dirs) t nil t))) - (while files - (unless - (or (file-directory-p (car files)) - (string-match emacs-wiki-file-ignore-regexp - (file-name-nondirectory - (car files)))) - (setcdr lnames - (cons (cons (emacs-wiki-page-name (car files)) - (car files)) nil)) - (setq lnames (cdr lnames))) - (setq files (cdr files))))) - (setq dirs (cdr dirs))) - (cdr names))))))) - -(defun emacs-wiki-complete-alist () - "Return equivalent of calling (emacs-wiki-file-alist) for all projects." - (let ((emacs-wiki-current-project "_CompositeFileList") - (emacs-wiki-directories - (copy-alist emacs-wiki-directories)) - (projs emacs-wiki-projects)) - (while projs - (let* ((projsyms (cdar projs)) - (dirs (cdr (assq 'emacs-wiki-directories projsyms)))) - (while dirs - (add-to-list 'emacs-wiki-directories (car dirs)) - (setq dirs (cdr dirs)))) - (setq projs (cdr projs))) - (emacs-wiki-file-alist))) - -;; Utility functions to extract parts of a Wiki name - -(defvar emacs-wiki-serving-p nil - "Non-nil when emacs-wiki is serving a wiki page directly.") - -(defsubst emacs-wiki-transform-name (name) - "Transform NAME as per `emacs-wiki-publishing-transforms', returning NAME" - (save-match-data - (mapc (function - (lambda (elt) - (let ((reg (car elt)) - (rep (cdr elt))) - (when (string-match reg name) - (setq name (replace-match rep t nil name)))))) - emacs-wiki-publishing-transforms) - name)) - -(defsubst emacs-wiki-published-name (name &optional current) - "Return the externally visible NAME for a wiki page, possibly transformed - via `emacs-wiki-publishing-transforms'. If CURRENT is provided, convert any - path to be relative to it" - (emacs-wiki-transform-name - (progn - (when current - (setq name (file-relative-name name - (file-name-directory - (emacs-wiki-transform-name current))))) - (concat (if emacs-wiki-serving-p - (unless (string-match "\\?" name) "wiki?") - emacs-wiki-publishing-file-prefix) - name - (if emacs-wiki-serving-p - (if emacs-wiki-current-project - (concat "&project=" emacs-wiki-current-project)) - emacs-wiki-publishing-file-suffix))))) - -(defsubst emacs-wiki-published-file (&optional file) - "Return the filename of the published file. Since this is based on the - published-name, it will be filtered through - `emacs-wiki-publishing-transforms'" - (expand-file-name (emacs-wiki-published-name (emacs-wiki-page-name - file)) - emacs-wiki-publishing-directory)) - -(defcustom emacs-wiki-publishing-transforms nil - "A list of cons cells mapping regexps to replacements, which is applied when -generating the published name from the wiki file name. The replacements -run in order so you can chain them together. - -An example is how I publish the emacs-wiki documentation. The emacs-wiki -homepage is in a file called EmacsWiki. With the following settings I can -publish directly to my webserver via tramp (the first rule catches 'WikiMarkup' -for instance): - -(setq emacs-wiki-publishing-directory \"/webserver:/var/www/\") -(setq emacs-wiki-publishing-transforms - ((\".*Wiki.*\" . \"emacs/wiki/\\&\") - (\"EmacsWiki\\|WelcomePage\" . \"index\"))) - -Then when trying to publish a page EmacsWiki: - -(emacs-wiki-published-file \"EmacsWiki\") - -You get: - -\"/webserver:/var/www/emacs/wiki/index.html\"" - :type '(repeat - (cons - (regexp :tag "String to match") - (string :tag "Replacement string"))) - :group 'emacs-wiki-publish) - -(defsubst emacs-wiki-wiki-url-p (name) - "Return non-nil if NAME is a URL." - (save-match-data - (string-match emacs-wiki-url-regexp name))) - -(defun emacs-wiki-wiki-visible-name (wiki-name) - "Return the visible part of a Wiki link. -This only really means something if [[extended][links]] are involved." - (save-match-data - (let ((name wiki-name)) - (if (string-match emacs-wiki-extended-link-regexp name) - (if (match-string 2 name) - (setq name (match-string 3 name)) - (setq name (match-string 1 name)))) - (if (and (not (emacs-wiki-wiki-url-p name)) - (string-match "#" name)) - (if (= 0 (match-beginning 0)) - (setq name (emacs-wiki-page-name)) - (let ((base (substring name 0 (match-beginning 0)))) - (if (assoc base emacs-wiki-interwiki-names) - (setq name (concat (substring name 0 (match-beginning 0)) - ":" (substring name (match-end 0)))) - (setq name base))))) - name))) - -(defun emacs-wiki-wiki-tag (wiki-name) - (save-match-data - (if (string-match "#" wiki-name) - (substring wiki-name (match-end 0))))) - -(defun emacs-wiki-wiki-link-target (wiki-name) - "Return the target of a Wiki link. This might include anchor tags." - (save-match-data - (let ((name wiki-name) lookup) - (if (string-match "^\\[\\[\\([^]]+\\)\\]" name) - (setq name (match-string 1 name))) - (if (and emacs-wiki-interwiki-names - (string-match "\\`\\([^#]+\\)\\(#\\(.+\\)\\)?\\'" name) - (setq lookup (assoc (match-string 1 name) - emacs-wiki-interwiki-names))) - (let ((tag (match-string 3 name)) - (target (cdr lookup))) - (if (stringp target) - (setq name (concat target tag)) - (setq name (funcall target tag)))) - (if (and (> (length name) 0) - (eq (aref name 0) ?#)) - (setq name (concat (emacs-wiki-page-name) name)))) - name))) - -(defun emacs-wiki-wiki-base (wiki-name) - "Find the WikiName or URL mentioned by a Wiki link. -This means without tags, in the case of a WikiName." - (save-match-data - (let ((file (emacs-wiki-wiki-link-target wiki-name))) - (if (emacs-wiki-wiki-url-p file) - file - (if (string-match "#" file) - (substring file 0 (match-beginning 0)) - file))))) - -;;; Open a Wiki page (with completion) - -(defvar emacs-wiki-history-list nil) - -(defun emacs-wiki-read-name (file-alist &optional prompt) - "Read the name of a valid Wiki page from minibuffer, with completion." - (let* ((default emacs-wiki-default-page) - (str (completing-read - (format "%s(default: %s) " (or prompt "Wiki page: ") default) - file-alist nil nil nil 'emacs-wiki-history-list))) - (if (or (null str) (= (length str) 0)) - default - str))) - -;;;###autoload -(defun emacs-wiki-find-file (wiki &optional command directory) - "Open the Emacs Wiki page WIKI by name. -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 Wiki page -will be created if it does not already exist." - (interactive - (list - (let ((num (prefix-numeric-value current-prefix-arg))) - (if (< num 16) - (let* ((file-alist (if (= num 4) - (emacs-wiki-complete-alist) - (emacs-wiki-file-alist))) - (name (emacs-wiki-read-name file-alist))) - (cons name (cdr (assoc name file-alist)))) - (let ((name (read-file-name "Open wiki file: "))) - (cons name name)))))) - (unless (interactive-p) - (setq wiki (cons wiki - (cdr (assoc wiki (emacs-wiki-file-alist)))))) - ;; At this point, `wiki' is (GIVEN-PAGE FOUND-FILE). - (if (cdr wiki) - (let ((buffer (funcall (or command 'find-file) (cdr wiki)))) - (if (= (prefix-numeric-value current-prefix-arg) 16) - (with-current-buffer buffer - (set (make-variable-buffer-local 'emacs-wiki-directories) - (cons (file-name-directory (cdr wiki)) - emacs-wiki-directories)) - (set (make-variable-buffer-local 'emacs-wiki-file-alist) nil))) - buffer) - (let* ((dirname (or directory - (emacs-wiki-maybe t) - (car emacs-wiki-directories))) - (filename (expand-file-name (car wiki) dirname))) - (unless (file-exists-p dirname) - (make-directory dirname t)) - (funcall (or command 'find-file) filename)))) - -;;; Navigate/visit links or URLs. Use TAB, S-TAB and RET (or mouse-2). - -(defun emacs-wiki-next-reference () - "Move forward to next Wiki link or URL, cycling if necessary." - (interactive) - (let ((case-fold-search nil) - (cycled 0) pos) - (save-excursion - (if (emacs-wiki-link-at-point) - (goto-char (match-end 0))) - (while (< cycled 2) - (if (re-search-forward emacs-wiki-url-or-name-regexp nil t) - (setq pos (match-beginning 0) - cycled 2) - (goto-char (point-min)) - (setq cycled (1+ cycled))))) - (if pos - (goto-char pos)))) - -(defun emacs-wiki-previous-reference () - "Move backward to the next Wiki link or URL, cycling if necessary. -This function is not entirely accurate, but it's close enough." - (interactive) - (let ((case-fold-search nil) - (cycled 0) pos) - (save-excursion - (while (< cycled 2) - (if (re-search-backward emacs-wiki-url-or-name-regexp nil t) - (setq pos (point) - cycled 2) - (goto-char (point-max)) - (setq cycled (1+ cycled))))) - (if pos - (goto-char pos)))) - -(defun emacs-wiki-visit-link (link-name) - "Visit the URL or link named by LINK-NAME." - (let ((link (emacs-wiki-wiki-link-target link-name))) - (if (emacs-wiki-wiki-url-p link) - (funcall emacs-wiki-browse-url-function link) - ;; The name list is current since the last time the buffer was - ;; highlighted - (let* ((base (emacs-wiki-wiki-base link-name)) - (file (emacs-wiki-page-file base t)) - (tag (and (not (emacs-wiki-wiki-url-p link)) - (emacs-wiki-wiki-tag link)))) - (if (null file) - (find-file base) - (find-file file) - (when tag - (goto-char (point-min)) - (re-search-forward (concat "^\\.?#" tag) nil t))))))) - -(unless (fboundp 'line-end-position) - (defsubst line-end-position (&optional N) - (save-excursion (end-of-line N) (point)))) - -(unless (fboundp 'line-beginning-position) - (defsubst line-beginning-position (&optional N) - (save-excursion (beginning-of-line N) (point)))) - -(unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties 'match-string)) - -(defun emacs-wiki-link-at-point (&optional pos) - "Return non-nil if a URL or Wiki link name is at point." - (if (or (null pos) - (and (char-after pos) - (not (eq (char-syntax (char-after pos)) ? )))) - (let ((case-fold-search nil) - (here (or pos (point)))) - (save-excursion - (goto-char here) - (skip-chars-backward "^'\"<>{}( \t\n") - (or (looking-at emacs-wiki-url-or-name-regexp) - (and (search-backward "[[" (line-beginning-position) t) - (looking-at emacs-wiki-name-regexp) - (<= here (match-end 0)))))))) - -(defun emacs-wiki-follow-name-at-point () - "Visit the link at point, or insert a newline if none." - (interactive) - (if (emacs-wiki-link-at-point) - (emacs-wiki-visit-link (match-string 0)) - (error "There is no valid link at point"))) - -(defun emacs-wiki-follow-name-at-mouse (event) - "Visit the link at point, or yank text if none." - (interactive "e") - (save-excursion - (cond ((fboundp 'event-window) ; XEmacs - (set-buffer (window-buffer (event-window event))) - (and (event-point event) (goto-char (event-point event)))) - ((fboundp 'posn-window) ; Emacs - (set-buffer (window-buffer (posn-window (event-start event)))) - (goto-char (posn-point (event-start event))))) - (if (emacs-wiki-link-at-point) - (emacs-wiki-visit-link (match-string 0))))) - -(defun emacs-wiki-rename-link (link-name new-name) - (when (emacs-wiki-wiki-url-p link-name) - (error "Can't rename a URL")) - (let* ((base (emacs-wiki-wiki-base link-name)) - (file (emacs-wiki-page-file base t))) - (if (null file) - (rename-file base new-name) - (rename-file file new-name)))) - -(defun emacs-wiki-rename-link-at-point () - "Rename the link under point, and the location it points to. This does not - work with URLs" - (interactive "*") - (let (new-name old-name) - (if (emacs-wiki-link-at-point) - (progn - (setq old-name (match-string 0)) - ;; emacs21 leaves the local keymap on this string, so we must strip - ;; properties so the user can hit return to exit minibuf - (set-text-properties 0 (length old-name) nil old-name) - (setq new-name (read-from-minibuffer "Rename to: " old-name)) - (emacs-wiki-rename-link old-name new-name) - ;; at this point, the file would have been successfully renamed, so - ;; it's safe to change to link name now - (replace-match new-name nil t)) - (error "There is no valid link at point")))) - -(defun emacs-wiki-delete-link (link-name) - "Delete the file which link-name corresponds to" - (when (emacs-wiki-wiki-url-p link-name) - (error "Can't rename a URL")) - (let* ((base (emacs-wiki-wiki-base link-name)) - (file (emacs-wiki-page-file base t))) - (if (null file) - (delete-file base) - (delete-file file)))) - -(defun emacs-wiki-delete-link-at-point () - "Delete the link under point, and the location it points to. This does not - work with URLs" - (interactive "*") - (let (name) - (if (emacs-wiki-link-at-point) - (progn - (setq name (match-string 0)) - (when (yes-or-no-p (concat "Delete " - name "? You can not undo this. ")) - (emacs-wiki-delete-link name) - (replace-match "" nil t))) - (error "There is no valid link at point")))) - -;;; Find text in Wiki pages, or pages referring to the current page - -(defvar emacs-wiki-search-history nil) - -(defun emacs-wiki-grep (string &optional grep-command) - "Grep for STRING in the Wiki directories. GREP-COMMAND if passed will - supplant emacs-wiki-grep-command." - (require 'compile) - (let ((str (or grep-command emacs-wiki-grep-command)) - (dirs (mapconcat (lambda (dir) - (shell-quote-argument (expand-file-name dir))) - emacs-wiki-directories " "))) - (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))) - (compile-internal str "No more search hits" "search" - nil grep-regexp-alist))) - -(defun emacs-wiki-search (text) - "Search for the given TEXT string in the Wiki directories." - (interactive - (list (let ((str (concat emacs-wiki-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 'emacs-wiki-search-history)))) - (emacs-wiki-grep nil text)) - -(defun emacs-wiki-backlink () - "Grep for the current pagename in all the Wiki directories." - (interactive) - (emacs-wiki-grep (emacs-wiki-page-name))) - -;;; Generate an index of all known Wiki pages - -(defun emacs-wiki-generate-index (&optional as-list exclude-private) - "Generate an index of all Wiki pages." - (let ((project emacs-wiki-current-project)) - (with-current-buffer (get-buffer-create "*Wiki Index*") - (erase-buffer) - (if project - (emacs-wiki-change-project project)) - (let ((files (sort (copy-alist (emacs-wiki-file-alist)) - (function - (lambda (l r) - (string-lessp (car l) (car r)))))) - file) - (while files - (unless (and exclude-private - (emacs-wiki-private-p (caar files))) - (insert (if as-list "- " "") "[[" (caar files) "]]\n")) - (setq files (cdr files)))) - (current-buffer)))) - -(defun emacs-wiki-index () - "Display an index of all known Wiki pages." - (interactive) - (message "Generating Wiki index...") - (pop-to-buffer (emacs-wiki-generate-index)) - (goto-char (point-min)) - (emacs-wiki-mode) - (message "Generating Wiki index...done")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Emacs Wiki Highlighting -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup emacs-wiki-highlight nil - "Options controlling the behaviour of Emacs Wiki highlighting. -See `emacs-wiki-highlight-buffer' for more information." - :group 'emacs-wiki) - -(defun emacs-wiki-make-faces () - (mapc (lambda (newsym) - (let (num) - (setq num newsym) - (setq newsym (intern (concat "emacs-wiki-header-" - (int-to-string num)))) - (cond - ((featurep 'xemacs) - (eval `(defface ,newsym - '((t (:size - ,(nth (1- num) '("24pt" "18pt" "14pt" "12pt")) - :bold t))) - "emacs-wiki header face" - :group 'emacs-wiki-highlight))) - ((< emacs-major-version 21) - (copy-face 'default newsym)) - (t - (eval `(defface ,newsym - '((t (:height ,(1+ (* 0.1 (- 5 num))) - :inherit variable-pitch - :weight bold))) - "emacs-wiki header face" - :group 'emacs-wiki-highlight)))))) - '(1 2 3 4 5 6))) -(emacs-wiki-make-faces) - -(defface emacs-wiki-link-face - '((((class color) (background light)) - (:foreground "green" :underline "green" :bold t)) - (((class color) (background dark)) - (:foreground "cyan" :underline "cyan" :bold t)) - (t (:bold t))) - "Face for Wiki cross-references." - :group 'emacs-wiki-highlight) - -(defface emacs-wiki-bad-link-face - '((((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 Wiki cross-references." - :group 'emacs-wiki-highlight) - -(defcustom emacs-wiki-highlight-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 'emacs-wiki-highlight) - -(defcustom emacs-wiki-inline-images (and (not (featurep 'xemacs)) - (>= emacs-major-version 21) - window-system) - "If non-nil, inline locally available images within Wiki pages." - :type 'boolean - :group 'emacs-wiki-highlight) - -(defcustom emacs-wiki-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. Remember -that it must be matched as a link first - so use either [[CamelCaps]] or -include a leading slash - [[./text]]. An 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 'emacs-wiki) - -(defcustom emacs-wiki-file-regexp - "[/?]\\|\\.\\(html?\\|pdf\\|el\\|zip\\|txt\\|tar\\)\\(\\.\\(gz\\|bz2\\)\\)?\\'" - "A link matching this regexp will be regarded as a link to a file. Remember -that it must be matched as a link first - so use either [[CamelCaps]] or -include a leading slash - [[./text]]" - :type 'regexp - :group 'emacs-wiki) - -(defcustom emacs-wiki-tag-regexp - "<\\([^/ \t\n][^ \t\n</>]*\\)\\(\\s-+[^<>]+[^</>]\\)?\\(/\\)?>" - "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 'emacs-wiki) - -(defcustom emacs-wiki-inline-relative-to 'emacs-wiki-publishing-directory - "The name of a symbol which records the location relative to where images - should be found. The default assumes that when editing, the images can be - found in the publishing directory. Another sensible default is - `default-directory', which will try and find the images relative to the - local page. You can use this to store images in wikidir/images, and - maintain a parallel copy on the remote host." - :type 'symbol - :group 'emacs-wiki) - -(defcustom emacs-wiki-markup-tags - '(("example" t nil t emacs-wiki-example-tag) - ("verbatim" t nil t emacs-wiki-verbatim-tag) - ("nowiki" t nil t emacs-wiki-nowiki-tag) - ("verse" t nil nil emacs-wiki-verse-tag) - ("numbered" t nil nil emacs-wiki-numbered-tag) - ("nop" nil nil t emacs-wiki-nop-tag) - ("contents" nil t nil emacs-wiki-contents-tag) - ("c-source" t t t emacs-wiki-c-source-tag)) - "A list of tag specifications, for specially marking up Wiki text. -XML-style tags are the best way to add custom markup to Emacs Wiki. -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, if the handler -function can also highlight the tag, and a function that performs -whatever action is desired within the delimited region. - -The tags themselves are deleted during publishing, although not during -highlighting, before the function is called. The function is called -with three arguments, the beginning and end of the region surrounded -by the tags (including the tags themselves, in the case of -highlighting). The third argument indicates whether the purpose of -the call is to highlight the region, or mark it up for publishing. If -properties are allowed, they are passed as a fourth 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/highlighting 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. For highlighting, they are processed as they occur, in -the order they occur, once per text region. - -Here is a summary of the default tags. This includes the dangerous -tags listed in `emacs-wiki-dangerous-tags', which may not be used by -outsiders. - - verbatim - Protects against highlighting and wiki interpretation, and escapes any - characters which have special meaning to the publishing format. For HTML, - this means characters like '<' are escaped as HTML entities. - - example - Like verbatim, but typesets in HTML using the <pre> tag, with - class=example, so whitespace formatting is preserved. - - nowiki - Inhibits wiki markup, but does not do any escaping to the underlying - publishing medium. Useful for embedding HTML, PHP, etc. - - verse - Typesets like a normal paragraph, but without word-wrapping. - That is, whitespace is preserved. - - redirect - Using the \"url\" attribute, you can specify that a page should - redirect to another page. The remaining contents of the page will - not be published. The optional \"delay\" attribute specifies how - long to wait before redirecting. - - nop - When placed before a WikiLink, it will prevent that WikiLink from - being treated as such. Good for names like DocBook. - - contents - Produces a compact table of contents for any section heading at the - same level or lower than the next section header encountered. - Optional \"depth\" attribute specifies how deep the table of - contents should go. - - lisp - Evaluate the region as a Lisp form, and displays the result. When - highlighting, the `display' text property is used, preserving the - underlying text. Turn off font-lock mode if you wish to edit it. - - command - Pass the region to a command interpretor and insert the result, - guarding it from any further expansion. Optional \"file\" - attribute specifies the shell or interpretor to use. If none is - given, and `emacs-wiki-command-tag-file' has not been configured, - Eshell is used. - - python, perl - Pass the region to the Python or Perl language interpretor, and - insert the result. - - c-source - Markup the region as C or C++ source code, using the c2html - program, if available. Optional boolean attribute \"numbered\" - will cause source lines to be numbered. - - Note: If c2html is not available, the region will be converted to - HTML friendly text (i.e., <> turns into <>), and placed in a - <pre> block. In this case, line numbering is not available. - - bookmarks - Insert bookmarks at the location of the tag from the given - bookmarks file. Required attribute \"file\" specifies which file - to read from, and the optional attribute \"type\" may be one of: - adr (for Opera), lynx, msie, ns, xbel or xmlproc. The default type - is \"xbel\". The optional attribute \"folder\" may be used to - specify which folder (and its children) should be inserted. - - Note that xml-parse.el version 1.5 (available from my website) and - the xbel-utils package (available at least to Debian users) is - required for this feature to work." - :type '(repeat (list (string :tag "Markup tag") - (boolean :tag "Expect closing tag" :value t) - (boolean :tag "Parse attributes" :value nil) - (boolean :tag "Highlight tag" :value nil) - function)) - :group 'emacs-wiki-highlight) - -(defcustom emacs-wiki-dangerous-tags - '(("redirect" t t nil emacs-wiki-redirect-tag) - ("lisp" t nil t emacs-wiki-lisp-tag) - ("command" t t t emacs-wiki-command-tag) - ("python" t t t emacs-wiki-python-tag) - ("perl" t t t emacs-wiki-perl-tag) - ("bookmarks" nil t nil emacs-wiki-bookmarks-tag)) - "A list of tag specifications, for specially marking up Wiki text. -These tags are dangerous -- meaning represent a gaping security hole --- and therefore are not available to outsiders who happen to edit a -Wiki page" - :type '(repeat (list (string :tag "Markup tag") - (boolean :tag "Expect closing tag" :value t) - (boolean :tag "Parse attributes" :value nil) - (boolean :tag "Highlight tag" :value nil) - function)) - :group 'emacs-wiki-highlight) - -(defvar emacs-wiki-highlight-regexp nil) -(defvar emacs-wiki-highlight-vector nil) - -(defun emacs-wiki-configure-highlighting (sym val) - (setq emacs-wiki-highlight-regexp - (concat "\\(" (mapconcat (function - (lambda (rule) - (if (symbolp (car rule)) - (symbol-value (car rule)) - (car rule)))) val "\\|") "\\)") - emacs-wiki-highlight-vector (make-vector 128 nil)) - (let ((rules val)) - (while rules - (if (eq (cadr (car rules)) t) - (let ((i 0) (l 128)) - (while (< i l) - (unless (aref emacs-wiki-highlight-vector i) - (aset emacs-wiki-highlight-vector i - (nth 2 (car rules)))) - (setq i (1+ i)))) - (aset emacs-wiki-highlight-vector (cadr (car rules)) - (nth 2 (car rules)))) - (setq rules (cdr rules)))) - (set sym val)) - -(defsubst emacs-wiki-highlight-ok-context-p (beg end str) - "Ensures whitespace or punctuation comes before the position BEG, and - after the string STR. A search-forward is done for STR, bounding by END, and - the position of the end of the match is returned if in the correct context." - (save-excursion - (let ((len (length str))) - (and - (setq end (search-forward str end t)) - ;; post end, want eob or whitespace/punctuation - (or (> (skip-syntax-forward ". " (1+ end)) 0) - (eq nil (char-after end))) - (goto-char (- end len)) - ;; pre end, no whitespace - (eq (skip-syntax-backward " " (- end len 1)) 0) - (goto-char (+ beg len)) - ;; post beg, no whitespace - (eq (skip-syntax-forward " " (+ beg len 1)) 0) - (or (backward-char len) t) ;; doesn't return anything useful - ;; pre beg, want sob or whitespace/punctuation - (or (< (skip-syntax-backward ". " (1- beg)) 0) - (eq nil (char-before beg))) - end)))) - -(defun emacs-wiki-multiline-maybe (beg end &optional predicate) - "If region between beg-end is a multi-line region, and the optional - predicate is true, font lock the current region as multi-line. Predicate is - called with the excursion saved." - (when (and (or (eq (char-before end) ?\n) - (> (count-lines beg end) 1)) - (or (not predicate) - (save-excursion (funcall predicate beg end)))) - (save-excursion - ;; mark whole lines as a multiline font-lock - (goto-char beg) - (setq beg (line-beginning-position)) - (goto-char end) - (setq end (line-end-position)) - (add-text-properties beg end '(font-lock-multiline t)) - t))) - -(defun emacs-wiki-highlight-emphasized () - ;; 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)) - (end end) - b2 e2 face) - ;; if it's a header - (unless (save-excursion - (goto-char beg) - (when (save-match-data (looking-at "^\\*\\{1,3\\} ")) - (add-text-properties - (line-beginning-position) (line-end-position) - (list 'face - (intern (concat "emacs-wiki-header-" - (int-to-string (1+ leader)))))) - t)) - ;; it might be an normal, emphasised piece of text - (when (and - (setq e2 (emacs-wiki-highlight-ok-context-p - beg end (buffer-substring-no-properties beg e1))) - (setq b2 (match-beginning 0))) - (cond ((= leader 1) (setq face 'italic)) - ((= leader 2) (setq face 'bold)) - ((= leader 3) (setq face 'bold-italic))) - (add-text-properties beg e1 '(invisible t intangible t)) - (add-text-properties e1 b2 (list 'face face)) - (add-text-properties b2 e2 '(invisible t intangible t))) - (emacs-wiki-multiline-maybe - beg end - ;; ensures we only mark the region as multiline if it's correctly - ;; delimited at the start - (lambda (beg end) - (goto-char (1+ beg)) - (eq (skip-syntax-forward " " (1+ beg)) 0) - (or (backward-char) t) - (or (< (skip-syntax-backward ". " (1- beg)) 0) - (eq nil (char-before beg)))))))) - -(defun emacs-wiki-highlight-underlined () - (let ((start (- (point) 2)) - end) - (when (setq end (emacs-wiki-highlight-ok-context-p start end "_")) - (add-text-properties start (+ start 1) '(invisible t intangible t)) - (add-text-properties (+ start 1) (- end 1) '(face underline)) - (add-text-properties (- end 1) end '(invisible t intangible t))))) - -(defun emacs-wiki-highlight-verbatim () - (let ((start (- (point) 2)) - end) - (when (setq end (emacs-wiki-highlight-ok-context-p start end "=")) - (search-forward "=" end t)))) - -(defcustom emacs-wiki-highlight-markup - `(;; render in teletype and suppress further parsing - ("=[^\t =]" ?= emacs-wiki-highlight-verbatim) - - ;; make emphasized text appear emphasized - ("\\*+" ?* emacs-wiki-highlight-emphasized) - - ;; make underlined text appear underlined - ("_[^ \t_]" ?_ emacs-wiki-highlight-underlined) - - ;; make quadruple quotes invisible - ("''''" ?\' - ,(function - (lambda () - (add-text-properties (match-beginning 0) (match-end 0) - '(invisible t intangible t))))) - - ("^#title" ?\# emacs-wiki-highlight-title) - - (emacs-wiki-url-or-name-regexp t emacs-wiki-highlight-link) - - ;; highlight any markup tags encountered - (emacs-wiki-tag-regexp ?\< emacs-wiki-highlight-custom-tags)) - "Expressions to highlight an Emacs Wiki 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. - -Lastly, none of the regexp should contain grouping elements that will -affect the match data results." - :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 'emacs-wiki-configure-highlighting - :group 'emacs-wiki-highlight) - -(defvar font-lock-mode nil) -(defvar font-lock-multiline nil) - -(defun emacs-wiki-use-font-lock () - (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 . emacs-wiki-highlight-region) - (font-lock-unfontify-region-function - . emacs-wiki-unhighlight-region))) - (set (make-local-variable 'font-lock-fontify-region-function) - 'emacs-wiki-highlight-region) - (set (make-local-variable 'font-lock-unfontify-region-function) - 'emacs-wiki-unhighlight-region) - (font-lock-mode t)) - -(defun emacs-wiki-mode-flyspell-verify () - "Return t if the word at point should be spell checked." - (let* ((word-pos (1- (point))) - (props (text-properties-at word-pos))) - (not (or (bobp) - (memq 'display props) - (if (and font-lock-mode (cadr (memq 'fontified props))) - (memq (cadr (memq 'face props)) - '(emacs-wiki-link-face emacs-wiki-bad-link-face)) - (emacs-wiki-link-at-point word-pos)))))) - -(put 'emacs-wiki-mode 'flyspell-mode-predicate - 'emacs-wiki-mode-flyspell-verify) - -(defun emacs-wiki-eval-lisp (form) - "Evaluate the given form and return the result as a string." - (require 'pp) - (save-match-data - (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)))))) - -(defun emacs-wiki-highlight-buffer () - "Re-highlight the entire Wiki buffer." - (interactive) - (emacs-wiki-highlight-region (point-min) (point-max) t)) - -(defun emacs-wiki-highlight-region (beg end &optional verbose) - "Apply highlighting according to `emacs-wiki-highlight-markup'. -Note that this function should NOT change the buffer, nor should any -of the functions listed in `emacs-wiki-highlight-markup'." - (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 - (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 (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 (line-beginning-position 2)) - ;; Undo any fontification in the area. - (font-lock-unfontify-region beg end) - ;; And apply fontification based on `emacs-wiki-highlight-markup' - (let ((len (float (- end beg))) - (case-fold-search nil)) - (goto-char beg) - (while - (and (< (point) end) - (re-search-forward emacs-wiki-highlight-regexp end t)) - (if verbose - (message "Highlighting buffer...%d%%" - (* (/ (float (- (point) beg)) len) 100))) - (funcall (aref emacs-wiki-highlight-vector - (char-after (match-beginning 0))))) - (run-hook-with-args 'emacs-wiki-highlight-buffer-hook - beg end verbose) - (if verbose (message "Highlighting buffer...done"))))) - (set-buffer-modified-p modified-p)))) - -(defun emacs-wiki-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 - invisible nil intangible nil display nil - mouse-face nil keymap nil help-echo nil)) - (set-buffer-modified-p modified-p)))) - -(eval-when-compile - (defvar end)) - -(defun emacs-wiki-multiline-maybe (beg end &optional predicate) - "If region between beg-end is a multi-line region, and the optional - predicate is true, font lock the current region as multi-line. Predicate is - called with the excursion saved." - (when (and (or (eq (char-before end) ?\n) - (> (count-lines beg end) 1)) - (or (not predicate) - (save-excursion (funcall predicate beg end)))) - (save-excursion - ;; mark whole lines as a multiline font-lock - (goto-char beg) - (setq beg (line-beginning-position)) - (goto-char end) - (setq end (line-end-position)) - (add-text-properties beg end '(font-lock-multiline t)) - t))) - -(defvar emacs-wiki-keymap-property - (if (or (featurep 'xemacs) - (>= emacs-major-version 21)) - 'keymap - 'local-map)) - -(defsubst emacs-wiki-link-properties (help-str &optional face) - (append (if face - (list 'face face 'rear-nonsticky t - emacs-wiki-keymap-property emacs-wiki-local-map) - (list 'invisible t 'intangible t 'rear-nonsticky t - emacs-wiki-keymap-property emacs-wiki-local-map)) - (list 'mouse-face 'highlight - 'help-echo help-str - emacs-wiki-keymap-property emacs-wiki-local-map))) - -(defun emacs-wiki-highlight-link () - (if (eq ?\[ (char-after (match-beginning 0))) - (if (and emacs-wiki-inline-images - (save-match-data - (string-match emacs-wiki-image-regexp (match-string 4)))) - (emacs-wiki-inline-image (match-beginning 0) (match-end 0) - (match-string 4) (match-string 6)) - (let* ((link (match-string-no-properties 4)) - (invis-props (emacs-wiki-link-properties link)) - (props (emacs-wiki-link-properties link 'emacs-wiki-link-face))) - (if (match-string 6) - (progn - (add-text-properties (match-beginning 0) - (match-beginning 6) invis-props) - (add-text-properties (match-beginning 6) (match-end 6) props) - (add-text-properties (match-end 6) (match-end 0) invis-props)) - (add-text-properties (match-beginning 0) - (match-beginning 4) invis-props) - (add-text-properties (match-beginning 4) (match-end 0) props) - (add-text-properties (match-end 4) (match-end 0) invis-props))) - (goto-char (match-end 0))) - (if (and emacs-wiki-inline-images - (save-match-data - (string-match emacs-wiki-image-regexp (match-string 0)))) - (emacs-wiki-inline-image (match-beginning 0) (match-end 0) - (match-string 0)) - (add-text-properties - (match-beginning 0) (match-end 0) - (emacs-wiki-link-properties - (match-string-no-properties 0) - (if (let ((base (emacs-wiki-wiki-base (match-string 0)))) - (or (emacs-wiki-page-file base t) - (save-match-data - (string-match "\\(/\\|\\`[a-z]\\{3,6\\}:\\)" base)))) - 'emacs-wiki-link-face - 'emacs-wiki-bad-link-face))) - (goto-char (match-end 0))))) - -(defun emacs-wiki-inline-image (beg end url &optional desc) - "Inline locally available images." - (let ((filename - (cond - ((string-match "\\`file:\\(.+\\)" url) - (match-string 1 url)) - ((string-match "/" url) - (expand-file-name url (symbol-value - emacs-wiki-inline-relative-to)))))) - (if (and filename (file-readable-p filename)) - (add-text-properties beg end (list 'display (create-image filename) - 'help-echo (or desc url)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Emacs Wiki Publishing (to HTML by default) -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup emacs-wiki-publish nil - "Options controlling the behaviour of Emacs Wiki publishing. -See `emacs-wiki-publish' for more information." - :group 'emacs-wiki) - -(defcustom emacs-wiki-maintainer (concat "mailto:webmaster@" (system-name)) - "URL where the maintainer can be reached." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-home-page emacs-wiki-default-page - "Title of the Wiki Home page." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-index-page "WikiIndex" - "Title of the Wiki Index page." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-downcase-title-words - '("the" "and" "at" "on" "of" "for" "in" "an" "a") - "Strings that should be downcased in a Wiki page title." - :type '(repeat string) - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-use-mode-flags (not emacs-wiki-under-windows-p) - "If non-nil, use file mode flags to determine page permissions. -Otherwise the regexps in `emacs-wiki-private-pages' and -`emacs-wiki-editable-pages' are used." - :type 'boolean - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-private-pages nil - "A list of regexps to exclude from public view. -This variable only applies if `emacs-wiki-use-mode-flags' is nil." - :type '(choice (const nil) (repeat regexp)) - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-editable-pages nil - "A list of regexps of pages that may be edited via HTTP. -This variable only applies if `emacs-wiki-use-mode-flags' is nil." - :type '(choice (const nil) (repeat regexp)) - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-publishing-directory "~/WebWiki" - "Directory where all wikis are published to." - :type 'directory - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-publishing-file-prefix "" - "This prefix will be prepended to all wiki names when publishing." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-publishing-file-suffix ".html" - "This suffix will be appended to all wiki names when publishing." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-before-markup-hook nil - "A hook run in the buffer where markup is done, before it is done." - :type 'hook - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-after-markup-hook nil - "A hook run in the buffer where markup is done, after it is done." - :type 'hook - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-meta-http-equiv "Content-Type" - "The http-equiv attribute used for the HTML <meta> tag." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-meta-content-type "text/html" - "The content type used for the HTML <meta> tag." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-meta-content-coding - (if (featurep 'mule) - 'detect - "iso-8859-1") - "If set to the symbol 'detect, use `emacs-wiki-coding-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 'emacs-wiki-publish) - -(defcustom emacs-wiki-charset-default "iso-8859-1" - "The default HTML meta charset to use if no translation is found in - `emacs-wiki-coding-map'" - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-coding-default 'iso-8859-1 - "The default emacs coding use if no special characters are found" - :type 'symbol - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-coding-map - '((iso-2022-jp "iso-2022-jp") - (utf-8 "utf-8") - (japanese-iso-8bit "euc-jp")) - "An alist mapping emacs coding systems to appropriate HTML charsets. - Use the base name of the coding system (ie, without the -unix)" - :type '(alist :key-type coding-system :value-type (group string)) - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-redirect-delay 1 - "The number of seconds to delay before doing a page redirect." - :type 'integer - :group 'emacs-wiki-publish) - -(defvar emacs-wiki-current-page-title nil - "Current page title, used instead of buffer name if non-nil. -This is usually set by code called by `emacs-wiki-publishing-markup'. -It should never be changed globally.") - -(defcustom emacs-wiki-anchor-on-word nil - "When true, anchors surround the closest word. This allows you -to select them in a browser (ie, for pasting), but has the -side-effect of marking up headers in multiple colours if your -header style is different to your link style." - :type 'boolean - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-publishing-header - "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"> -<html> - <head> - <title><lisp>(emacs-wiki-page-title)</lisp></title> - <meta name=\"generator\" content=\"emacs-wiki.el\"> - <meta http-equiv=\"<lisp>emacs-wiki-meta-http-equiv</lisp>\" - content=\"<lisp>emacs-wiki-meta-content</lisp>\"> - <link rev=\"made\" href=\"<lisp>emacs-wiki-maintainer</lisp>\"> - <link rel=\"home\" href=\"<lisp>(emacs-wiki-published-name - emacs-wiki-home-page)</lisp>\"> - <link rel=\"index\" href=\"<lisp>(emacs-wiki-published-name - emacs-wiki-index-page)</lisp>\"> - <lisp>emacs-wiki-style-sheet</lisp> - </head> - <body> - <h1><lisp>(emacs-wiki-page-title)</lisp></h1> - <!-- Page published by Emacs Wiki begins here -->\n" - "Text to prepend to a wiki being published. -This text may contain <lisp> markup tags." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-publishing-footer - " - <!-- Page published by Emacs Wiki ends here --> - <div class=\"navfoot\"> - <hr> - <table width=\"100%\" border=\"0\" summary=\"Footer navigation\"> - <tr> - <td width=\"33%\" align=\"left\"> - <lisp> - (if buffer-file-name - (concat - \"<span class=\\\"footdate\\\">Updated: \" - (format-time-string emacs-wiki-footer-date-format - (nth 5 (file-attributes buffer-file-name))) - (and emacs-wiki-serving-p - (emacs-wiki-editable-p (emacs-wiki-page-name)) - (concat - \" / \" - (emacs-wiki-link-href - (concat \"editwiki?\" (emacs-wiki-page-name)) - \"Edit\"))) - \"</span>\")) - </lisp> - </td> - <td width=\"34%\" align=\"center\"> - <span class=\"foothome\"> - <lisp> - (concat - (and (emacs-wiki-page-file emacs-wiki-home-page t) - (not (emacs-wiki-private-p emacs-wiki-home-page)) - (concat - (emacs-wiki-link-href emacs-wiki-home-page \"Home\") - \" / \")) - (emacs-wiki-link-href emacs-wiki-index-page \"Index\") - (and (emacs-wiki-page-file \"ChangeLog\" t) - (not (emacs-wiki-private-p \"ChangeLog\")) - (concat - \" / \" - (emacs-wiki-link-href \"ChangeLog\" \"Changes\")))) - </lisp> - </span> - </td> - <td width=\"33%\" align=\"right\"> - <lisp> - (if emacs-wiki-serving-p - (concat - \"<span class=\\\"footfeed\\\">\" - (emacs-wiki-link-href \"searchwiki?get\" \"Search\") - (and buffer-file-name - (concat - \" / \" - (emacs-wiki-link-href - (concat \"searchwiki?q=\" (emacs-wiki-page-name)) - \"Referrers\"))) - \"</span>\")) - </lisp> - </td> - </tr> - </table> - </div> - </body> -</html>\n" - "Text to append to a wiki being published. -This text may contain <lisp> markup tags." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-footer-date-format "%Y-%m-%d" - "Format of current date for `emacs-wiki-publishing-footer'. -This string must be a valid argument to `format-time-string'." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-style-sheet - "<style type=\"text/css\"> -a.nonexistent { - font-weight: bold; - background-color: #F8F8F8; color: #FF2222; -} - -a.nonexistent:visited { - background-color: #F8F8F8; color: #FF2222; -} - -body { - background: white; color: black; - margin-left: 5%; margin-right: 5%; - margin-top: 3%; -} - -em { font-style: italic; } -strong { font-weight: bold; } - -ul { list-style-type: disc } - -dl.contents { margin-top: 0; } -dt.contents { margin-bottom: 0; } - -p.verse { - white-space: pre; - margin-left: 5%; -} - -pre { - white-space: pre; - font-family: monospace; - margin-left: 5%; -} -</style>" - "The style sheet used for each wiki page. -This can either be an inline stylesheet, using <style></style> tags, -or an external stylesheet reference using a <link> tag. - -Here is an example of using a <link> tag: - - <link rel=\"stylesheet\" type=\"text/css\" href=\"emacs-wiki.css\">" - :type 'string - :group 'emacs-wiki-publish) - -(defvar emacs-wiki-publishing-p nil - "Set to t while Wiki pages are being published. -This can be used by <lisp> tags to know when HTML is being generated.") - -(defcustom emacs-wiki-block-groups-regexp - "\\(h[1-9r]\\|[oud]l\\|table\\|center\\|blockquote\\|pre\\)[^>]*" - "This regexp identifies HTML tag which defines their own blocks. -That is, they do not need to be surrounded by <p>." - :type 'regexp - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-table-attributes "border=\"2\" cellpadding=\"5\"" - "The attribute to be used with HTML <table> tags. -Note that since emacs-wiki support direct insertion of HTML tags, you -can easily create any kind of table you want, as long as every line -begins at column 0 (to prevent it from being blockquote'd). To make -really ANYTHING you want, use this idiom: - - <verbatim> - <table> - [... contents of my table, in raw HTML ...] - </verbatim></table> - -It may look strange to have the tags out of sequence, but remember -that verbatim is processed long before table is even seen." - :type 'string - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-report-threshhold 100000 - "If a Wiki file is this size or larger, report publishing progress." - :type 'integer - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-publishing-markup - (list - ["&\\([-A-Za-z_#0-9]+\\);" 0 emacs-wiki-markup-entity] - - ;; change the displayed title or the stylesheet for a given page - ["\\`#\\(title\\|style\\)\\s-+\\(.+\\)\n+" 0 - emacs-wiki-markup-initial-directives] - - ;; process any markup tags - [emacs-wiki-tag-regexp 0 emacs-wiki-markup-custom-tags] - - ;; emphasized or literal text - ["\\(^\\|[-[ \t\n<('`\"]\\)\\(=[^= \t\n]\\|_[^_ \t\n]\\|\\*+[^* \t\n]\\)" - 2 emacs-wiki-markup-word] - - ;; headings, outline-mode style - ["^\\(\\*+\\)\\s-+" 0 emacs-wiki-markup-heading] - - ;; define anchor points - ["^#\\([A-Za-z0-9_%]+\\)\\s-*" 0 emacs-wiki-markup-anchor] - - ;; horizontal rule, or section separator - ["^----+" 0 "<hr>"] - - ;; footnotes section is separated by a horizontal rule in HTML - ["^\\(\\* \\)?Footnotes:?\\s-*" 0 "<hr>\n<p>\n"] - ;; footnote definition/reference (def if at beginning of line) - ["\\[\\([1-9][0-9]*\\)\\]" 0 emacs-wiki-markup-footnote] - - ;; don't require newlines between numbered and unnumbered lists. - ;; This must come before paragraphs are calculated, so that any - ;; extra newlines added will be condensed. - ["^\\s-*\\(-\\|[0-9]+\\.\\)" 1 "\n\\1"] - - ;; the beginning of the buffer begins the first paragraph - ["\\`\n*" 0 "<p>\n"] - ;; plain paragraph separator - ["\n\\([ \t]*\n\\)+" 0 "\n\n</p>\n\n<p>\n"] - - ;; if table.el was loaded, allow for pretty tables. otherwise only - ;; simple table markup is supported, nothing fancy. use | to - ;; separate cells, || to separate header elements, and ||| for - ;; footer elements - (vector - (if (featurep 'table) - "^\\(\\s-*\\)\\(\\+[-+]+\\+[\n\r \t]+|\\)" - "^\\s-*\\(\\([^|\n]+\\(|+\\)\\s-*\\)+\\)\\([^|\n]+\\)?$") - 1 'emacs-wiki-markup-table) - - ;; 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. - ["^\\(\\s-*\\(-\\|[0-9]+\\.\\|\\(.+\\)[ \t]+::\n?\\)\\)?\\([ \t]+\\)" 4 - emacs-wiki-markup-list-or-paragraph] - - ;; "verse" text is indicated the same way as a quoted e-mail - ;; response: "> text", where text may contain initial whitespace - ;; (see below). - ["<p>\\s-+> \\(\\([^\n]\n?\\)+\\)\\(\\s-*</p>\\)?" 0 - emacs-wiki-markup-verse] - - ;; join together the parts of a list - ["</\\([oud]l\\)>\\s-*\\(</p>\\s-*<p>\\s-*\\)?<\\1>\\s-*" 0 ""] - - ;; join together the parts of a table - (vector - (concat "</tbody>\\s-*" - "</table>\\s-*" "\\(</p>\\s-*<p>\\s-*\\)?" "<table[^>]*>\\s-*" - "<tbody>\\s-*") 0 "") - ["</table>\\s-*\\(</p>\\s-*<p>\\s-*\\)?<table[^>]*>\\s-*" 0 ""] - - ;; fixup paragraph delimiters - (vector - (concat "<p>\\s-*\\(</?" emacs-wiki-block-groups-regexp ">\\)") 0 "\\1") - (vector (concat "\\(</?" emacs-wiki-block-groups-regexp - ">\\)\\s-*\\(</p>\\)") 3 "\\1") - - ;; terminate open paragraph at the end of the buffer - ["<p>\\s-*\\'" 0 ""] - ;; make sure to close any open text (paragraphs) - ["\\([^> \t\n]\\)\\s-*\\'" 0 "\\1\n</p>"] - ;; lists have no whitespace after them, so add a final linebreak - ["\\(</[oud]l>\\)\\(\\s-*\\(<hr>\\|\\'\\)\\)" 0 "\\1\n<br>\\2"] - - ;; replace WikiLinks in the buffer (links to other pages) - ;; <nop> before a WikiName guards it from being replaced - ;; '''' can be used to add suffixes, such as WikiName''''s - [emacs-wiki-url-or-name-regexp 0 emacs-wiki-markup-link] - ["''''" 0 ""] - - ;; bare email addresses - (vector - (concat - "\\([^:.@/a-zA-Z0-9]\\)" - "\\([-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+\\)" - "\\([^\"a-zA-Z0-9]\\)") - 0 - "\\1<a href=\"mailto:\\2\">\\2</a>\\4") - - ;; replace quotes, since most browsers don't understand `` and '' - ["\\(``\\|''\\)" 0 "\""] - - ;; insert the default publishing header - (function - (lambda () - (insert emacs-wiki-publishing-header))) - - ;; insert the default publishing footer - (function - (lambda () - (goto-char (point-max)) - (insert emacs-wiki-publishing-footer))) - - ;; process any remaining markup tags - [emacs-wiki-tag-regexp 0 emacs-wiki-markup-custom-tags]) - "List of markup rules to apply when publishing a Wiki page. -Each member of the list is either a function, or a vector 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 be bound to nil while -processing the markup rules. - -Here is a description of the default markup rules: - -Headings - - * First level - ** Second level - *** Third level - - Note that the first level is actually indicated using H2, so that - it doesn't appear at the same level as the page heading (which - conceptually titles the section of that Wiki page). - -Horizontal rules - ----- - -Emphasis - - *emphasis* - **strong emphasis** - ***very strong emphasis*** - _underlined text_ - =verbatim= - - <verbatim>This tag should be used for larger blocks of - text</verbatim>. - -Footnotes - - A reference[1], which is just a number in square brackets, - constitutes a footnote reference. - - Footnotes: - - [1] 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. - -Paragraphs - - One or more blank lines separates paragraphs. - -Centered paragraphs and quotations - - A line that begins with six or more columns of whitespace (made up - of tabs or spaces) indicates a centered paragraph. I assume this - because it's expected you will use M-s to center the line, which - usually adds a lot of whitespace before it. - - If a line begins with some whitespace, but less than six columns, it - indicates a quoted paragraph. - -Poetic verse - - Poetry requires that whitespace be preserved, without resorting to - the monospace typical of <pre>. For this, the following special - markup exists, which is reminiscent of e-mail 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> - -Literal paragraphs - - Use the HTML tags <pre></pre> to insert a paragraph and preserve - whitespace. If you're inserting a block of code, you will almost - always want to use <verbatim></verbatim> *within* the <pre> tags. - The shorcut for doing this is to use the <example> tag: - - <example> - Some literal text or code here. - </example> - -Lists - - - bullet list - - 1. Enumerated list - - Term :: A definition list - - Blank lines between list elements are optional, but required between - members of a definition list. - -Tables - - There are two forms of table markup supported. If Takaaki Ota's - table.el package is available, then simply create your tables using - his package, and they will be rendered into the appropriate HTML. - - If table.el is not available, then only very simple table markup is - supported. The attributes of the table are kept in - `emacs-wiki-table-attributes'. The syntax is: - - Double bars || Separate header fields - Single bars | Separate body fields - Here are more | body fields - Triple bars ||| Separate footer fields - - Other paragraph markup applies to both styles, meaning that if six - or more columns of whitespace precedes the first line of the table, - it will be centered, and if any whitespace at all precedes first - line, it will occur in a blockquote. - -Anchors and tagged links - - #example 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 anchor text is not - displayed. - - You can reference an anchored point in another page (or even in the - current page) using WikiName#anchor. The #anchor will never be - displayed in HTML, whether at the point of definition or reference, - but it will cause browsers to jump to that point in the document. - -Redirecting to another page or URL - - Sometimes you may wish to redirect someone to another page. To do - this, put: - - <redirect url=\"http://somewhereelse.com\"/> - - at the top of the page. If the <redirect> tag specifies content, - this will be used as the redirection message, rather than the - default. - - The numbers of seconds to delay is defined by - `emacs-wiki-redirect-delay', which defaults to 2 seconds. The page - shown will also contain a link to click on, for browsing which do - not support automatic refreshing. - -URLs - - A regular URL is given as a link. If it's an image URL, it will - be inlined using an IMG tag. - -Embedded lisp - - <lisp>(concat \"This form gets\" \"inserted\")</lisp> - -Special handling of WikiNames - - If you need to add a plural at the end of a WikiName, separate it - with four single quotes: WikiName''''s. - - To prevent a link name (of any type) from being treated as such, - surround it with =equals= (to display it in monotype), or prefix it - with the tag <nop>. - -Special Wiki links - - Besides the normal WikiName type links, emacs-wiki also supports - extended links: - - [[link text][optional link description]] - - An extended link is always a link, no matter how it looks. This - means you can use any file in your `emacs-wiki-directories' as a - Wiki file. If you provide an optional description, that's what will - be shown instead of the link text. This is very useful for - providing textual description of URLs. - - See the documentation to emacs-wiki-image-regexp for how to inline - files and images. - -InterWiki names - - There are times when you will want to constantly reference pages on - another website. Rather than repeating the URL ad nauseum, you can - define an InterWiki name. This is a set of WikiNames to URL - correlations, that support textual substitution using #anchor names - (which are appended to the URL). For example, MeatballWiki is - defined in the variable `emacs-wiki-interwiki-names'. It means you - can reference the page \"MeatBall\" on MeatballWiki using this - syntax: - - MeatballWiki#MeatBall - - In the resulting HTML, the link is simply shown as - \"MeatballWiki:MeatBall\"." - :type '(repeat - (choice - (vector :tag "Markup rule" - (choice regexp symbol) - integer - (choice string function symbol)) - function)) - :group 'emacs-wiki-publish) - -(defcustom emacs-wiki-changelog-markup - (list - ;; process any custom markup tags - [emacs-wiki-tag-regexp 0 emacs-wiki-markup-custom-tags] - - ["&" 0 "&"] - ["<" 0 "<"] - [">" 0 ">"] - - ["^\\(\\S-+\\)\\s-+\\(.+\\)" 0 emacs-wiki-markup-changelog-section] - - ;; emphasized or literal text - ["\\(^\\|[-[ \t\n<('`\"]\\)\\(=[^= \t\n]\\|_[^_ \t\n]\\|\\*+[^* \t\n]\\)" - 2 emacs-wiki-markup-word] - - ;; headings, outline-mode style - ["^\\*\\s-+\\(.+\\)$" 0 "<h2>\\1</h2>"] - - ;; escape the 'file' entries, incase they are extended wiki links - ["^[ \t]+\\* \\([^:(]+\\)\\([ \t]+(\\|:\\)" 0 emacs-wiki-changelog-escape-files] - - ;; don't require newlines between unnumbered lists. - ["^\\s-*\\(\\*\\)" 1 "\n\\1"] - - ;; the beginning of the buffer begins the first paragraph - ["\\`\n*" 0 "<p>\n"] - ;; plain paragraph separator - ["\n\\([ \t]*\n\\)+" 0 "\n\n</p>\n\n<p>\n"] - - ;; 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. - ["^\\(\\s-*\\(\\*\\)\\)?\\([ \t]+\\)\\(\\([^\n]\n?\\)+\\)" 3 - "<ul>\n<li>\\4</ul>\n"] - - ;; join together the parts of a list - ["</\\([oud]l\\)>\\s-*\\(</p>\\s-*<p>\\s-*\\)?<\\1>\\s-*" 0 ""] - - ;; fixup paragraph delimiters - (vector - (concat "<p>\\s-*\\(</?" emacs-wiki-block-groups-regexp ">\\)") 0 "\\1") - (vector (concat "\\(</?" emacs-wiki-block-groups-regexp - ">\\)\\s-*\\(</p>\\)") 3 "\\1") - - ;; terminate open paragraph at the end of the buffer - ["<p>\\s-*\\'" 0 ""] - ;; make sure to close any open text (paragraphs) - ["\\([^> \t\n]\\)\\s-*\\'" 0 "\\1\n</p>"] - ;; lists have no whitespace after them, so add a final linebreak - ["\\(</[oud]l>\\)\\(\\s-*\\(<hr>\\|\\'\\)\\)" 0 "\\1\n<br>\\2"] - - ;; bare email addresses - (vector - (concat - "\\([^:.@/a-zA-Z0-9]\\)" - "\\([-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+\\)" - "\\([^\"a-zA-Z0-9]\\)") - 0 - "\\1<a href=\"mailto:\\2\">\\2</a>\\4") - - ;; replace WikiLinks in the buffer (links to other pages) - [emacs-wiki-url-or-name-regexp 0 emacs-wiki-markup-link] - ["''''" 0 ""] - - ;; insert the default publishing header - (function - (lambda () - (insert emacs-wiki-publishing-header))) - - ;; insert the default publishing footer - (function - (lambda () - (goto-char (point-max)) - (insert emacs-wiki-publishing-footer)))) - "List of markup rules for publishing ChangeLog files. -These are used when the wiki page's name is ChangeLog." - :type '(repeat - (choice - (vector :tag "Markup rule" - (choice regexp symbol) - integer - (choice string function symbol)) - function)) - :group 'emacs-wiki-publish) - -(defun emacs-wiki-transform-content-type (content-type) - "Using `emacs-wiki-coding-map', try and resolve an emacs coding - system to an associated HTML coding system. If no match is found, - `emacs-wiki-charset-default' is used instead." - (let ((match (assoc (coding-system-base content-type) - emacs-wiki-coding-map))) - (if match - (cadr match) - emacs-wiki-charset-default))) - -(defun emacs-wiki-private-p (name) - "Return non-nil if NAME is a private page, and shouldn't be published." - (if name - (if emacs-wiki-use-mode-flags - (let* ((page-file (emacs-wiki-page-file name t)) - (filename (and page-file (file-truename page-file)))) - (if filename - (or (eq ?- (aref (nth 8 (file-attributes - (file-name-directory filename))) 7)) - (eq ?- (aref (nth 8 (file-attributes filename)) 7))))) - (let ((private-pages emacs-wiki-private-pages) private) - (while private-pages - (if (string-match (car private-pages) name) - (setq private t private-pages nil) - (setq private-pages (cdr private-pages)))) - private)))) - -(defun emacs-wiki-editable-p (name) - "Return non-nil if NAME is a page that may be publically edited. -If the page does not exist, the page will be created if: mode flags -are not being checked, and it is a page listed in -`emacs-wiki-editable-pages', or the first directory in -`emacs-wiki-directories' is writable. In either case, the new page -will be created in the first directory in `emacs-wiki-directories'." - (if (and name emacs-wiki-http-support-editing) - (if emacs-wiki-use-mode-flags - (let ((filename - (file-truename - (or (emacs-wiki-page-file name t) - (expand-file-name name (car emacs-wiki-directories)))))) - (if (file-exists-p filename) - (eq ?w (aref (nth 8 (file-attributes filename)) 8)) - (eq ?w (aref (nth 8 (file-attributes - (file-name-directory filename))) 8)))) - (let ((editable-pages emacs-wiki-editable-pages) editable) - (while editable-pages - (if (string-match (car editable-pages) name) - (setq editable t editable-pages nil) - (setq editable-pages (cdr editable-pages)))) - editable)))) - -(defun emacs-wiki-visit-published-file (&optional arg) - "Visit the current wiki page's published result." - (interactive "P") - (if arg - (find-file-other-window (emacs-wiki-published-file)) - (funcall emacs-wiki-browse-url-function - (concat "file:" (emacs-wiki-published-file))))) - -(defun emacs-wiki-dired-publish () - "Publish all marked files in a dired buffer." - (interactive) - (emacs-wiki-publish-files (dired-get-marked-files) t)) - -(defun emacs-wiki-prettify-title (title) - "Prettify the given TITLE." - (save-match-data - (let ((case-fold-search nil)) - (while (string-match "\\([A-Za-z]\\)\\([A-Z0-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)) - emacs-wiki-downcase-title-words) - (setcar w (downcase (car w)))) - (setq w (cdr w))) - (mapconcat 'identity words " "))))) - -(defun emacs-wiki-publish (&optional arg) - "Publish all wikis that need publishing. -If the published wiki already exists, it is only overwritten if the -wiki is newer than the published copy. When given the optional -argument ARG, all wikis are rewritten, no matter how recent they are. -The index file is rewritten no matter what." - (interactive "P") - ;; prompt to save any emacs-wiki buffers - (save-some-buffers nil (lambda () - (eq major-mode 'emacs-wiki-mode))) - ;; ensure the publishing location is available - (unless (file-exists-p emacs-wiki-publishing-directory) - (message "Creating publishing directory %s" - emacs-wiki-publishing-directory) - (make-directory emacs-wiki-publishing-directory)) - (if (emacs-wiki-publish-files - (let* ((names (emacs-wiki-file-alist)) - (files (list t)) - (lfiles files)) - (while names - (setcdr lfiles (cons (cdar names) nil)) - (setq lfiles (cdr lfiles) - names (cdr names))) - (cdr files)) arg) - ;; republish the index if any pages were published - (with-current-buffer (emacs-wiki-generate-index t t) - (emacs-wiki-replace-markup emacs-wiki-index-page) - (let ((backup-inhibited t)) - (write-file (emacs-wiki-published-file emacs-wiki-index-page))) - (kill-buffer (current-buffer)) - (message "All Wiki pages%s have been published." - (if emacs-wiki-current-project - (concat " for project " emacs-wiki-current-project) - ""))) - (message "No Wiki pages%s need publishing at this time." - (if emacs-wiki-current-project - (concat " in project " emacs-wiki-current-project) - "")))) - -(defun emacs-wiki-publish-this-page () - "Force publication of the current page." - (interactive) - (emacs-wiki-publish-files (list buffer-file-name) t)) - -(defun emacs-wiki-publish-files (files force) - "Publish all files in list FILES. -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." - (let (published-some file page published) - (while files - (setq file (car files) - files (cdr files) - page (emacs-wiki-page-name file) - published (emacs-wiki-published-file page)) - (if (and (not (emacs-wiki-private-p page)) - (or force (file-newer-than-file-p file published))) - (with-temp-buffer - (insert-file-contents file t) - (cd (file-name-directory file)) - (emacs-wiki-maybe) - (emacs-wiki-replace-markup) - (let ((backup-inhibited t) - (buffer-file-coding-system - (when (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) - (when (eq buffer-file-coding-system 'undecided-unix) - ;; make it agree with the default charset - (setq buffer-file-coding-system - emacs-wiki-coding-default)) - (write-file published)) - (setq published-some t)))) - published-some)) - - - -(defun emacs-wiki-escape-html-specials (&optional end) - (while (and (or (< (point) end) (not end)) - (re-search-forward "[<>&\"]" end t)) - (cond - ((eq (char-before) ?\") - (delete-char -1) - (insert """)) - ((eq (char-before) ?\<) - (delete-char -1) - (insert "<")) - ((eq (char-before) ?\>) - (delete-char -1) - (insert ">")) - ((eq (char-before) ?\&) - (delete-char -1) - (insert "&"))))) - -;; we currently only do this on links. this means a stray '&' in an -;; emacs-wiki document risks being misinterpreted when being published, but -;; this is the price we pay to be able to inline HTML content without special -;; tags. -(defun emacs-wiki-escape-html-string (str) - "Convert to character entities any non alphanumeric characters outside of a - few punctuation symbols, that risk being misinterpreted if not escaped" - (when str - (let (pos code len) - (save-match-data - (while (setq pos (string-match "[^-[:alnum:]/:._=@\\?~#]" str pos)) - (setq code (int-to-string (aref str pos)) - len (length code) - str (replace-match (concat "&#" code ";") nil nil str) - pos (+ 3 len pos))) - str)))) - -(defun emacs-wiki-replace-markup (&optional title) - "Replace markup according to `emacs-wiki-publishing-markup'." - (let* ((emacs-wiki-meta-http-equiv emacs-wiki-meta-http-equiv) - (emacs-wiki-current-page-title title) - (emacs-wiki-publishing-p t) - (case-fold-search nil) - (inhibit-read-only t) - (rules (if (string= (emacs-wiki-page-name) "ChangeLog") - emacs-wiki-changelog-markup - emacs-wiki-publishing-markup)) - (limit (* (length rules) (point-max))) - (verbose (and emacs-wiki-report-threshhold - (> (point-max) emacs-wiki-report-threshhold))) - (base 0) - (emacs-wiki-meta-content - (concat emacs-wiki-meta-content-type "; charset=" - (if (stringp emacs-wiki-meta-content-coding) - emacs-wiki-meta-content-coding - (emacs-wiki-transform-content-type - (or buffer-file-coding-system - emacs-wiki-coding-default)))))) - (run-hooks 'emacs-wiki-before-markup-hook) - (while rules - (goto-char (point-min)) - (if (functionp (car rules)) - (funcall (car rules)) - (let ((regexp (aref (car rules) 0)) - (group (aref (car rules) 1)) - (replacement (aref (car rules) 2)) - start last-pos pos) - (if (symbolp regexp) - (setq regexp (symbol-value regexp))) - (if verbose - (message "Publishing %s...%d%%" - (emacs-wiki-page-name) - (* (/ (float (+ (point) base)) limit) 100))) - (while (and regexp (setq pos (re-search-forward regexp nil t))) - (if verbose - (message "Publishing %s...%d%%" - (emacs-wiki-page-name) - (* (/ (float (+ (point) base)) limit) 100))) - (unless (get-text-property (match-beginning group) 'read-only) - (let ((text (cond - ((functionp replacement) - (funcall replacement)) - ((symbolp replacement) - (symbol-value replacement)) - (t replacement)))) - (when text - (condition-case nil - (replace-match text t) - (error - (replace-match "[FIXME: invalid characters]" t)))))) - (if (and last-pos (= pos last-pos)) - (if (eobp) - (setq regexp nil) - (forward-char 1))) - (setq last-pos pos)))) - (setq rules (cdr rules) - base (+ base (point-max)))) - (run-hooks 'emacs-wiki-after-markup-hook) - (if verbose - (message "Publishing %s...done" (emacs-wiki-page-name))))) - -(defun emacs-wiki-custom-tags (&optional highlight-p) - (let ((tag-info (or (assoc (match-string 1) emacs-wiki-markup-tags) - (assoc (match-string 1) emacs-wiki-dangerous-tags)))) - (when (and tag-info (or (not highlight-p) - (nth 3 tag-info))) - (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 - "\\([^ \t\n=]+\\)\\(=\"\\([^\"]+\\)\"\\)?" attrstr)) - (let ((attr (cons (downcase - (match-string-no-properties 1 attrstr)) - (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 (search-forward (concat "</" (car tag-info) ">") nil t) - (unless highlight-p - (delete-region (match-beginning 0) (point))) - (setq tag-info nil))) - (when tag-info - (setq end (point-marker)) - (unless highlight-p - (delete-region start beg)) - (goto-char (if highlight-p beg start)) - (let ((args (list start end))) - (if (nth 2 tag-info) - (nconc args (list attrs))) - (if (nth 3 tag-info) - (nconc args (list highlight-p))) - (apply (nth 4 tag-info) args)))))) - nil) - -(defun emacs-wiki-markup-initial-directives () - (cond - ((string= (match-string 1) "title") - (set (make-local-variable 'emacs-wiki-current-page-title) (match-string 2))) - (t ;; "style" - (set (make-local-variable 'emacs-wiki-style-sheet) - (concat "<link rel=\"stylesheet\" type=\"text/css\" href=\"" - (match-string 2) "\">")))) - "") - -(defalias 'emacs-wiki-markup-custom-tags 'emacs-wiki-custom-tags) - -(defun emacs-wiki-highlight-title () - (add-text-properties (+ 7 (match-beginning 0)) - (line-end-position) - '(face emacs-wiki-header-1))) - -(defun emacs-wiki-highlight-custom-tags () - ;; Remove the match-data related to the url-or-name-regexp, which is - ;; part of emacs-wiki-highlight-regexp. All in the name of speed. - (let ((match-data (match-data))) - (setcdr (cdr match-data) - (nthcdr (* 2 (+ 2 emacs-wiki-url-or-name-regexp-group-count)) - match-data)) - (set-match-data match-data) - (emacs-wiki-custom-tags t))) - -(defun emacs-wiki-example-tag (beg end highlight-p) - (if highlight-p - (progn - (emacs-wiki-multiline-maybe beg end) - (goto-char end)) - (insert "<pre class=\"example\">") - (emacs-wiki-escape-html-specials end) - (when (< (point) end) - (goto-char end)) - (insert "</pre>") - (add-text-properties beg (point) '(rear-nonsticky (read-only) - read-only t)))) - -(defun emacs-wiki-verbatim-tag (beg end highlight-p) - (if highlight-p - (progn - (emacs-wiki-multiline-maybe beg end) - (goto-char end)) - (emacs-wiki-escape-html-specials end) - (add-text-properties beg end '(rear-nonsticky (read-only) - read-only t)))) - -(defun emacs-wiki-nowiki-tag (beg end highlight-p) - (if highlight-p - (goto-char end) - (add-text-properties - beg end '(read-nonsticky (read-only) read-only t)))) - -(defun emacs-wiki-verse-tag (beg end) - (save-excursion - (while (< (point) end) - (unless (eq (char-after) ?\n) - (insert "> ")) - (forward-line)))) - -(defvar emacs-wiki-numbered-counter 1) -(make-variable-buffer-local 'emacs-wiki-numbered-counter) - -(defun emacs-wiki-numbered-tag (beg end) - (save-excursion - (goto-char beg) - (setq end (copy-marker (1- end))) - (insert "<table cellspacing=\"8\">") - (insert (format "<tr><td valign=\"top\"><strong>%d</strong></td> -<td><p><a name=\"%d\"/>" emacs-wiki-numbered-counter - emacs-wiki-numbered-counter)) - (setq emacs-wiki-numbered-counter - (1+ emacs-wiki-numbered-counter)) - (while (and (< (point) end) - (re-search-forward "^$" end t)) - (replace-match (format "</p> -</td> -</tr><tr><td valign=\"top\"><strong>%d</strong></td><td> -<p><a name=\"%d\"/>" emacs-wiki-numbered-counter - emacs-wiki-numbered-counter)) - (setq emacs-wiki-numbered-counter - (1+ emacs-wiki-numbered-counter))) - (goto-char end) - (insert (format "</p> -</td></tr></table>" (1+ emacs-wiki-numbered-counter))))) - -(defun emacs-wiki-redirect-tag (beg end attrs) - (let ((link (cdr (assoc "url" attrs)))) - (when link - (setq emacs-wiki-meta-http-equiv "Refresh" - emacs-wiki-meta-content - (concat (or (cdr (assoc "delay" attrs)) - (int-to-string emacs-wiki-redirect-delay)) - ";\nURL=" (emacs-wiki-link-url link))) - (if (= beg end) - (insert "You should momentarily be redirected to [[" link "]].") - (goto-char end)) - (delete-region (point) (point-max))))) - -(defun emacs-wiki-nop-tag (beg end highlight-p) - (if highlight-p - (add-text-properties beg (point) '(invisible t intangible t))) - (when (looking-at emacs-wiki-name-regexp) - (goto-char (match-end 0)) - (unless highlight-p - (add-text-properties beg (point) - '(rear-nonsticky (read-only) read-only t))))) - -(defun emacs-wiki-insert-anchor (anchor) - "Insert an anchor, either around the word at point, or within a tag." - (skip-chars-forward " \t\n") - (if (looking-at "<\\([^ />]+\\)>") - (let ((tag (match-string 1))) - (goto-char (match-end 0)) - (insert "<a name=\"" anchor "\" id=\"" anchor "\">") - (when emacs-wiki-anchor-on-word - (or (and (search-forward (format "</%s>" tag) - (line-end-position) t) - (goto-char (match-beginning 0))) - (forward-word 1))) - (insert "</a>")) - (insert "<a name=\"" anchor "\" id=\"" anchor "\">") - (when emacs-wiki-anchor-on-word - (forward-word 1)) - (insert "</a>"))) - -(defun emacs-wiki-contents-tag (beg end attrs) - (let ((max-depth (let ((depth (cdr (assoc "depth" attrs)))) - (or (and depth (string-to-int depth)) 2))) - (index 1) - base contents l) - (save-excursion - (catch 'done - (while (re-search-forward "^\\(\\*+\\)\\s-+\\(.+\\)" nil t) - (setq l (length (match-string 1))) - (if (null base) - (setq base l) - (if (< l base) - (throw 'done t))) - (when (<= l max-depth) - (setq contents (cons (cons l (match-string-no-properties 2)) - contents)) - (goto-char (match-beginning 2)) - (emacs-wiki-insert-anchor (concat "sec" (int-to-string index))) - (setq index (1+ index)))))) - (setq index 1 contents (reverse contents)) - (let ((depth 1) (sub-open 0) (p (point))) - (insert "<dl class=\"contents\">\n") - (while contents - (insert "<dt class=\"contents\">\n") - (insert "<a href=\"#sec" (int-to-string index) "\">" - (cdar contents) - "</a>\n") - (setq index (1+ index)) - (insert "</dt>\n") - (setq depth (caar contents) - contents (cdr contents)) - (if contents - (cond - ((< (caar contents) depth) - (let ((idx (caar contents))) - (while (< idx depth) - (insert "</dl>\n</dd>\n") - (setq sub-open (1- sub-open) - idx (1+ idx))))) - ((> (caar contents) depth) ; can't jump more than one ahead - (insert "<dd>\n<dl class=\"contents\">\n") - (setq sub-open (1+ sub-open)))))) - (while (> sub-open 0) - (insert "</dl>\n</dd>\n") - (setq sub-open (1- sub-open))) - (insert "</dl>\n") - (put-text-property p (point) 'read-only t)))) - -(defun emacs-wiki-lisp-tag (beg end highlight-p) - (if highlight-p - (add-text-properties - beg end - (list 'font-lock-multiline t - 'display (emacs-wiki-eval-lisp - (buffer-substring-no-properties (+ beg 6) (- end 7))) - 'intangible t)) - (save-excursion - (insert (emacs-wiki-eval-lisp - (prog1 - (buffer-substring-no-properties beg end) - (delete-region beg end))))))) - -(defcustom emacs-wiki-command-default-file nil - "If non-nil, this default program to use with <command> tags. -If nil, Eshell is used, since it works on all platforms." - :type '(choice file (const :tag "Use Eshell" nil)) - :group 'emacs-wiki-publish) - -(defun emacs-wiki-command-tag (beg end attrs &optional highlight-p pre-tags) - (if highlight-p - (goto-char end) - (while (looking-at "\\s-*$") - (forward-line)) - (let ((interp (or (cdr (assoc "file" attrs)) - emacs-wiki-command-default-file))) - (if (null interp) - (eshell-command (prog1 - (buffer-substring-no-properties (point) end) - (delete-region beg end)) t) - (let ((file (make-temp-file "ewiki"))) - (unwind-protect - (let ((args (split-string interp))) - (write-region (point) end file) - (delete-region beg end) - (if pre-tags - (insert "<pre>\n")) - (apply 'call-process (car args) file t nil (cdr args)) - (while (eq (char-syntax (char-before)) ? ) - (backward-char)) - (add-text-properties beg (point) - '(rear-nonsticky (read-only) - read-only t)) - (if pre-tags - (insert "</pre>\n"))) - (if (file-exists-p file) - (delete-file file)))))))) - -(defcustom emacs-wiki-c-to-html - (if (or (featurep 'executable) - (load "executable" t t)) - (concat (executable-find "c2html") " -c -s")) - "Program to use to convert <c-source> tag text to HTML." - :type 'string - :group 'emacs-wiki-publish) - -(defun emacs-wiki-c-source-tag (beg end attrs highlight-p) - (if highlight-p - (goto-char end) - (if emacs-wiki-c-to-html - (let ((c-to-html emacs-wiki-c-to-html)) - (if (assoc "numbered" attrs) - (setq c-to-html (concat c-to-html " -n"))) - (emacs-wiki-command-tag beg end (list (cons "file" c-to-html)))) - (insert "<pre>") - (emacs-wiki-escape-html-specials end) - (goto-char end) - (add-text-properties beg (point) - '(rear-nonsticky (read-only) read-only t)) - (insert "</pre>")))) - -(defun emacs-wiki-python-tag (beg end attrs highlight-p) - (emacs-wiki-command-tag - beg end (list (cons "file" (executable-find "python"))) highlight-p t)) - -(defun emacs-wiki-perl-tag (beg end attrs highlight-p) - (emacs-wiki-command-tag - beg end (list (cons "file" (executable-find "perl"))) highlight-p t)) - -(defun emacs-wiki-insert-xbel-bookmarks (bmarks folder) - "Insert a set of XBEL bookmarks as an HTML list." - (while bmarks - (let ((bookmark (car bmarks))) - (cond - ((equal (xml-tag-name bookmark) "folder") - (let ((title (cadr (xml-tag-child bookmark "title")))) - (unless folder - (insert "<li>" title "\n<ul>\n")) - (emacs-wiki-insert-xbel-bookmarks (xml-tag-children bookmark) - (if (equal folder title) - nil - folder)) - (unless folder - (insert "</ul>\n")))) - ((equal (xml-tag-name bookmark) "bookmark") - (unless folder - (insert "<li><a href=\"" (xml-tag-attr bookmark "href") "\">" - (cadr (xml-tag-child bookmark "title")) "</a>\n"))))) - (setq bmarks (cdr bmarks)))) - -(defcustom emacs-wiki-xbel-bin-directory "/usr/bin" - "Directory where the xbel parsing utilities reside." - :type 'directory - :group 'emacs-wiki-publish) - -(defun emacs-wiki-bookmarks-tag (beg end attrs) - (require 'xml-parse) - (let ((filename (expand-file-name (cdr (assoc "file" attrs)))) - (type (cdr (assoc "type" attrs))) - (folder (cdr (assoc "folder" attrs))) - (this-buffer (current-buffer)) - buffer) - (when filename - (cond - (type - (setq buffer (get-buffer-create " *xbel_parse*")) - (with-current-buffer buffer - (erase-buffer) - (call-process - (format "%s/%s_parse" - (directory-file-name emacs-wiki-xbel-bin-directory) type) - nil t nil filename))) - (t - (setq buffer (find-file-noselect filename)))) - (insert "<ul>\n") - (emacs-wiki-insert-xbel-bookmarks - (with-current-buffer buffer - (goto-char (point-min)) - (when (re-search-forward "<!DOCTYPE\\s-+xbel" nil t) ; XBEL format - (goto-char (match-beginning 0)) - ;; the `cdr' is to skip the "title" child - (cdr (xml-tag-children (read-xml))))) folder) - (insert "</ul>\n") - (kill-buffer buffer))) - (while (eq (char-syntax (char-before)) ? ) - (backward-char)) - (add-text-properties beg (point) - '(rear-nonsticky (read-only) read-only t))) - -(defun emacs-wiki-link-url (wiki-link) - "Resolve the given WIKI-LINK into its ultimate URL form." - (let ((link (emacs-wiki-wiki-link-target wiki-link))) - (save-match-data - (if (or (emacs-wiki-wiki-url-p link) - (string-match emacs-wiki-image-regexp link) - (string-match emacs-wiki-file-regexp link)) - link - (if (assoc (emacs-wiki-wiki-base link) - (emacs-wiki-file-alist t)) - (if (string-match "#" link) - (concat (emacs-wiki-published-name - (substring link 0 (match-beginning 0)) - (emacs-wiki-page-name)) "#" - (substring link (match-end 0))) - (emacs-wiki-published-name link (emacs-wiki-page-name)))))))) - -(defsubst emacs-wiki-link-href (url name) - "Return an href string for URL and NAME." - (concat "<a href=\"" (emacs-wiki-published-name url) "\">" name "</a>")) - -(defun emacs-wiki-markup-link () - "Resolve the matched wiki-link into its ultimate <a href> form. -Images used the <img> tag." - ;; avoid marking up urls that appear to be inside existing HTML - (when (and (not (eq (char-after (point)) ?\")) - (not (eq (char-after (point)) ?\>))) - (let* ((wiki-link (match-string 0)) - (url (emacs-wiki-escape-html-string - (emacs-wiki-link-url wiki-link))) - (name (emacs-wiki-escape-html-string - (emacs-wiki-wiki-visible-name wiki-link)))) - (if (null url) - (if (and emacs-wiki-serving-p - (emacs-wiki-editable-p (emacs-wiki-wiki-base wiki-link))) - (concat "<a class=\"nonexistent\" href=\"editwiki?" - (emacs-wiki-wiki-base wiki-link) "\">" name "</a>") - (concat "<a class=\"nonexistent\" href=\"" - emacs-wiki-maintainer "\">" name "</a>")) - (if (save-match-data - (string-match emacs-wiki-image-regexp url)) - (concat "<img src=\"" url "\" alt=\"" name "\">") - (concat "<a href=\"" url "\">" name "</a>")))))) - -(defun emacs-wiki-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 multi-line) - (cond - ((string= leader "_") - (setq open-tag "<u>" close-tag "</u>")) - ((string= leader "=") - (setq open-tag "<code>" close-tag "</code>") - (setq mark-read-only t)) - (t - (setq multi-line t) - (let ((l (length leader))) - (cond - ((= l 1) (setq open-tag "<em>" close-tag "</em>")) - ((= l 2) (setq open-tag "<strong>" close-tag "</strong>")) - ((= l 3) (setq open-tag "<strong><em>" - close-tag "</em></strong>")))))) - (if (and (setq loc (search-forward leader nil t)) - (eq 0 (skip-syntax-forward "w" (1+ loc))) - (or multi-line (= 1 (count-lines beg loc)))) - (progn - (replace-match "") - (insert close-tag) - (save-excursion - (goto-char beg) - (delete-region beg end) - (insert open-tag)) - (if mark-read-only - (add-text-properties beg (point) - '(rear-nonsticky (read-only) read-only - t)))) - (backward-char)) - nil)) - -(defun emacs-wiki-markup-anchor () - (save-match-data - (emacs-wiki-insert-anchor (match-string 1))) - "") - -(defcustom emacs-wiki-entity-table - '(("#7779" . "s") - ("#7717" . "h") - ("#7789" . "t") - ("#7716" . "H") - ("#7826" . "Z")) - "Substitutions to use for HTML entities which are not fully -supported by all browsers -- in other words, we are pre-empting the -entity mechanism and providing our own textual equivalent. For -Unicode browsers, this is usually unnecessary." - :type 'sexp - :group 'emacs-wiki) - -(defun emacs-wiki-markup-entity () - (or (cdr (assoc (match-string 1) - emacs-wiki-entity-table)) - (concat "&" (match-string 1) ";"))) - -(defsubst emacs-wiki-surround-text (beg-tag end-tag move-func) - (insert beg-tag) - (funcall move-func) - (insert end-tag)) ; returns nil for us - -(defun emacs-wiki-markup-heading () - (let ((len (1+ (length (match-string 1))))) - (emacs-wiki-surround-text (format "<h%d>" len) (format "</h%d>" len) - 'end-of-line) - "")) - -(defun emacs-wiki-markup-footnote () - (if (/= (line-beginning-position) (match-beginning 0)) - "<sup><a name=\"fnr.\\1\" href=\"#fn.\\1\">\\1</a></sup>" - (prog1 - "<sup>[<a name=\"fn.\\1\" href=\"#fnr.\\1\">\\1</a>]</sup>" - (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 "^[ \t]+\\([^\n]\\)" end t) - (replace-match "\\1" t)))))))) - -(defsubst emacs-wiki-forward-paragraph () - (and (re-search-forward "^\\s-*$" nil t) - (match-beginning 0))) - -(defun emacs-wiki-markup-list-or-paragraph () - "Markup a list entry or quoted paragraph. -The reason this function is so funky, is to prevent text properties -like read-only from being inadvertently deleted." - (if (null (match-string 2)) - (let* ((ws (match-string 4)) - (tag (if (>= (string-width ws) 6) - "center" - "blockquote"))) - (unless (and (equal tag "blockquote") - (save-excursion - (forward-line) - (or (eolp) - (looking-at "\\S-")))) - (emacs-wiki-surround-text (format "<%s>\n<p>\n%s" tag ws) - (format "\n</p>\n</%s>\n" tag) - 'emacs-wiki-forward-paragraph))) - (let ((str (match-string 2))) - (cond - ((and (eq (aref str 0) ?-)) - (delete-region (match-beginning 0) (match-end 0)) - (emacs-wiki-surround-text - "<ul>\n<li>" "</li>\n</ul>\n" - (function - (lambda () - (and (re-search-forward "^\\s-*\\(-\\|$\\)" nil t) - (goto-char (match-beginning 0))))))) - ((and (>= (aref str 0) ?0) - (<= (aref str 0) ?9)) - (delete-region (match-beginning 0) (match-end 0)) - (emacs-wiki-surround-text - "<ol>\n<li>" "</li>\n</ol>\n" - (function - (lambda () - (and (re-search-forward "^\\s-*\\([0-9]+\\.\\|$\\)" nil t) - (goto-char (match-beginning 0))))))) - (t - (goto-char (match-beginning 0)) - (insert "<dl>\n<dt>") - (save-match-data - (when (re-search-forward "[ \t\n]+::[ \t\n]+" nil t) - (replace-match "</dt>\n<dd>\n"))) - (emacs-wiki-forward-paragraph) - (insert "</dd>\n</dl>\n")))))) - -(defun emacs-wiki-markup-table () - (if (featurep 'table) - (let ((leader (match-string 1)) - (begin (copy-marker (match-beginning 0))) - table end) - (goto-char (match-end 0)) - (setq table - (with-current-buffer (table-generate-source 'html) - (prog1 - (buffer-string) - (kill-buffer (current-buffer))))) - (goto-char begin) - (if (re-search-backward "<p>[ \t\n\r]+" nil t) - (replace-match (if (>= (string-width leader) 6) - "<center>\n" - (if (> (length leader) 0) - "<blockquote>\n" - "")))) - (delete-region begin (re-search-forward "-+\\+\\s-*[\r\n]+\\s-*$" - nil t)) - (insert table) - (setq end (point-marker)) - (goto-char begin) - (while (< (point) end) - (if (looking-at "^\\s-+") - (replace-match "")) - (forward-line)) - (goto-char end) - (if (re-search-forward "[ \t\n\r]+</p>" nil t) - (replace-match (if (>= (string-width leader) 6) - "\n</center>" - (if (> (length leader) 0) - "\n</blockquote>" - "")))) - (set-match-data (list begin begin begin begin)) - nil) - (let* ((str (save-match-data - (if (featurep 'xemacs) - ;; more emacs divergence. :( - (replace-in-string (match-string 1) " *|+ *$" "") - (match-string 1)))) - (fields - (append (save-match-data - (split-string str "[ \t]*|+[ \t]*")) - (list (match-string 4)))) - (len (length (match-string 3))) - (row (cond ((= len 1) "tbody") - ((= len 2) "thead") - ((= len 3) "tfoot"))) - (col (cond ((= len 1) "td") - ((= len 2) "th") - ((= len 3) "td")))) - (concat "<table " emacs-wiki-table-attributes ">\n" - "<" row ">\n" "<tr>\n<" col ">" - (mapconcat 'identity fields (format "</%s><%s>" col col)) - "</" col ">\n" "</tr>\n" "</" row ">\n" - "</table>\n")))) - -(defun emacs-wiki-markup-verse () - (save-match-data - (let* ((lines (split-string (match-string 1) "\n")) - (l lines)) - (while l - (if (and (> (length (car l)) 2) - (string-match "\\`\\s-*> " (car l))) - (setcar l (substring (car l) (match-end 0)))) - (setq l (cdr l))) - (concat "<p class=\"verse\">" - (mapconcat 'identity lines "\n") "</p>")))) - -(defcustom emacs-wiki-pretty-changelogs nil - "If non-nil, markup ChangeLog buffers using pretty tables. -This rule requires that a GIF file called \"onepixel.gif\" be in your -publication tree. Here is a uuencoded version of such a file: - -begin 644 onepixel.gif -M1TE&.#EA`0`!`*$``````/___________R'Y!`'__P$`+``````!``$```(\" -$3`$`.P`` -` -end" - :type 'boolean - :group 'emacs-wiki-publish) - -(defun emacs-wiki-changelog-escape-files () - (replace-match "[[\\1]]" t nil nil 1)) - -(defun emacs-wiki-markup-changelog-section () - (if (not emacs-wiki-pretty-changelogs) - "* \\1 \\2" - (let ((email (match-string 2)) - (date (match-string 1))) - (goto-char (match-beginning 0)) - (delete-region (match-beginning 0) (match-end 0)) - (while (eolp) - (kill-line 1)) - (insert (format " <TABLE WIDTH=\"100%%\" BORDER=\"0\" - CELLSPACING=\"1\" CELLPADDING=\"2\"> - <TR> - <TD BGCOLOR=\"black\" BACKGROUND=\"onepixel.gif\"> - <TABLE WIDTH=\"100%%\" BORDER=\"0\" - CELLPADDING=\"5\" CELLSPACING=\"0\"> - <TR> - <TD ALIGN=\"left\" BGCOLOR=\"b0c4de\" BACKGROUND=\"onepixel.gif\"> - <FONT COLOR=\"navy\"> <B>%s</B> </FONT> - </TD> - <TD ALIGN=\"right\" VALIGN=\"bottom\" BGCOLOR=\"b0c4de\" - BACKGROUND=\"onepixel.gif\"> - <FONT SIZE=\"2\" COLOR=\"2f4f4f\"> %s </FONT> - </TD> - </TR> - <TR> - <TD BGCOLOR=\"fffff0\" COLSPAN=\"2\" BACKGROUND=\"onepixel.gif\"> - <FONT COLOR=\"black\"> -" email date)) - (add-text-properties (match-beginning 0) (point) - '(read-only t rear-nonsticky (read-only)))) - (if (re-search-forward "^[0-9]" nil t) - (goto-char (1- (match-beginning 0))) - (goto-char (point-max)) - (while (eq (char-before (1- (point))) ?\n) - (delete-char -1))) - (let ((here (1- (point)))) - (insert " - </FONT> - </TD> - </TR> - </TABLE> - </TD> - </TR> - </TABLE> - <br>") - (add-text-properties here (point) - '(read-only t rear-nonsticky (read-only))) - nil))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Emacs Wiki HTTP Server (using httpd.el) -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup emacs-wiki-http nil - "Options controlling the behaviour of the Emacs Wiki HTTP server. - -So, you want to run a Wiki server based on Emacs? It's simple. -First, you will need two other scripts: httpd.el and cgi.el. Both of -them can be downloaded from Eric Mardsen's page: - - http://www.chez.com/emarsden/downloads/ - -Once you have those two scripts, you must decide between two different -methods of serving pages directly from Emacs: - -* PERSISTED INVOCATION SERVER - -This scheme keeps a dedicated Emacs process running, solely for the -purpose of rendering pages. It has the disadvantage of occupying -virtual memory when no one is requesting pages. It has the advantage -of being 50 times faster than the next method. - -To use the persisted invoctaion server, you must download the Python -script `httpd-serve' from the same website where you downloaded -emacs-wiki: - - http://www.gci-net.com/~johnw/emacs.html - -Once you have have downloaded the script, running it is simple: - - ./httpd-serve --daemon --port 8080 --load /tmp/my-emacs-wiki \ - [path to your HTML files] - -The file `/tmp/my-emacs-wiki.el' should contain all the customizations -required by your Wiki setup. This is how the server knows where to -find your pages. This script MUST contain the following line: - - (load \"emacs-wiki\") - -That's it. You should now be able to access your Wiki repository at -localhost:8080. Only world-readable will be visible, and only -world-writable can be edited over HTTP. - -* AN EMACS SPAWNED PER REQUEST - -The old method of serving Wiki pages directly is to spawn an Emacs -invocation for every request. This has the advantage of being a far -simpler approach, and it doesn't consume memory if no one is -requesting pages. The disadvantage is that it's hideously slow, and -multiple requests may bog down your machine's supply of virtual -memory. - -Anyway, to use this approach, add the following line to your -/etc/inted.conf file: - - 8080 stream tcp nowait.10000 nobody /usr/local/bin/emacs-httpd - -The emacs-httpd script should look something like this: - - #!/bin/sh - /usr/bin/emacs -batch --no-init-file --no-site-file \\ - -l httpd -l cgi -l emacs-wiki \\ - --eval \"(setq httpd-document-root emacs-wiki-publishing-directory \\ - emacs-wiki-maintainer \\\"mailto:joe@where.com\\\")\" \\ - -f httpd-serve 2> /dev/null - -Emacs-wiki will now serve pages directly on port 8080. Note that if -you need to configure any variables in emacs-wiki, you will have to -repeat those configurations in the emacs-httpd script. - -Note: If you have the 'stopafter' tool installed, it's a good idea to -put a limit on how much time each Emacs process is allowed. And if -you want to render planner.el pages, you'll need to make another -modification. Here is a more complete example: - - #!/bin/sh - /usr/bin/stopafter 60 KILL /usr/bin/emacs \\ - -batch --no-init-file --no-site-file \\ - -l httpd -l cgi -l emacs-wiki -l planner \\ - --eval \"(progn \\ - (setq httpd-document-root emacs-wiki-publishing-directory \\ - emacs-wiki-maintainer \\\"mailto:joe@where.com\\\") \\ - (planner-update-wiki-project))\" \\ - -f httpd-serve 2> /dev/null" - :group 'emacs-wiki) - -(defcustom emacs-wiki-http-search-form - " -<form method=\"GET\" action=\"/searchwiki?get\"> - <center> - Search for: <input type=\"text\" size=\"50\" name=\"q\" value=\"\"> - <input type=\"submit\" value=\"Search!\"> - </center> -</form>\n" - "The form presenting for doing searches when using httpd.el." - :type 'string - :group 'emacs-wiki-http) - -(defcustom emacs-wiki-http-support-editing t - "If non-nil, allow direct editing when serving over httpd.el. -Note that a page can be edited only if it is world-writable and -`emacs-wiki-use-mode-flags' is set, or if it matches one of the -regexps in `emacs-wiki-editable-pages'." - :type 'boolean - :group 'emacs-wiki-http) - -(defcustom emacs-wiki-http-edit-form - " -<form method=\"POST\" action=\"/changewiki?post\"> - <textarea name=\"%PAGE%\" rows=\"25\" cols=\"80\">%TEXT%</textarea> - <center> - <input type=\"submit\" value=\"Submit changes\"> - </center> -</form>\n" - "The form presenting for doing edits when using httpd.el." - :type 'string - :group 'emacs-wiki-http) - -(defun emacs-wiki-http-send-buffer (&optional title modified code - msg no-markup) - "Markup and send the contents of the current buffer via HTTP." - (unless no-markup (emacs-wiki-replace-markup title)) - (princ "HTTP/1.0 ") - (princ (or code 200)) - (princ " ") - (princ (or msg "OK")) - (princ httpd-line-terminator) - (princ "Server: emacs-wiki.el/2.26") - (princ httpd-line-terminator) - (princ "Connection: close") - (princ httpd-line-terminator) - (princ "MIME-Version: 1.0") - (princ httpd-line-terminator) - (princ "Date: ") - (princ (format-time-string "%a, %e %b %Y %T %Z")) - (princ httpd-line-terminator) - (princ "From: ") - (princ (substring emacs-wiki-maintainer 7)) - (when modified - (princ httpd-line-terminator) - (princ "Last-Modified: ") - (princ (format-time-string "%a, %e %b %Y %T %Z" modified))) - (princ httpd-line-terminator) - (princ "Content-Type: text/html; charset=iso-8859-1") - (princ httpd-line-terminator) - (princ "Content-Length: ") - (princ (1- (point-max))) - (princ httpd-line-terminator) - (princ httpd-line-terminator) - (princ (buffer-string))) - -(defun emacs-wiki-http-reject (title msg &optional annotation) - (with-temp-buffer - (insert msg ".\n") - (if annotation - (insert annotation "\n")) - (emacs-wiki-http-send-buffer title nil 404 msg))) - -(defvar emacs-wiki-buffer-mtime nil) -(make-variable-buffer-local 'emacs-wiki-buffer-mtime) - -(defun emacs-wiki-sort-buffers (l r) - (let ((l-mtime (with-current-buffer l - emacs-wiki-buffer-mtime)) - (r-mtime (with-current-buffer r - emacs-wiki-buffer-mtime))) - (cond - ((and (null l-mtime) (null r-mtime)) l) - ((null l-mtime) r) - ((null r-mtime) l) - (t (emacs-wiki-time-less-p r-mtime l-mtime))))) - -(defun emacs-wiki-winnow-list (entries &optional predicate) - "Return only those ENTRIES for which PREDICATE returns non-nil." - (let ((flist (list t)) - valid p) - (let ((entry entries)) - (while entry - (if (funcall predicate (car entry)) - (nconc flist (list (car entry)))) - (setq entry (cdr entry)))) - (cdr flist))) - -(defcustom emacs-wiki-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 `emacs-wiki-http' -customization group." - :type 'integer - :group 'emacs-wiki-http) - -(defun emacs-wiki-prune-cache () - "If the page cache has become too large, prune it." - (let* ((buflist (sort (emacs-wiki-winnow-list - (buffer-list) - (function - (lambda (buf) - (with-current-buffer buf - emacs-wiki-buffer-mtime)))) - 'emacs-wiki-sort-buffers)) - (len (length buflist))) - (while (> len emacs-wiki-max-cache-size) - (kill-buffer (car buflist)) - (setq len (1- len))))) - -(defun emacs-wiki-render-page (name) - "Render the wiki page identified by NAME. -When serving from a dedicated Emacs process (see the httpd-serve -script), a maximum of `emacs-wiki-max-cache-size' pages will be cached -in memory to speed up serving time." - (if (equal name emacs-wiki-index-page) - (with-current-buffer (emacs-wiki-generate-index t t) - (emacs-wiki-http-send-buffer "Wiki Index") - (kill-buffer (current-buffer))) - (let ((file (and (not (emacs-wiki-private-p name)) - (cdr (assoc name (emacs-wiki-file-alist))))) - (inhibit-read-only t)) - (if (null file) - (emacs-wiki-http-reject "Page not found" - (format "Wiki page %s not found" name)) - (set-buffer (get-buffer-create file)) - (let ((modified-time (nth 5 (file-attributes file)))) - (when (or (null emacs-wiki-buffer-mtime) - (emacs-wiki-time-less-p emacs-wiki-buffer-mtime - modified-time)) - (erase-buffer) - (setq emacs-wiki-buffer-mtime modified-time)) - (goto-char (point-max)) - (if (not (bobp)) - (emacs-wiki-http-send-buffer nil emacs-wiki-buffer-mtime - nil nil t) - (insert-file-contents file t) - (cd (file-name-directory file)) - (emacs-wiki-maybe) - (emacs-wiki-http-send-buffer nil emacs-wiki-buffer-mtime))) - (set-buffer-modified-p nil) - (emacs-wiki-prune-cache))))) - -(defun emacs-wiki-wikify-search-results (term) - "Convert the current buffer's grep results into a Wiki form." - (goto-char (point-max)) - (forward-line -2) - (delete-region (point) (point-max)) - (goto-char (point-min)) - (kill-line 2) - (let ((results (list t))) - (while (re-search-forward "^.+/\\([^/:]+\\):\\s-*[0-9]+:\\(.+\\)" nil t) - (let ((page (match-string 1))) - (unless (or (emacs-wiki-private-p page) - (string-match emacs-wiki-file-ignore-regexp page)) - (let ((text (match-string 2)) - (entry (assoc page results))) - (if entry - (nconc (cdr entry) (list text)) - (nconc results (list (cons page (list text))))))))) - (delete-region (point-min) (point-max)) - (setq results - (sort (cdr results) - (function - (lambda (l r) - (string-lessp (car l) (car r)))))) - (while results - (unless (emacs-wiki-private-p (caar results)) - (insert "[[" (caar results) "]] ::\n <p>") - (let ((hits (cdar results))) - (while hits - (while (string-match "</?lisp>" (car hits)) - (setcar hits (replace-match "" t t (car hits)))) - (while (string-match (concat "\\([^*?[/>]\\)\\<\\(" term "\\)\\>") - (car hits)) - (setcar hits (replace-match "\\1<strong>\\2</strong>" - t nil (car hits)))) - (insert " > <verbatim>" (car hits) "</verbatim>\n") - (setq hits (cdr hits)))) - (insert "</p>\n\n")) - (setq results (cdr results))))) - -(defun emacs-wiki-setup-edit-page (page-name) - (insert "<verbatim>" emacs-wiki-http-edit-form "</verbatim>") - (goto-char (point-min)) - (search-forward "%PAGE%") - (replace-match page-name t t) - (search-forward "%TEXT%") - (let ((beg (match-beginning 0)) - (file (emacs-wiki-page-file page-name)) - end) - (delete-region beg (point)) - (when file - (insert-file-contents file) - (save-restriction - (narrow-to-region beg (point)) - (goto-char (point-min)) - (emacs-wiki-escape-html-specials))))) - -(defun emacs-wiki-http-changewiki (&optional content) - "Change the contents of Wiki page, using the results of a POST request." - (require 'cgi) - (unless content - (goto-char (point-min)) - (if (not (re-search-forward "Content-length:\\s-*\\([0-9]+\\)" nil t)) - (emacs-wiki-http-reject "Content-length missing" - "No Content-length for POST request" - (concat "Header received was:\n\n<example>" - (buffer-string) "</example>\n")) - (let ((content-length (string-to-number (match-string 1)))) - (erase-buffer) - (read-event) ; absorb the CRLF separator - (let ((i 0)) - (while (< i content-length) - (insert (read-event)) - (setq i (1+ i)))))) - (setq content (buffer-string))) - (when content - (let* ((result (cgi-decode content)) - (page (caar result)) - (text (cdar result)) - (len (length text)) - (require-final-newline t) - (pos 0) illegal user) - (if (not (emacs-wiki-editable-p page)) - (emacs-wiki-http-reject - "Editing not allowed" - (format "Editing Wiki page %s is not allowed" page)) - (while (and (null illegal) - (setq pos (string-match "<\\s-*\\([^> \t]+\\)" - text pos))) - (setq pos (match-end 0)) - (if (assoc (match-string 1 text) emacs-wiki-dangerous-tags) - (setq illegal (match-string 1 text)))) - (if illegal - (emacs-wiki-http-reject - "Disallowed tag used" - (format "Public use of <%s> tag not allowed" illegal)) - (emacs-wiki-find-file page) - (if (setq user (file-locked-p buffer-file-name)) - (emacs-wiki-http-reject - "Page is locked" - (format "The page \"%s\" is currently being edited by %s." - page (if (eq user t) (user-full-name) user))) - (let ((inhibit-read-only t) - (delete-old-versions t)) - (erase-buffer) - (insert (if (eq (aref text (1- len)) ?%) - (substring text 0 (1- len)) - text)) - (goto-char (point-min)) - (while (re-search-forward "\r$" nil t) - (replace-match "" t t)) - (save-buffer) - ;; this is 0666 - there is no read syntax for octals which - ;; works across all emacsen - (let ((oct 438)) - (when (/= (file-modes buffer-file-name) oct) - (set-file-modes buffer-file-name oct))) - (kill-buffer (current-buffer))) - (with-temp-buffer - (emacs-wiki-file-alist) ; force re-check - (insert "<redirect url=\"" page "\" delay=\"3\">") - (insert "Thank you, your changes have been saved to " page) - (insert ". You will be redirected to " - "the new page in a moment.") - (insert "</redirect>") - (emacs-wiki-http-send-buffer "Changes Saved")))))))) - -(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 emacs-wiki-serve-page (page content) - (let ((handled t)) - (cond - ((string-match "\\`wiki\\?\\(.+\\)" page) - (emacs-wiki-render-page (match-string 1 page))) - - ((string-match "\\`editwiki\\?\\(.+\\)" page) - (let ((page-name (match-string 1 page))) - (if (not (emacs-wiki-editable-p page-name)) - (emacs-wiki-http-reject "Editing not allowed" - "Editing this Wiki page is not allowed") - (with-temp-buffer - (emacs-wiki-setup-edit-page page-name) - ;; this is required because of the : in the name - (emacs-wiki-http-send-buffer - (concat "Edit Wiki Page: " page-name)))))) - - ((string-match "\\`searchwiki\\?get" page) - (with-temp-buffer - (insert "<verbatim>" emacs-wiki-http-search-form "</verbatim>") - (emacs-wiki-http-send-buffer "Search Wiki Pages"))) - - ((string-match "\\`searchwiki\\?q=\\(.+\\)" page) - (let ((compilation-scroll-output nil) - (term (match-string 1 page))) - (unintern 'start-process) - (require 'compile) - (with-current-buffer (emacs-wiki-grep term) - (emacs-wiki-wikify-search-results term) - (emacs-wiki-http-send-buffer "Search Results") - (kill-buffer (current-buffer))))) - - ((string-match "\\`changewiki\\?post" page) - (emacs-wiki-http-changewiki content)) - - ((string-match "\\`diffwiki\\?\\(.+\\)" page) - ;; jww (2001-04-20): This code doesn't fully work yet. - (emacs-wiki-find-file (match-string 1 page)) - (require 'vc) - (require 'vc-hooks) - (let ((curr-ver (vc-workfile-version buffer-file-name))) - (vc-version-diff buffer-file-name - curr-ver (vc-previous-version curr-ver)) - (let ((inhibit-read-only t)) - (goto-char (point-min)) - (when (re-search-forward "^diff" nil t) - (forward-line) - (delete-region (point-min) (point))) - (insert "<verbatim><pre>") - (emacs-wiki-escape-html-specials) - (goto-char (point-max)) - (if (re-search-backward "^Process.*killed" nil t) - (delete-region (point) (point-max))) - (insert "</verbatim></pre>") - (emacs-wiki-http-send-buffer "Diff Results")))) - - (t - (setq handled nil))) - handled)) - -(defun emacs-wiki-serve (page &optional content) - "Serve the given PAGE from this emacs-wiki server." - ;; index.html is really a reference to the main Wiki page - (if (string= page "index.html") - (setq page (concat "wiki?" emacs-wiki-home-page))) - - ;; handle the actual request - (let ((vc-follow-symlinks t) - (emacs-wiki-report-threshhold nil) - (emacs-wiki-serving-p t) - httpd-vars project) - (save-excursion - ;; process any CGI variables, if cgi.el is available - (if (string-match "\\`\\([^&]+\\)&" page) - (setq httpd-vars - (and (fboundp 'cgi-decode) - (cgi-decode (substring page (match-end 0)))) - page (match-string 1 page))) - (setq project (httpd-var "project")) - (if project - (with-emacs-wiki-project project - (emacs-wiki-serve-page page content)) - (emacs-wiki-serve-page page content))))) - -(if (featurep 'httpd) - (httpd-add-handler "\\`\\(index\\.html\\|.*wiki\\(\\?\\|\\'\\)\\)" - 'emacs-wiki-serve)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Support for multile Emacs Wiki projects -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup emacs-wiki-project nil - "Options controlling multi-project behavior in Emacs-Wiki." - :group 'emacs-wiki) - -(defvar emacs-wiki-current-project nil) -(defvar emacs-wiki-predicate nil) -(defvar emacs-wiki-major-mode nil) -(defvar emacs-wiki-project-server-prefix nil) - -(defcustom emacs-wiki-show-project-name-p t - "When true, display the current project name in the mode-line" - :group 'emacs-wiki - :type 'boolean) - -;; this might go away - did anyone prefer the old behavior? tell me! -(defvar emacs-wiki-old-project-change-p nil) - -(defcustom emacs-wiki-update-project-hook - '(emacs-wiki-update-project-interwikis) - "A hook called whenever `emacs-wiki-projects' is modified. -By default, this hook is used to update the Interwiki table so that it -contains links to each project name." - :type 'hook - :group 'emacs-wiki-project) - -(defun emacs-wiki-update-project-interwikis () - (let ((projs emacs-wiki-projects)) - (while projs - (add-to-list - 'emacs-wiki-interwiki-names - `(,(caar projs) - . (lambda (tag) - (emacs-wiki-project-interwiki-link ,(caar projs) tag)))) - (setq projs (cdr projs))))) - -(defcustom emacs-wiki-projects nil - "A list of project-specific Emacs-Wiki variable settings. -Each entry is a cons cell, of the form (PROJECT VARS). - -Projects are useful for maintaining separate wikis that vary in -some way. For instance, you might want to keep your work-related -wiki files in a separate directory, with a different fill-column: - -(setq emacs-wiki-projects - `((\"default\" . ((emacs-wiki-directories . (\"~/wiki\")))) - (\"work\" . ((fill-column . 65) - (emacs-wiki-directories . (\"~/workwiki/\")))))) - -You can then change between them with \\[emacs-wiki-change-project], -by default bound to C-c C-v. When you use \\[emacs-wiki-find-file] to -find a new file, emacs-wiki will attempt to detect which project it -is part of by finding the first project where emacs-wiki-directories -contains that file. - -VARS is an alist of symbol to value mappings, to be used locally in -all emacs-wiki buffers associated with that PROJECT. - -You may also set the variable `emacs-wiki-predicate' in this alist, -which should be a function to determine whether or not the project -pertains to a certain buffer. It will be called within the buffer in -question. The default predicate checks whether the file exists within -`emacs-wiki-directories' for that project. - -The variable `emacs-wiki-major-mode' can be used to determine the -major mode for a specific emacs-wiki buffer, in case you have -developed a customized major-mode derived from `emacs-wiki-mode'. - -The variable `emacs-wiki-project-server-prefix' is prepended to the -Interwiki URL, whenever an Interwiki reference to another project is -made. For example, if you had two projects, A and B, and in A you -made a reference to B by typing B#WikiPage, A needs to know what -directory or server to prepend to the WikiPage.html href. If this -variable is not set, it is assumed that both A and B publish to the -same location. - -If any variable is not customized specifically for a project, the -global value is used." - :type `(repeat - (cons - :tag "Emacs-Wiki Project" - (string :tag "Project name") - (repeat - (choice - (cons :tag "emacs-wiki-predicate" - (const emacs-wiki-predicate) function) - (cons :tag "emacs-wiki-major-mode" - (const emacs-wiki-major-mode) function) - (cons :tag "emacs-wiki-project-server-prefix" - (const emacs-wiki-project-server-prefix) string) - ,@(mapcar - (function - (lambda (sym) - (list 'cons :tag (symbol-name sym) - (list 'const sym) - (get sym 'custom-type)))) - (apropos-internal "\\`emacs-wiki-" - (function - (lambda (sym) - (and (not (eq sym 'emacs-wiki-projects)) - (get sym 'custom-type)))))))))) - :set (function - (lambda (sym val) - (set sym val) - (run-hooks 'emacs-wiki-update-project-hook))) - :group 'emacs-wiki-project) - -(defmacro with-emacs-wiki-project (project &rest body) - "Evaluate as part of PROJECT the given BODY forms." - `(with-temp-buffer - (emacs-wiki-change-project ,project) - ,@body)) - -(put 'with-emacs-wiki-project 'lisp-indent-function 1) - -(defun emacs-wiki-change-project (project) - "Manually change the project associated with the current buffer." - (interactive (list (completing-read "Switch to project: " - emacs-wiki-projects - nil t nil))) - (let ((projsyms (cdr (assoc project emacs-wiki-projects))) - sym) - (while projsyms - (setq sym (caar projsyms)) - (unless (memq sym '(emacs-wiki-predicate emacs-wiki-major-mode)) - (let ((custom-set (or (get sym 'custom-set) 'set)) - (var (if (eq (get sym 'custom-type) 'hook) - (make-local-hook sym) - (make-local-variable sym)))) - (if custom-set - (funcall custom-set var (cdar projsyms))))) - (setq projsyms (cdr projsyms)))) - (when (not (string= emacs-wiki-current-project project)) - ;; if it was a user request to change, change to the welcome buffer first - (if (and (interactive-p) - (not emacs-wiki-old-project-change-p)) - (with-emacs-wiki-project - project (emacs-wiki-visit-link emacs-wiki-default-page)) - (set (make-local-variable 'emacs-wiki-current-project) project) - (when emacs-wiki-show-project-name-p - (setq mode-name (concat "Wiki[" project "]")))))) - -(defun emacs-wiki-project-interwiki-link (project tag) - (with-emacs-wiki-project project - (if emacs-wiki-publishing-p - (concat emacs-wiki-project-server-prefix - (emacs-wiki-link-url (or tag emacs-wiki-home-page))) - (or (emacs-wiki-page-file (or tag emacs-wiki-home-page)) - ;; doesn't yet exist, so we don't qualify the name, causing it to be - ;; rendered as a bad link - tag)))) - -(provide 'emacs-wiki) -;;; emacs-wiki.el ends here -- 2.39.5