Mercurial > hg > dotemacs
changeset 71:ca6e4eda3dca
Add more packages
| author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
|---|---|
| date | Mon, 06 Aug 2012 12:23:17 -0400 |
| parents | b21179c7b441 |
| children | b086e0144b71 |
| files | packages/coffee.el packages/csv-mode.el packages/graphviz-dot-mode.el packages/markdown-mode.el |
| diffstat | 4 files changed, 3789 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/packages/coffee.el @@ -0,0 +1,114 @@ +;;; coffee.el --- Submit a BREW request to an RFC2324-compliant coffee device +;;; +;;; Author: Eric Marsden <emarsden@laas.fr> +;;; Version: 0.3 +;;; Copyright: (C) 1999, 2003 Eric Marsden +;;; Keywords: coffee, brew, kitchen-sink, can't +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public +;; License along with this program; if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. +;; +;; Please send suggestions and bug reports to <emarsden@laas.fr>. +;; The latest version of this package should be available at +;; +;; <URL:http://purl.org/net/emarsden/home/downloads/> + +;;; Commentary: +;; +;; This module provides an Emacs interface to RFC2324-compliant coffee +;; devices (Hyper Text Coffee Pot Control Protocol, or HTCPCP). It +;; prompts the user for the different additives, then issues a BREW +;; request to the coffee device. +;; +;; coffee.el requires a special BREW-capable version of Emacs/W3 to be +;; installed. +;; +;; Reference: <URL:ftp://ftp.isi.edu/in-notes/rfc2324.txt> +;; +;; +;; Thanks to Giacomo Boffi <giacomo.boffi@polimi.it> for some typos +;; and the addition of the "Brown-Coffee" sweetener type. + +;;; Code: + +(require 'cl) + +(defvar coffee-host "coffee" + "*The host which provides the coffee service.") + +(defvar coffee-pot-designator 1 + "*On machines with multiple pots, the number of the pot to brew in") + +(defvar coffee-brew-hook nil + "*Hook executed before issuing a BREW request") + +(defconst coffee-milk-types + '("Cream" "Half-and-Half" "Whole-Milk" "Part-Skim" "Skim" "Non-Dairy")) + +(defconst coffee-syrup-types '("Vanilla" "Almond" "Raspberry" "Chocolate")) + +(defconst coffee-sweetener-types '("White-Sugar" "Brown-Sugar" "Artificial-Sweetener")) + +(defconst coffee-alcohol-types '("Whiskey" "Rum" "Kahula" "Aquavit")) + +(defconst coffee-addition-types + `(("Milk" . ,coffee-milk-types) + ("Syrup" . ,coffee-syrup-types) + ("Sweetener" . ,coffee-sweetener-types) + ("Alcohol" . ,coffee-alcohol-types))) + +(defun coffee () + "Submit a BREW request to an RFC2324-compliant coffee device" + (interactive) + (require 'url) + (let* ((additions-list + (append coffee-milk-types + coffee-syrup-types + coffee-sweetener-types + coffee-alcohol-types)) + (additions-string + (mapconcat #'identity additions-list ",")) + (url (coffee-url)) + (url-request-method "BREW") + (url-request-extra-headers + `(("Content-type" . "message-coffeepot") + ("Accept-Additions" . ,additions-string))) + (url-request-data "START")) + (run-hooks 'coffee-brew-hook) + (url-retrieve url (lambda () (coffee-drink))))) + +(defun coffee-additions () + (let* ((type-name + (completing-read "Coffee addition: " coffee-addition-types nil t)) + (type (cdr (assoc type-name coffee-addition-types))) + (ingredients (mapcar #'(lambda (a) (cons a a)) type)) + (ingredient + (completing-read "Addition type: " ingredients nil t))) + ingredient)) + +(defun coffee-url () + (require 'w3-forms) + (concat "coffee://" coffee-host "/" + (int-to-string coffee-pot-designator) + "?" (w3-form-encode-xwfu (coffee-additions)))) + + +(defun coffee-drink () + (sleep-for -1)) + + +(provide 'coffee) + +;; coffee.el ends here
new file mode 100644 --- /dev/null +++ b/packages/csv-mode.el @@ -0,0 +1,1286 @@ +;;; csv-mode.el --- major mode for editing comma-separated value files + +;; Copyright (C) 2003, 2004 Francis J. Wright + +;; Author: Francis J. Wright <F.J.Wright at qmul.ac.uk> +;; Time-stamp: <23 August 2004> +;; URL: http://centaur.maths.qmul.ac.uk/Emacs/ +;; Version: $Id: csv-mode.el,v 1.1 2005/09/28 01:52:41 psg Exp $ +;; Keywords: convenience + +;; This file is not part of GNU Emacs. + +;; This package 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 package is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This package is intended for use with GNU Emacs 21 (only) and +;; implements the following commands to process records of CSV +;; (comma-separated value) type: `csv-sort-fields' and +;; `csv-sort-numeric-fields' sort respectively lexicographically and +;; numerically on a specified field or column; `csv-reverse-region' +;; reverses the order. They are based closely on, and use, code in +;; `sort.el'. `csv-kill-fields' and `csv-yank-fields' respectively +;; kill and yank fields or columns, although they do not use the +;; normal kill ring. `csv-kill-fields' can kill more than one field +;; at once, but multiple killed fields can be yanked only as a fixed +;; group equivalent to a single field. `csv-align-fields' aligns +;; fields into columns; `csv-unalign-fields' undoes such alignment; +;; separators can be hidden within aligned records. `csv-transpose' +;; interchanges rows and columns. For details, see the documentation +;; for the individual commands. + +;; CSV mode supports a generalised comma-separated values format +;; (character-separated values) in which the fields can be separated +;; by any of several single characters, specified by the value of the +;; customizable user option `csv-separators'. CSV data fields can be +;; delimited by quote characters (and must if they contain separator +;; characters). This implementation supports quoted fields, where the +;; quote characters allowed are specified by the value of the +;; customizable user option `csv-field-quotes'. By default, the only +;; separator is a comma and the only field quote is a double quote. +;; These user options can be changed ONLY by CUSTOMIZING them, +;; e.g. via the command `customize-variable'. + +;; CSV mode commands ignore blank lines and comment lines beginning +;; with the value of the buffer local variable `csv-comment-start', +;; which by default is #. The user interface is similar to that of +;; the standard commands `sort-fields' and `sort-numeric-fields', but +;; see the major mode documentation below. + +;; The global minor mode `csv-field-index-mode' provides display of +;; the current field index in the mode line, cf. `line-number-mode' +;; and `column-number-mode'. It is on by default. + +;;; Installation: + +;; Put this file somewhere that Emacs can find it (i.e. in one of the +;; directories in your `load-path' such as `site-lisp'), optionally +;; byte-compile it (recommended), and put this in your .emacs file: +;; +;; (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) +;; (autoload 'csv-mode "csv-mode" +;; "Major mode for editing comma-separated value files." t) + +;;; History: + +;; Begun on 15 November 2003 to provide lexicographic sorting of +;; simple CSV data by field and released as csv.el. Facilities to +;; kill multiple fields and customize separator added on 9 April 2004. +;; Converted to a major mode and renamed csv-mode.el on 10 April 2004, +;; partly at the suggestion of Stefan Monnier <monnier at +;; IRO.UMontreal.CA> to avoid conflict with csv.el by Ulf Jasper. +;; Field alignment, comment support and CSV mode customization group +;; added on 1 May 2004. Support for index ranges added on 6 June +;; 2004. Multiple field separators added on 12 June 2004. +;; Transposition added on 22 June 2004. Separator invisibility added +;; on 23 June 2004. + +;;; See also: + +;; the standard GNU Emacs 21 packages align.el, which will align +;; columns within a region, and delim-col.el, which helps to prettify +;; columns in a text region or rectangle; + +;; csv.el by Ulf Jasper <ulf.jasper at web.de>, which provides +;; functions for reading/parsing comma-separated value files and is +;; available at http://de.geocities.com/ulf_jasper/emacs.html (and in +;; the gnu.emacs.sources archives). + +;;; To do (maybe): + +;; Make separators and quotes buffer-local and locally settable. +;; Support (La)TeX tables: set separator and comment; support record +;; end string. +;; Convert comma-separated to space- or tab-separated. + +;;; Code: + +(defgroup CSV nil + "Major mode for editing files of comma-separated value type." + :group 'convenience) + +(defvar csv-separator-chars nil + "Field separators as a list of character. +Set by customizing `csv-separators' -- do not set directly!") + +(defvar csv-separator-regexp nil + "Regexp to match a field separator. +Set by customizing `csv-separators' -- do not set directly!") + +(defvar csv-skip-regexp nil + "Regexp used by `skip-chars-forward' etc. to skip fields. +Set by customizing `csv-separators' -- do not set directly!") + +(defvar csv-font-lock-keywords nil + "Font lock keywords to highlight the field separators in CSV mode. +Set by customizing `csv-separators' -- do not set directly!") + +(defcustom csv-separators '(",") + "Field separators: a list of *single-character* strings. +For example: (\",\"), the default, or (\",\" \";\" \":\"). +Neighbouring fields may be separated by any one of these characters. +The first is used when inserting a field separator into the buffer. +All must be different from the field quote characters, `csv-field-quotes'." + ;; Suggested by Eckhard Neber <neber@mwt.e-technik.uni-ulm.de> + :group 'CSV + :type '(repeat string) + ;; Character would be better, but in Emacs 21.3 does not display + ;; correctly in a customization buffer. + :set (lambda (variable value) + (mapc (lambda (x) + (if (or (/= (length x) 1) + (and (boundp 'csv-field-quotes) + (member x csv-field-quotes))) + (error))) + value) + (custom-set-default variable value) + (setq csv-separator-chars (mapcar 'string-to-char value) + csv-skip-regexp (apply 'concat "^\n" csv-separators) + csv-separator-regexp (apply 'concat `("[" ,@value "]")) + csv-font-lock-keywords + ;; NB: csv-separator-face variable evaluates to itself. + `((,csv-separator-regexp . csv-separator-face))))) + +(defcustom csv-field-quotes '("\"") + "Field quotes: a list of *single-character* strings. +For example: (\"\\\"\"), the default, or (\"\\\"\" \"'\" \"`\"). +A field can be delimited by a pair of any of these characters. +All must be different from the field separators, `csv-separators'." + :group 'CSV + :type '(repeat string) + ;; Character would be better, but in Emacs 21 does not display + ;; correctly in a customization buffer. + :set (lambda (variable value) + (mapc (lambda (x) + (if (or (/= (length x) 1) + (member x csv-separators)) + (error))) + value) + (when (boundp 'csv-mode-syntax-table) + ;; FIRST remove old quote syntax: + (with-syntax-table text-mode-syntax-table + (mapc (lambda (x) + (modify-syntax-entry + (string-to-char x) + (string (char-syntax (string-to-char x))) + ;; symbol-value to avoid compiler warning: + (symbol-value 'csv-mode-syntax-table))) + csv-field-quotes)) + ;; THEN set new quote syntax: + (csv-set-quote-syntax value)) + ;; BEFORE setting new value of `csv-field-quotes': + (custom-set-default variable value))) + +(defun csv-set-quote-syntax (field-quotes) + "Set syntax for field quote characters FIELD-QUOTES to be \"string\". +FIELD-QUOTES should be a list of single-character strings." + (mapc (lambda (x) + (modify-syntax-entry + (string-to-char x) "\"" + ;; symbol-value to avoid compiler warning: + (symbol-value 'csv-mode-syntax-table))) + field-quotes)) + +(defvar csv-comment-start nil + "String that starts a comment line, or nil if no comment syntax. +Such comment lines are ignored by CSV mode commands. +This variable is buffer local\; its default value is that of +`csv-comment-start-default'. It is set by the function +`csv-set-comment-start' -- do not set it directly!") + +(make-variable-buffer-local 'csv-comment-start) + +(defcustom csv-comment-start-default "#" + "String that starts a comment line, or nil if no comment syntax. +Such comment lines are ignored by CSV mode commands. +Default value of buffer-local variable `csv-comment-start'. +Changing this variable does not affect any existing CSV mode buffer." + :group 'CSV + :type '(choice (const :tag "None" nil) string) + :set (lambda (variable value) + (custom-set-default variable value) + (set-default 'csv-comment-start value))) + +(defcustom csv-align-style 'left + "Aligned field style: one of 'left, 'centre, 'right or 'auto. +Alignment style used by `csv-align-fields'. +Auto-alignment means left align text and right align numbers." + :group 'CSV + :type '(choice (const left) (const centre) + (const right) (const auto))) + +(defcustom csv-align-padding 1 + "Aligned field spacing: must be a positive integer. +Number of spaces used by `csv-align-fields' after separators." + :group 'CSV + :type 'integer) + +(defcustom csv-header-lines 0 + "Header lines to skip when setting region automatically." + :group 'CSV + :type 'integer) + +(defcustom csv-invisibility-default nil + "If non-nil, make separators in aligned records invisible." + :group 'CSV + :type 'boolean) + +(defface csv-separator-face + '((((class color)) (:foreground "red")) + (t (:weight bold))) + "CSV mode face used to highlight separators." + :group 'CSV) + +;; This mechanism seems to keep XEmacs happy: +(defvar csv-separator-face 'csv-separator-face + "Face name to use to highlight separators.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Mode definition, key bindings and menu +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst csv-mode-line-help-echo + ;; See bindings.el for details of `mode-line-format' construction. + (get-text-property 0 'help-echo (car default-mode-line-format)) + "Primary default mode line help echo text.") + +(defconst csv-mode-line-format + ;; See bindings.el for details of `mode-line-format' construction. + (append (butlast default-mode-line-format 2) + (cons `(csv-field-index-string + ("" csv-field-index-string + ,(propertize "--" 'help-echo csv-mode-line-help-echo))) + (last default-mode-line-format 2))) + "Mode line format string for CSV mode.") + +(define-derived-mode csv-mode text-mode "CSV" + "Major mode for editing files of comma-separated value type. + +CSV mode is derived from `text-mode', and runs `text-mode-hook' before +running `csv-mode-hook'. It turns `auto-fill-mode' off by default. +CSV mode can be customized by user options in the CSV customization +group. The separators are specified by the value of `csv-separators'. + +CSV mode commands ignore blank lines and comment lines beginning with +the value of `csv-comment-start', which delimit \"paragraphs\". +\"Sexp\" is re-interpreted to mean \"field\", so that `forward-sexp' +\(\\[forward-sexp]), `kill-sexp' (\\[kill-sexp]), etc. all apply to fields. +Standard comment commands apply, such as `comment-dwim' (\\[comment-dwim]). + +If `font-lock-mode' is enabled then separators, quoted values and +comment lines are highlighted using respectively `csv-separator-face', +`font-lock-string-face' and `font-lock-comment-face'. + +The user interface (UI) for CSV mode commands is similar to that of +the standard commands `sort-fields' and `sort-numeric-fields', except +that if there is no prefix argument then the UI prompts for the field +index or indices. In `transient-mark-mode' only: if the region is not +set then the UI attempts to set it to include all consecutive CSV +records around point, and prompts for confirmation; if there is no +prefix argument then the UI prompts for it, offering as a default the +index of the field containing point if the region was not set +explicitly. The region set automatically is delimited by blank lines +and comment lines, and the number of header lines at the beginning of +the region given by the value of `csv-header-lines' are skipped. + +Sort order is controlled by `csv-descending'. + +CSV mode provides the following specific keyboard key bindings: + +\\{csv-mode-map}" + (turn-off-auto-fill) + ;; Set syntax for field quotes: + (csv-set-quote-syntax csv-field-quotes) + ;; Make sexp functions apply to fields: + (set (make-local-variable 'forward-sexp-function) 'csv-forward-field) + ;; Paragraph means a group of contiguous records: + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-start) + ;; Comment support: + (make-local-variable 'comment-start) + (csv-set-comment-start csv-comment-start) + (setq + ;; Font locking -- separator plus syntactic: + font-lock-defaults '(csv-font-lock-keywords) + buffer-invisibility-spec csv-invisibility-default + ;; Mode line to support `csv-field-index-mode': + mode-line-format csv-mode-line-format) + ;; Enable or disable `csv-field-index-mode' (could probably do this + ;; a bit more efficiently): + (csv-field-index-mode (symbol-value 'csv-field-index-mode))) + +(defun csv-set-comment-start (string) + "Set comment start for this CSV mode buffer to STRING. +It must be either a string or nil." + (interactive + (list (edit-and-eval-command + "Comment start (string or nil): " csv-comment-start))) + (setq csv-comment-start string + paragraph-separate "[:space:]*$" ; white space + paragraph-start "\n") ; must include \n explicitly! + (if string + (progn + (setq paragraph-separate (concat paragraph-separate "\\|" string) + paragraph-start (concat paragraph-start "\\|" string) + comment-start string) + (modify-syntax-entry + (string-to-char string) "<" csv-mode-syntax-table) + (modify-syntax-entry ?\n ">" csv-mode-syntax-table)) + (with-syntax-table text-mode-syntax-table + (modify-syntax-entry (string-to-char string) + (string (char-syntax (string-to-char string))) + csv-mode-syntax-table) + (modify-syntax-entry ?\n + (string (char-syntax ?\n)) + csv-mode-syntax-table)))) + +(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) + +(define-key csv-mode-map [(control ?c) (control ?v)] 'csv-toggle-invisibility) +(define-key csv-mode-map [(control ?c) (control ?t)] 'csv-transpose) +(define-key csv-mode-map [(control ?c) (control ?c)] 'csv-set-comment-start) +(define-key csv-mode-map [(control ?c) (control ?u)] 'csv-unalign-fields) +(define-key csv-mode-map [(control ?c) (control ?a)] 'csv-align-fields) +(define-key csv-mode-map [(control ?c) (control ?z)] 'csv-yank-as-new-table) +(define-key csv-mode-map [(control ?c) (control ?y)] 'csv-yank-fields) +(define-key csv-mode-map [(control ?c) (control ?k)] 'csv-kill-fields) +(define-key csv-mode-map [(control ?c) (control ?d)] 'csv-toggle-descending) +(define-key csv-mode-map [(control ?c) (control ?r)] 'csv-reverse-region) +(define-key csv-mode-map [(control ?c) (control ?n)] 'csv-sort-numeric-fields) +(define-key csv-mode-map [(control ?c) (control ?s)] 'csv-sort-fields) + +(defvar csv-descending nil + "If non-nil, CSV mode sort functions sort in order of descending sort key. +Usually they sort in order of ascending sort key.") + +(defun csv-toggle-descending () + "Toggle `csv-descending'." + (interactive) + (setq csv-descending (not csv-descending)) + (message "Sort order is %sscending" (if csv-descending "de" "a"))) + +(defun csv-toggle-invisibility () + "Toggle `buffer-invisibility-spec'." + (interactive) + (setq buffer-invisibility-spec (not buffer-invisibility-spec)) + (message "Separators in aligned records will be %svisible \ +\(after re-aligning if soft\)" + (if buffer-invisibility-spec "in" "")) + (redraw-frame (selected-frame))) + +(easy-menu-define + csv-menu + csv-mode-map + "CSV major mode menu keymap" + '("CSV" + ["Sort By Field Lexicographically" csv-sort-fields :active t + :help "Sort lines in region lexicographically by the specified field"] + ["Sort By Field Numerically" csv-sort-numeric-fields :active t + :help "Sort lines in region numerically by the specified field"] + ["Reverse Order of Lines" csv-reverse-region :active t + :help "Reverse the order of the lines in the region"] + ["Use Descending Sort Order" csv-toggle-descending :active t + :style toggle :selected csv-descending + :help "If selected, use descending order when sorting"] + "--" + ["Kill Fields (Columns)" csv-kill-fields :active t + :help "Kill specified fields of each line in the region"] + ["Yank Fields (Columns)" csv-yank-fields :active t + :help "Yank killed fields as specified field of each line in region"] + ["Yank As New Table" csv-yank-as-new-table :active t + :help "Yank killed fields as a new table at point"] + ["Align Fields into Columns" csv-align-fields :active t + :help "Align the start of every field of each line in the region"] + ["Unalign Columns into Fields" csv-unalign-fields :active t + :help "Undo soft alignment and optionally remove redundant white space"] + ["Transpose Rows and Columns" csv-transpose :active t + :help "Rewrite rows (which may have different lengths) as columns"] + "--" + ["Forward Field" forward-sexp :active t + :help "Move forward across one field\; with ARG, do it that many times"] + ["Backward Field" backward-sexp :active t + :help "Move backward across one field\; with ARG, do it that many times"] + ["Kill Field Forward" kill-sexp :active t + :help "Kill field following cursor\; with ARG, do it that many times"] + ["Kill Field Backward" backward-kill-sexp :active t + :help "Kill field preceding cursor\; with ARG, do it that many times"] + "--" + ("Alignment Style" + ["Left" (setq csv-align-style 'left) :active t + :style radio :selected (eq csv-align-style 'left) + :help "If selected, `csv-align-fields' left aligns fields"] + ["Centre" (setq csv-align-style 'centre) :active t + :style radio :selected (eq csv-align-style 'centre) + :help "If selected, `csv-align-fields' centres fields"] + ["Right" (setq csv-align-style 'right) :active t + :style radio :selected (eq csv-align-style 'right) + :help "If selected, `csv-align-fields' right aligns fields"] + ["Auto" (setq csv-align-style 'auto) :active t + :style radio :selected (eq csv-align-style 'auto) + :help "\ +If selected, `csv-align-fields' left aligns text and right aligns numbers"] + ) + ["Show Current Field Index" csv-field-index-mode :active t + :style toggle :selected csv-field-index-mode + :help "If selected, display current field index in mode line"] + ["Make Separators Invisible" csv-toggle-invisibility :active t + :style toggle :selected buffer-invisibility-spec + :help "If selected, separators in aligned records are invisible"] + ["Set Buffer's Comment Start" csv-set-comment-start :active t + :help "Set comment start string for this buffer"] + ["Customize CSV Mode" (customize-group 'CSV) :active t + :help "Open a customization buffer to change CSV mode options"] + )) + +(require 'sort) + +(defsubst csv-not-looking-at-record () + "Return t if looking at blank or comment line, nil otherwise. +Assumes point is at beginning of line." + (looking-at paragraph-separate)) + +(defun csv-interactive-args (&optional type) + "Get arg or field(s) and region interactively, offering sensible defaults. +Signal an error if the buffer is read-only. +If TYPE is noarg then return a list `(beg end)'. +Otherwise, return a list `(arg beg end)', where arg is: + the raw prefix argument by default\; + a single field index if TYPE is single\; + a list of field indices or index ranges if TYPE is multiple. +Field defaults to the current prefix arg\; if not set, prompt user. + +A field index list consists of positive or negative integers or ranges, +separated by any non-integer characters. A range has the form m-n, +where m and n are positive or negative integers, m < n, and n defaults +to the last field index if omitted. + +In transient mark mode, if the mark is not active then automatically +select and highlight CSV records around point, and query user. +The default field when read interactively is the current field." + ;; Must be run interactively to activate mark! + (let* ((arg current-prefix-arg) (default-field 1) + (region + (if (and transient-mark-mode (not mark-active)) + ;; Set region automatically: + (save-excursion + (let (startline lbp) + (if arg + (beginning-of-line) + (setq lbp (line-beginning-position)) + (while (re-search-backward csv-separator-regexp lbp 1) + ;; Move as far as possible, i.e. to beginning of line. + (setq default-field (1+ default-field)))) + (if (csv-not-looking-at-record) + (error "Point may not be within CSV records")) + (setq startline (point)) + ;; Set mark at beginning of region: + (while (not (or (bobp) (csv-not-looking-at-record))) + (forward-line -1)) + (if (csv-not-looking-at-record) (forward-line 1)) + ;; Skip header lines: + (forward-line csv-header-lines) + (set-mark (point)) ; OK since in save-excursion + ;; Move point to end of region: + (goto-char startline) + (beginning-of-line) + (while (not (or (eobp) (csv-not-looking-at-record))) + (forward-line 1)) + ;; Show mark briefly if necessary: + (unless (and (pos-visible-in-window-p) + (pos-visible-in-window-p (mark))) + (exchange-point-and-mark) + (sit-for 1) + (exchange-point-and-mark)) + (or (y-or-n-p "Region OK? ") + (error "Action aborted by user")) + (message nil) ; clear y-or-n-p message + (list (region-beginning) (region-end)))) + ;; Use region set by user: + (list (region-beginning) (region-end))))) + (setq default-field (number-to-string default-field)) + (cond + ((eq type 'multiple) + (if arg + ;; Ensure that field is a list: + (or (consp arg) + (setq arg (list (prefix-numeric-value arg)))) + ;; Read field interactively, ignoring non-integers: + (setq arg + (mapcar + (lambda (x) + (if (string-match "-" x 1) ; not first character + ;; Return a range as a pair - the cdr may be nil: + (let ((m (substring x 0 (match-beginning 0))) + (n (substring x (match-end 0)))) + (cons (car (read-from-string m)) + (and (not (string= n "")) + (car (read-from-string n))))) + ;; Return a number as a number: + (car (read-from-string x)))) + (split-string + (read-string + "Fields (sequence of integers or ranges): " default-field) + "[^-+0-9]+"))))) + ((eq type 'single) + (if arg + (setq arg (prefix-numeric-value arg)) + (while (not (integerp arg)) + (setq arg (eval-minibuffer "Field (integer): " default-field)))))) + (if (eq type 'noarg) region (cons arg region)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Sorting by field +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun csv-nextrecfun () + "Called by `csv-sort-fields-1' with point at end of previous record. +It moves point to the start of the next record. +It should move point to the end of the buffer if there are no more records." + (forward-line) + (while (and (not (eobp)) (csv-not-looking-at-record)) + (forward-line))) + +(defun csv-sort-fields-1 (field beg end startkeyfun endkeyfun) + "Modified version of `sort-fields-1' that skips blank or comment lines. + +FIELD is a single field index, and BEG and END specify the region to +sort. + +STARTKEYFUN moves from the start of the record to the start of the key. +It may return either a non-nil value to be used as the key, or +else the key is the substring between the values of point after +STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key +starts at the beginning of the record. + +ENDKEYFUN moves from the start of the sort key to the end of the sort key. +ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the +same as ENDRECFUN." + (let ((tbl (syntax-table))) + (if (zerop field) (setq field 1)) + (unwind-protect + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (set-syntax-table sort-fields-syntax-table) + (sort-subr csv-descending + 'csv-nextrecfun 'end-of-line + startkeyfun endkeyfun))) + (set-syntax-table tbl)))) + +(defun csv-sort-fields (field beg end) + "Sort lines in region lexicographically by the ARGth field of each line. +If not set, the region defaults to the CSV records around point. +Fields are separated by `csv-separators' and null fields are allowed anywhere. +Field indices increase from 1 on the left or decrease from -1 on the right. +A prefix argument specifies a single field, otherwise prompt for field index. +Ignore blank and comment lines. The variable `sort-fold-case' +determines whether alphabetic case affects the sort order. +When called non-interactively, FIELD is a single field index\; +BEG and END specify the region to sort." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'single)) + (barf-if-buffer-read-only) + (csv-sort-fields-1 field beg end + (lambda () (csv-sort-skip-fields field) nil) + (lambda () (skip-chars-forward csv-skip-regexp)))) + +(defun csv-sort-numeric-fields (field beg end) + "Sort lines in region numerically by the ARGth field of each line. +If not set, the region defaults to the CSV records around point. +Fields are separated by `csv-separators'. +Null fields are allowed anywhere and sort as zeros. +Field indices increase from 1 on the left or decrease from -1 on the right. +A prefix argument specifies a single field, otherwise prompt for field index. +Specified non-null field must contain a number in each line of the region, +which may begin with \"0x\" or \"0\" for hexadecimal and octal values. +Otherwise, the number is interpreted according to sort-numeric-base. +Ignore blank and comment lines. +When called non-interactively, FIELD is a single field index\; +BEG and END specify the region to sort." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'single)) + (barf-if-buffer-read-only) + (csv-sort-fields-1 field beg end + (lambda () + (csv-sort-skip-fields field) + (let* ((case-fold-search t) + (base + (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]") + (cond ((match-beginning 1) + (goto-char (match-end 1)) + 16) + ((match-beginning 2) + (goto-char (match-end 2)) + 8) + (t nil))))) + (string-to-number (buffer-substring (point) + (save-excursion + (forward-sexp 1) + (point))) + (or base sort-numeric-base)))) + nil)) + +(defun csv-reverse-region (beg end) + "Reverse the order of the lines in the region. +This is just a CSV-mode style interface to `reverse-region', which is +the function that should be used non-interactively. It takes two +point or marker arguments, BEG and END, delimiting the region." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'noarg)) + (barf-if-buffer-read-only) + (reverse-region beg end)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Moving by field +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defsubst csv-end-of-field () + "Skip forward over one field." + (skip-syntax-forward " ") + (if (eq (char-syntax (following-char)) ?\") + (goto-char (scan-sexps (point) 1))) + (skip-chars-forward csv-skip-regexp)) + +(defsubst csv-beginning-of-field () + "Skip backward over one field." + (skip-syntax-backward " ") + (if (eq (char-syntax (preceding-char)) ?\") + (goto-char (scan-sexps (point) -1))) + (skip-chars-backward csv-skip-regexp)) + +(defun csv-forward-field (arg) + "Move forward across one field, cf. `forward-sexp'. +With ARG, do it that many times. Negative arg -N means +move backward across N fields." + (interactive "p") + (if (< arg 0) + (csv-backward-field (- arg)) + (while (>= (setq arg (1- arg)) 0) + (if (or (bolp) + (when (and (not (eobp)) (eolp)) (forward-char) t)) + (while (and (not (eobp)) (csv-not-looking-at-record)) + (forward-line 1))) + (if (memq (following-char) csv-separator-chars) (forward-char)) + (csv-end-of-field)))) + +(defun csv-backward-field (arg) + "Move backward across one field, cf. `backward-sexp'. +With ARG, do it that many times. Negative arg -N means +move forward across N fields." + (interactive "p") + (if (< arg 0) + (csv-forward-field (- arg)) + (while (>= (setq arg (1- arg)) 0) + (when (or (eolp) + (when (and (not (bobp)) (bolp)) (backward-char) t)) + (while (progn + (beginning-of-line) + (csv-not-looking-at-record)) + (backward-char)) + (end-of-line)) + (if (memq (preceding-char) csv-separator-chars) (backward-char)) + (csv-beginning-of-field)))) + +(defun csv-sort-skip-fields (n &optional yank) + "Position point at the beginning of field N on the current line. +Fields are separated by `csv-separators'\; null terminal field allowed. +Assumes point is initially at the beginning of the line. +YANK non-nil allows N to be greater than the number of fields, in +which case extend the record as necessary." + (if (> n 0) + ;; Skip across N - 1 fields. + (let ((i (1- n))) + (while (> i 0) + (csv-end-of-field) + (if (eolp) + (if yank + (if (> i 1) (insert (car csv-separators))) + (error "Line has too few fields: %s" + (buffer-substring + (save-excursion (beginning-of-line) (point)) + (save-excursion (end-of-line) (point))))) + (forward-char)) ; skip separator + (setq i (1- i)))) + (end-of-line) + ;; Skip back across -N - 1 fields. + (let ((i (1- (- n)))) + (while (> i 0) + (csv-beginning-of-field) + (if (bolp) + (error "Line has too few fields: %s" + (buffer-substring + (save-excursion (beginning-of-line) (point)) + (save-excursion (end-of-line) (point))))) + (backward-char) ; skip separator + (setq i (1- i))) + ;; Position at the front of the field + ;; even if moving backwards. + (csv-beginning-of-field)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Field index mode +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Based partly on paren.el + +(defcustom csv-field-index-delay 0.125 + "Time in seconds to delay before updating field index display." + :group 'CSV + :type '(number :tag "seconds")) + +(defvar csv-field-index-idle-timer nil) + +(defvar csv-field-index-string nil) +(make-variable-buffer-local 'csv-field-index-string) + +(defvar csv-field-index-old nil) +(make-variable-buffer-local 'csv-field-index-old) + +(define-minor-mode csv-field-index-mode + "Toggle CSV-Field-Index mode. +With prefix ARG, turn CSV-Field-Index mode on if and only if ARG is positive. +Returns the new status of CSV-Field-Index mode (non-nil means on). +When CSV-Field-Index mode is enabled, the current field index appears in +the mode line after `csv-field-index-delay' seconds of Emacs idle time." + :group 'CSV + :global t + :init-value t ; for documentation, since default is t + ;; This macro generates a function that first sets the mode + ;; variable, then runs the following code, runs the mode hooks, + ;; displays a message if interactive, updates the mode line and + ;; finally returns the variable value. + + ;; First, always disable the mechanism (to avoid having two timers): + (when csv-field-index-idle-timer + (cancel-timer csv-field-index-idle-timer) + (setq csv-field-index-idle-timer nil)) + ;; Now, if the mode is on and any buffer is in CSV mode then + ;; re-initialize and enable the mechanism by setting up a new timer: + (if csv-field-index-mode + (if (memq t (mapcar (lambda (buffer) + (with-current-buffer buffer + (when (eq major-mode 'csv-mode) + (setq csv-field-index-string nil + csv-field-index-old nil) + t))) + (buffer-list))) + (setq csv-field-index-idle-timer + (run-with-idle-timer csv-field-index-delay t + 'csv-field-index))) + ;; but if the mode is off then remove the display from the mode + ;; lines of all CSV buffers: + (mapc (lambda (buffer) + (with-current-buffer buffer + (when (eq major-mode 'csv-mode) + (setq csv-field-index-string nil + csv-field-index-old nil) + (force-mode-line-update)))) + (buffer-list)))) + +(defun csv-field-index () + "Construct `csv-field-index-string' to display in mode line. +Called by `csv-field-index-idle-timer'." + (if (eq major-mode 'csv-mode) + (save-excursion + (let ((lbp (line-beginning-position)) (field 1)) + (while (re-search-backward csv-separator-regexp lbp 1) + ;; Move as far as possible, i.e. to beginning of line. + (setq field (1+ field))) + (if (csv-not-looking-at-record) (setq field nil)) + (when (not (eq field csv-field-index-old)) + (setq csv-field-index-old field + csv-field-index-string + (and field (propertize (format "F%d" field) + 'help-echo csv-mode-line-help-echo))) + (force-mode-line-update)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Killing and yanking fields +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar csv-killed-fields nil + "A list of the fields or sub-records last killed by `csv-kill-fields'.") + +(defun csv-kill-fields (fields beg end) + "Kill specified fields of each line in the region. +If not set, the region defaults to the CSV records around point. +Fields are separated by `csv-separators' and null fields are allowed anywhere. +Field indices increase from 1 on the left or decrease from -1 on the right. +The fields are stored for use by `csv-yank-fields'. Fields can be +specified in any order but are saved in increasing index order. +Ignore blank and comment lines. + +When called interactively, a prefix argument specifies a single field, +otherwise prompt for a field list, which may include ranges in the form +m-n, where m < n and n defaults to the last field index if omitted. + +When called non-interactively, FIELDS is a single field index or a +list of field indices, with ranges specified as (m.n) or (m), and BEG +and END specify the region to process." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'multiple)) + (barf-if-buffer-read-only) + ;; Kill the field(s): + (setq csv-killed-fields nil) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (if (or (cdr fields) (consp (car fields))) + (csv-kill-many-columns fields) + (csv-kill-one-column (car fields))))) + (setq csv-killed-fields (nreverse csv-killed-fields))) + +(defmacro csv-kill-one-field (field killed-fields) + "Kill field with index FIELD in current line. +Save killed field by `push'ing onto KILLED-FIELDS. +Assumes point is at beginning of line. +Called by `csv-kill-one-column' and `csv-kill-many-columns'." + `(progn + ;; Move to start of field to kill: + (csv-sort-skip-fields ,field) + ;; Kill to end of field (cf. `kill-region'): + (push (delete-and-extract-region + (point) + (progn (csv-end-of-field) (point))) + ,killed-fields) + (if (eolp) (delete-char -1) ; delete trailing separator at eol + (delete-char 1)))) ; or following separator otherwise + +(defun csv-kill-one-column (field) + "Kill field with index FIELD in all lines in (narrowed) buffer. +Save killed fields in `csv-killed-fields'. +Assumes point is at `point-min'. Called by `csv-kill-fields'. +Ignore blank and comment lines." + (while (not (eobp)) + (or (csv-not-looking-at-record) + (csv-kill-one-field field csv-killed-fields)) + (forward-line))) + +(defun csv-kill-many-columns (fields) + "Kill several fields in all lines in (narrowed) buffer. +FIELDS is an unordered list of field indices. +Save killed fields in increasing index order in `csv-killed-fields'. +Assumes point is at `point-min'. Called by `csv-kill-fields'. +Ignore blank and comment lines." + (if (eolp) (error "First record is empty")) + ;; Convert non-positive to positive field numbers: + (let ((last 1) (f fields)) + (csv-end-of-field) + (while (not (eolp)) + (forward-char) ; skip separator + (csv-end-of-field) + (setq last (1+ last))) ; last = # fields in first record + (while f + (cond ((consp (car f)) + ;; Expand a field range: (m.n) -> m m+1 ... n-1 n. + ;; If n is nil then it defaults to the number of fields. + (let* ((range (car f)) (cdrf (cdr f)) + (m (car range)) (n (cdr range))) + (if (< m 0) (setq m (+ m last 1))) + (if n + (if (< n 0) (setq n (+ n last 1))) + (setq n last)) + (setq range (list n)) + (while (> n m) (push (setq n (1- n)) range)) + (setcar f (car range)) + (setcdr f (cdr range)) + (setcdr (setq f (last range)) cdrf))) + ((zerop (car f)) (setcar f 1)) + ((< (car f) 0) (setcar f (+ f last 1)))) + (setq f (cdr f)))) + (goto-char (point-min)) + ;; Kill from right to avoid miscounting: + (setq fields (sort fields '>)) + (while (not (eobp)) + (or (csv-not-looking-at-record) + (let ((fields fields) killed-fields field) + (while fields + (setq field (car fields) + fields (cdr fields)) + (beginning-of-line) + (csv-kill-one-field field killed-fields)) + (push (mapconcat 'identity killed-fields (car csv-separators)) + csv-killed-fields))) + (forward-line))) + +(defun csv-yank-fields (field beg end) + "Yank fields as the ARGth field of each line in the region. +ARG may be arbitrarily large and records are extended as necessary. +If not set, the region defaults to the CSV records around point\; +if point is not in a CSV record then offer to yank as a new table. +The fields yanked are those last killed by `csv-kill-fields'. +Fields are separated by `csv-separators' and null fields are allowed anywhere. +Field indices increase from 1 on the left or decrease from -1 on the right. +A prefix argument specifies a single field, otherwise prompt for field index. +Ignore blank and comment lines. When called non-interactively, FIELD +is a single field index\; BEG and END specify the region to process." + ;; (interactive "*P\nr") + (interactive (condition-case err + (csv-interactive-args 'single) + (error (list nil nil err)))) + (barf-if-buffer-read-only) + (if (null beg) + (if (y-or-n-p (concat (error-message-string end) + ". Yank as a new table? ")) + (csv-yank-as-new-table) + (error (error-message-string end))) + (if (<= field 0) (setq field (1+ field))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let ((fields csv-killed-fields)) + (while (not (eobp)) + (unless (csv-not-looking-at-record) + ;; Yank at start of specified field if possible, + ;; otherwise yank at end of record: + (if (zerop field) + (end-of-line) + (csv-sort-skip-fields field 'yank)) + (and (eolp) (insert (car csv-separators))) + (when fields + (insert (car fields)) + (setq fields (cdr fields))) + (or (eolp) (insert (car csv-separators)))) + (forward-line))))))) + +(defun csv-yank-as-new-table () + "Yank fields as a new table starting at point. +The fields yanked are those last killed by `csv-kill-fields'." + (interactive "*") + (let ((fields csv-killed-fields)) + (while fields + (insert (car fields) ?\n) + (setq fields (cdr fields))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Aligning fields +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun csv-align-fields (hard beg end) + "Align all the fields in the region to form columns. +The alignment style is specified by `csv-align-style'. The number of +spaces specified by `csv-align-fields' appears after each separator. +Use soft alignment done by displaying virtual white space after the +separators unless invoked with an argument, in which case insert real +space characters into the buffer after the separators. +Unalign first (see `csv-unalign-fields'). Ignore blank and comment lines. + +In hard-aligned records, separators become invisible whenever +`buffer-invisibility-spec' is non-nil. In soft-aligned records, make +separators invisible if and only if `buffer-invisibility-spec' is +non-nil when the records are aligned\; this can be changed only by +re-aligning. \(Unaligning always makes separators visible.) + +When called non-interactively, use hard alignment if HARD is non-nil\; +BEG and END specify the region to align." + (interactive (csv-interactive-args)) + (setq end (set-marker (make-marker) end)) + (csv-unalign-fields hard beg end) ; if hard then barfs if buffer read only + (save-excursion + (save-restriction + (narrow-to-region beg end) + (set-marker end nil) + (goto-char (point-min)) + (let (widths) + ;; Construct list of column widths: + (while (not (eobp)) ; for each record... + (or (csv-not-looking-at-record) + (let ((w widths) x) + (setq beg (point)) ; beginning of current field + (while (not (eolp)) + (csv-end-of-field) + (setq x (- (point) beg)) ; field width + (if w + (if (> x (car w)) (setcar w x)) + (setq w (list x) + widths (nconc widths w))) + (or (eolp) (forward-char)) ; skip separator + (setq w (cdr w) + beg (point))))) + (forward-line)) + + ;; Align fields: + (goto-char (point-min)) + (while (not (eobp)) ; for each record... + (or (csv-not-looking-at-record) + (let ((w widths) (padding 0) x) + (setq beg (point)) ; beginning of current field + (while (and w (not (eolp))) + (let ((left-padding 0) (right-padding 0) overlay) + (csv-end-of-field) + (set-marker end (point)) ; end of current field + (setq x (- (point) beg) ; field width + x (- (car w) x)) ; required padding + + ;; beg = beginning of current field + ;; end = (point) = end of current field + + ;; Compute required padding: + (cond + ((eq csv-align-style 'left) + ;; Left align -- pad on the right: + (setq left-padding csv-align-padding + right-padding x)) + ((eq csv-align-style 'right) + ;; Right align -- pad on the left: + (setq left-padding (+ csv-align-padding x))) + ((eq csv-align-style 'auto) + ;; Auto align -- left align text, right align numbers: + (if (string-match "\\`[-+.[:digit:]]+\\'" + (buffer-substring beg (point))) + ;; Right align -- pad on the left: + (setq left-padding (+ csv-align-padding x)) + ;; Left align -- pad on the right: + (setq left-padding csv-align-padding + right-padding x))) + ((eq csv-align-style 'centre) + ;; Centre -- pad on both left and right: + (let ((y (/ x 2))) ; truncated integer quotient + (setq left-padding (+ csv-align-padding y) + right-padding (- x y))))) + + (if hard + ;; Hard alignment... + (progn + (when (> left-padding 0) ; pad on the left + ;; Insert spaces before field: + (if (= beg end) ; null field + (insert (make-string left-padding ?\ )) + (goto-char beg) ; beginning of current field + (insert (make-string left-padding ?\ )) + (goto-char end))) ; end of current field + (unless (eolp) + (if (> right-padding 0) ; pad on the right + ;; Insert spaces after field: + (insert (make-string right-padding ?\ ))) + ;; Make separator (potentially) invisible; + ;; in Emacs 21.3, neighbouring overlays + ;; conflict, so use the following only + ;; with hard alignment: + (overlay-put (make-overlay (point) (1+ (point))) + ;; 'face 'secondary-selection) ; test + 'invisible t) + (forward-char))) ; skip separator + + ;; Soft alignment... + + (if buffer-invisibility-spec ; csv-hide-separators + + ;; Hide separators... + (progn + ;; Merge right-padding from previous field + ;; with left-padding from this field: + (setq padding (+ padding left-padding)) + (when (> padding 0) + (goto-char beg) ; beginning of current field + (if (bolp) + ;; Display spaces before first field + ;; by overlaying first character: + (overlay-put + (make-overlay (point) (1+ (point))) + 'before-string + (make-string padding ?\ )) + ;; Display separator as spaces: + (overlay-put + (make-overlay (1- (point)) (point)) + ;; 'face 'secondary-selection)) ; test + ;; 'display (make-string padding ?\ ))) + ;; Above 'display mangles buffer + ;; horribly if any string is empty! + 'display `(space :width ,padding))) + (goto-char end)) ; end of current field + (unless (eolp) + (setq padding right-padding) + (forward-char))) ; skip separator + + ;; Do not hide separators... + (when (> left-padding 0) ; pad on the left + ;; Display spaces before field: + (setq overlay (make-overlay beg (point))) + (overlay-put overlay 'before-string + (make-string left-padding ?\ ))) + (unless (eolp) + (if (> right-padding 0) ; pad on the right + ;; Display spaces after field: + (overlay-put + (or overlay + (make-overlay beg (point))) + 'after-string (make-string right-padding ?\ ))) + (forward-char))) ; skip separator + + )) + + (setq w (cdr w) + beg (point))))) + (forward-line))))) + (set-marker end nil)) + +(defun csv-unalign-fields (hard beg end) + "Undo soft alignment and optionally remove redundant white space. +Undo soft alignment introduced by `csv-align-fields'. If invoked with +an argument then also remove all spaces and tabs around separators. +Also make all invisible separators visible again. +Ignore blank and comment lines. When called non-interactively, remove +spaces and tabs if HARD non-nil\; BEG and END specify region to unalign." + (interactive (csv-interactive-args)) + ;; Remove any soft alignment: + (mapc 'delete-overlay (overlays-in beg end)) + (when hard + (barf-if-buffer-read-only) + ;; Remove any white-space padding around separators: + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (while (not (eobp)) + (or (csv-not-looking-at-record) + (while (not (eolp)) + ;; Delete horizontal white space forward: + ;; (delete-horizontal-space) + ;; This relies on left-to-right argument evaluation; + ;; see info node (elisp) Function Forms. + (delete-region (point) + (+ (point) (skip-chars-forward " \t"))) + (csv-end-of-field) + ;; Delete horizontal white space backward: + ;; (delete-horizontal-space t) + (delete-region (point) + (+ (point) (skip-chars-backward " \t"))) + (or (eolp) (forward-char)))) + (forward-line)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Transposing rows and columns +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun csv-transpose (beg end) + "Rewrite rows (which may have different lengths) as columns. +Null fields are introduced as necessary within records but are +stripped from the ends of records. Preserve soft alignment. +This function is its own inverse. Ignore blank and comment lines. +When called non-interactively, BEG and END specify region to process." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'noarg)) + (barf-if-buffer-read-only) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + ;; Delete rows and collect them as a reversed list of lists of + ;; fields, skipping comment and blank lines: + (let ((sep (car csv-separators)) + (align (overlays-in beg end)) + rows columns) + ;; Remove soft alignment if necessary: + (when align + (mapc 'delete-overlay align) + (setq align t)) + (while (not (eobp)) + (if (csv-not-looking-at-record) + ;; Skip blank and comment lines: + (forward-line) + (let ((lep (line-end-position))) + (push + (csv-split-string + (buffer-substring-no-properties (point) lep) + csv-separator-regexp nil t) + rows) + (delete-region (point) lep) + (or (eobp) (delete-char 1))))) + ;; Rows must have monotonic decreasing lengths to be + ;; transposable, so ensure this by padding with null fields. + ;; rows is currently a reversed list of field lists, which + ;; must therefore have monotonic increasing lengths. + (let ((oldlen (length (car rows))) newlen + (r (cdr rows))) + (while r + (setq newlen (length (car r))) + (if (< newlen oldlen) + (nconc (car r) (make-list (- oldlen newlen) nil)) + (setq oldlen newlen)) + (setq r (cdr r)))) + ;; Collect columns as a reversed list of lists of fields: + (while rows + (let (column (r rows) row) + (while r + (setq row (car r)) + ;; Provided it would not be a trailing null field, push + ;; field onto column: + (if (or column (string< "" (car row))) + (push (car row) column)) + ;; Pop field off row: + (setcar r (cdr row)) + ;; If row is now empty then remove it: + (or (car r) (setq rows (cdr rows))) + (setq r (cdr r))) + (push column columns))) + ;; Insert columns into buffer as rows: + (setq columns (nreverse columns)) + (while columns + (insert (mapconcat 'identity (car columns) sep) ?\n) + (setq columns (cdr columns))) + ;; Re-do soft alignment if necessary: + (if align (csv-align-fields nil (point-min) (point-max))))))) + +;; The following generalised version of `split-string' is taken from +;; the development version of WoMan and should probably replace the +;; standard version in subr.el. However, CSV mode (currently) needs +;; only the `allowbeg' option. + +(defun csv-split-string + (string &optional separators subexp allowbeg allowend) + "Splits STRING into substrings where there are matches for SEPARATORS. +Each match for SEPARATORS is a splitting point. +The substrings between the splitting points are made into a list +which is returned. +If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\". +SUBEXP specifies a subexpression of SEPARATORS to be the splitting +point\; it defaults to 0. + +If there is a match for SEPARATORS at the beginning of STRING, we do +not include a null substring for that, unless ALLOWBEG is non-nil. +Likewise, if there is a match at the end of STRING, we do not include +a null substring for that, unless ALLOWEND is non-nil. + +Modifies the match data; use `save-match-data' if necessary." + (or subexp (setq subexp 0)) + (let ((rexp (or separators "[ \f\t\n\r\v]+")) + (start 0) + notfirst + (list nil)) + (while (and (string-match rexp string + (if (and notfirst + (= start (match-beginning subexp)) + (< start (length string))) + (1+ start) start)) + (< (match-beginning subexp) (length string))) + (setq notfirst t) + (or (and (not allowbeg) (eq (match-beginning subexp) 0)) + (and (eq (match-beginning subexp) (match-end subexp)) + (eq (match-beginning subexp) start)) + (push (substring string start (match-beginning subexp)) list)) + (setq start (match-end subexp))) + (or (and (not allowend) (eq start (length string))) + (push (substring string start) list)) + (nreverse list))) + +(provide 'csv-mode) + +;;; csv-mode.el ends here
new file mode 100644 --- /dev/null +++ b/packages/graphviz-dot-mode.el @@ -0,0 +1,919 @@ +;;; graphviz-dot-mode.el --- Mode for the dot-language used by graphviz (att). + +;; Copyright (C) 2002 - 2005 Pieter Pareit <pieter.pareit@scarlet.be> + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be +;; useful, but WITHOUT ANY WARRANTY; without even the implied +;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. See the GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public +;; License along with this program; if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, +;; MA 02111-1307 USA + +;; Authors: Pieter Pareit <pieter.pareit@scarlet.be> +;; Rubens Ramos <rubensr AT users.sourceforge.net> +;; Maintainer: Pieter Pareit <pieter.pareit@planetinternet.be> +;; Homepage: http://users.skynet.be/ppareit/projects/graphviz-dot-mode/graphviz-dot-mode.html +;; Created: 28 Oct 2002 +;; Last modified: 24 Feb 2005 +;; Version: 0.3.4 +;; Keywords: mode dot dot-language dotlanguage graphviz graphs att + +;;; Commentary: +;; Use this mode for editing files in the dot-language (www.graphviz.org and +;; http://www.research.att.com/sw/tools/graphviz/). +;; +;; To use graphviz-dot-mode, add +;; (load-file "PATH_TO_FILE/graphviz-dot-mode.el") +;; to your ~/.emacs(.el) or ~/.xemacs/init.el +;; +;; The graphviz-dot-mode will do font locking, indentation, preview of graphs +;; and eases compilation/error location. There is support for both GNU Emacs +;; and XEmacs. +;; +;; Font locking is automatic, indentation uses the same commands as +;; other modes, tab, M-j and C-M-q. Insertion of comments uses the +;; same commands as other modes, M-; . You can compile a file using +;; M-x compile or C-c c, after that M-x next-error will also work. +;; There is support for viewing an generated image with C-c p. + +;;; Todo: +;; * cleanup the mess of graphviz-dot-compilation-parse-errors +;; * electric indentation is fundamentally broken, because +;; {...} are also used for record nodes. You could argue, I suppose, that +;; many diagrams don't need those, but it would be worth having a note (and +;; it makes sense that the default is now for electric indentation to be +;; off). + +;;; History: + +;; Version 0.3.4 bug fixes +;; 24/02/2005: * fixed a bug in graphviz-dot-preview +;; Version 0.3.3 bug fixes +;; 13/02/2005: Reuben Thomas <rrt AT sc3d.org> +;; * add graphviz-dot-indent-width +;; Version 0.3.2 bug fixes +;; 25/03/2004: Rubens Ramos <rubensr AT users.sourceforge.net> +;; * semi-colons and brackets are added when electric +;; behaviour is disabled. +;; * electric characters do not behave electrically inside +;; comments or strings. +;; * default for electric-braces is disabled now (makes more +;; sense I guess). +;; * using read-from-minibuffer instead of read-shell-command +;; for emacs. +;; * Fixed test for easymenu, so that it works on older +;; versions of XEmacs. +;; * Fixed indentation error when trying to indent last brace +;; of an empty graph. +;; * region-active-p does not exist in emacs (21.2 at least), +;; so removed from code +;; * Added uncomment menu option +;; Version 0.3.1 bug fixes +;; 03/03/2004: * backward-word needs argument for older emacs +;; Version 0.3 added features and fixed bugs +;; 10/01/2004: fixed a bug in graphviz-dot-indent-graph +;; 08/01/2004: Rubens Ramos <rubensr AT users.sourceforge.net> +;; * added customization support +;; * Now it works on XEmacs and Emacs +;; * Added support to use an external Viewer +;; * Now things do not break when dot mode is entered +;; when there is no buffer name, but the side effect is +;; that in this case, the compilation command is not +;; correct. +;; * Preview works on XEmacs and emacs. +;; * Electric indentation on newline +;; * Minor changes to indentation +;; * Added keyword completion (but could be A LOT better) +;; * There are still a couple of ugly hacks. Look for 'RR'. +;; Version 0.2 added features +;; 11/11/2002: added preview support. +;; 10/11/2002: indent a graph or subgraph at once with C-M-q. +;; 08/11/2002: relaxed rules for indentation, the may now be extra chars +;; after beginning of graph (comment's for example). +;; Version 0.1.2 bug fixes and naming issues +;; 06/11/2002: renamed dot-font-lock-defaults to dot-font-lock-keywords. +;; added some documentation to dot-colors. +;; provided a much better way to handle my max-specpdl-size +;; problem. +;; added an extra autoload cookie (hope this helps, as I don't +;; yet use autoload myself) +;; Version 0.1.1 bug fixes +;; 06/11/2002: added an missing attribute, for font-locking to work. +;; fixed the regex generating, so that it only recognizes +;; whole words +;; 05/11/2002: there can now be extra white space chars after an '{'. +;; 04/11/2002: Why I use max-specpdl-size is now documented, and old value +;; gets restored. +;; Version 0.1 initial release +;; 02/11/2002: implemented parser for *compilation* of a .dot file. +;; 01/11/2002: implemented compilation of an .dot file. +;; 31/10/2002: added syntax-table to the mode. +;; 30/10/2002: implemented indentation code. +;; 29/10/2002: implemented all of font-lock. +;; 28/10/2002: derived graphviz-dot-mode from fundamental-mode, started +;; implementing font-lock. + +;;; Code: + +(defconst graphviz-dot-mode-version "0.3.3" + "Version of `graphviz-dot-mode.el'.") + +(defgroup graphviz nil + "Major mode for editing Graphviz Dot files" + :group 'tools) + +(defun graphviz-dot-customize () + "Run \\[customize-group] for the `graphviz' group." + (interactive) + (customize-group 'graphviz)) + +(defvar graphviz-dot-mode-abbrev-table nil + "Abbrev table in use in Graphviz Dot mode buffers.") +(define-abbrev-table 'graphviz-dot-mode-abbrev-table ()) + +(defcustom graphviz-dot-dot-program "dot" + "*Location of the dot program. This is used by `compile'." + :type 'string + :group 'graphviz) + +(defcustom graphviz-dot-view-command "doted %s" + "*External program to run on the buffer. You can use `%s' in this string, +and it will be substituted by the buffer name." + :type 'string + :group 'graphviz) + +(defcustom graphviz-dot-view-edit-command nil + "*Whether to allow the user to edit the command to run an external +viewer." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-save-before-view t + "*If not nil, M-x graphviz-dot-view saves the current buffer before running +the command." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-auto-indent-on-newline t + "*If not nil, `electric-graphviz-dot-terminate-line' is executed in a line is terminated." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-indent-width default-tab-width + "*Indentation width in Graphviz Dot mode buffers." + :type 'integer + :group 'graphviz) + +(defcustom graphviz-dot-auto-indent-on-braces nil + "*If not nil, `electric-graphviz-dot-open-brace' and `electric-graphviz-dot-close-brace' are executed when { or } are typed" + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-auto-indent-on-semi t + "*If not nil, `electric-graphviz-dot-semi' is executed when semicolon is typed" + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-preview-extension "png" + "*The extension to use for the compilation and preview commands. The format +for the compilation command is +`dot -T<extension> file.dot > file.<extension>'." + :type 'string + :group 'graphviz) + +(defcustom graphviz-dot-toggle-completions nil + "*Non-nil means that repeated use of \ +\\<graphviz-dot-mode-map>\\[graphviz-dot-complete-word] will toggle the possible +completions in the minibuffer. Normally, when there is more than one possible +completion, a buffer will display all completions." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-delete-completions nil + "*Non-nil means that the completion buffer is automatically deleted when a +key is pressed." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-attr-keywords + '("graph" "digraph" "subgraph" "node" "edge" "strict" "rankdir" + "size" "page" "Damping" "Epsilon" "URL" "arrowhead" "arrowsize" + "arrowtail" "bb" "bgcolor" "bottomlabel" "center" "clusterrank" + "color" "comment" "compound" "concentrate" "constraint" "decorate" + "dim" "dir" "distortion" "fillcolor" "fixedsize" "fontcolor" + "fontname" "fontpath" "fontsize" "group" "headURL" "headlabel" + "headport" "height" "label" "labelangle" "labeldistance" "labelfloat" + "labelfontcolor" "labelfontname" "labelfontsize" "labeljust" + "labelloc" "layer" "layers" "len" "lhead" "lp" "ltail" "margin" + "maxiter" "mclimit" "minlen" "model" "nodesep" "normalize" "nslimit" + "nslimit1" "ordering" "orientation" "overlap" "pack" "pagedir" + "pencolor" "peripheries" "pin" "pos" "quantum" "rank" "ranksep" + "ratio" "rects" "regular" "remincross" "rotate" "samehead" "sametail" + "samplepoint" "searchsize" "sep" "shape" "shapefile" "showboxes" + "sides" "skew" "splines" "start" "style" "stylesheet" "tailURL" + "taillabel" "tailport" "toplabel" "vertices" "voro_margin" "weight" + "z") + "*Keywords for attribute names in a graph. This is used by the auto +completion code. The actual completion tables are built when the mode +is loaded, so changes to this are not immediately visible." + :type '(repeat (string :tag "Keyword")) + :group 'graphviz) + +(defcustom graphviz-dot-value-keywords + '("true" "false" "normal" "inv" "dot" "invdot" "odot" "invodot" + "none" "tee" "empty" "invempty" "diamond" "odiamond" "box" "obox" + "open" "crow" "halfopen" "local" "global" "none" "forward" "back" + "both" "none" "BL" "BR" "TL" "TR" "RB" "RT" "LB" "LT" ":n" ":ne" ":e" + ":se" ":s" ":sw" ":w" ":nw" "same" "min" "source" "max" "sink" "LR" + "box" "polygon" "ellipse" "circle" "point" "egg" "triangle" + "plaintext" "diamond" "trapezium" "parallelogram" "house" "hexagon" + "octagon" "doublecircle" "doubleoctagon" "tripleoctagon" "invtriangle" + "invtrapezium" "invhouse" "Mdiamond" "Msquare" "Mcircle" "record" + "Mrecord" "dashed" "dotted" "solid" "invis" "bold" "filled" + "diagonals" "rounded" ) + "*Keywords for attribute values. This is used by the auto completion +code. The actual completion tables are built when the mode is loaded, +so changes to this are not immediately visible." + :type '(repeat (string :tag "Keyword")) + :group 'graphviz) + +;;; Font-locking: +(defvar graphviz-dot-colors-list + '(aliceblue antiquewhite antiquewhite1 antiquewhite2 + antiquewhite3 antiquewhite4 aquamarine aquamarine1 + aquamarine2 aquamarine3 aquamarine4 azure azure1 + azure2 azure3 azure4 beige bisque bisque1 bisque2 + bisque3 bisque4 black blanchedalmond blue blue1 + blue2 blue3 blue4 blueviolet brown brown1 brown2 + brown3 brown4 burlywood burlywood1 burlywood2 + burlywood3 burlywood4 cadetblue cadetblue1 + cadetblue2 cadetblue3 cadetblue4 chartreuse + chartreuse1 chartreuse2 chartreuse3 chartreuse4 + chocolate chocolate1 chocolate2 chocolate3 chocolate4 + coral coral1 coral2 coral3 coral4 cornflowerblue + cornsilk cornsilk1 cornsilk2 cornsilk3 cornsilk4 + crimson cyan cyan1 cyan2 cyan3 cyan4 darkgoldenrod + darkgoldenrod1 darkgoldenrod2 darkgoldenrod3 + darkgoldenrod4 darkgreen darkkhaki darkolivegreen + darkolivegreen1 darkolivegreen2 darkolivegreen3 + darkolivegreen4 darkorange darkorange1 darkorange2 + darkorange3 darkorange4 darkorchid darkorchid1 + darkorchid2 darkorchid3 darkorchid4 darksalmon + darkseagreen darkseagreen1 darkseagreen2 + darkseagreen3 darkseagreen4 darkslateblue + darkslategray darkslategray1 darkslategray2 + darkslategray3 darkslategray4 darkslategrey + darkturquoise darkviolet deeppink deeppink1 + deeppink2 deeppink3 deeppink4 deepskyblue + deepskyblue1 deepskyblue2 deepskyblue3 deepskyblue4 + dimgray dimgrey dodgerblue dodgerblue1 dodgerblue2 + dodgerblue3 dodgerblue4 firebrick firebrick1 + firebrick2 firebrick3 firebrick4 floralwhite + forestgreen gainsboro ghostwhite gold gold1 gold2 + gold3 gold4 goldenrod goldenrod1 goldenrod2 + goldenrod3 goldenrod4 gray gray0 gray1 gray10 gray100 + gray11 gray12 gray13 gray14 gray15 gray16 gray17 + gray18 gray19 gray2 gray20 gray21 gray22 gray23 + gray24 gray25 gray26 gray27 gray28 gray29 gray3 + gray30 gray31 gray32 gray33 gray34 gray35 gray36 + gray37 gray38 gray39 gray4 gray40 gray41 gray42 + gray43 gray44 gray45 gray46 gray47 gray48 gray49 + gray5 gray50 gray51 gray52 gray53 gray54 gray55 + gray56 gray57 gray58 gray59 gray6 gray60 gray61 + gray62 gray63 gray64 gray65 gray66 gray67 gray68 + gray69 gray7 gray70 gray71 gray72 gray73 gray74 + gray75 gray76 gray77 gray78 gray79 gray8 gray80 + gray81 gray82 gray83 gray84 gray85 gray86 gray87 + gray88 gray89 gray9 gray90 gray91 gray92 gray93 + gray94 gray95 gray96 gray97 gray98 gray99 green + green1 green2 green3 green4 greenyellow grey grey0 + grey1 grey10 grey100 grey11 grey12 grey13 grey14 + grey15 grey16 grey17 grey18 grey19 grey2 grey20 + grey21 grey22 grey23 grey24 grey25 grey26 grey27 + grey28 grey29 grey3 grey30 grey31 grey32 grey33 + grey34 grey35 grey36 grey37 grey38 grey39 grey4 + grey40 grey41 grey42 grey43 grey44 grey45 grey46 + grey47 grey48 grey49 grey5 grey50 grey51 grey52 + grey53 grey54 grey55 grey56 grey57 grey58 grey59 + grey6 grey60 grey61 grey62 grey63 grey64 grey65 + grey66 grey67 grey68 grey69 grey7 grey70 grey71 + grey72 grey73 grey74 grey75 grey76 grey77 grey78 + grey79 grey8 grey80 grey81 grey82 grey83 grey84 + grey85 grey86 grey87 grey88 grey89 grey9 grey90 + grey91 grey92 grey93 grey94 grey95 grey96 grey97 + grey98 grey99 honeydew honeydew1 honeydew2 honeydew3 + honeydew4 hotpink hotpink1 hotpink2 hotpink3 hotpink4 + indianred indianred1 indianred2 indianred3 indianred4 + indigo ivory ivory1 ivory2 ivory3 ivory4 khaki khaki1 + khaki2 khaki3 khaki4 lavender lavenderblush + lavenderblush1 lavenderblush2 lavenderblush3 + lavenderblush4 lawngreen lemonchiffon lemonchiffon1 + lemonchiffon2 lemonchiffon3 lemonchiffon4 lightblue + lightblue1 lightblue2 lightblue3 lightblue4 + lightcoral lightcyan lightcyan1 lightcyan2 lightcyan3 + lightcyan4 lightgoldenrod lightgoldenrod1 + lightgoldenrod2 lightgoldenrod3 lightgoldenrod4 + lightgoldenrodyellow lightgray lightgrey lightpink + lightpink1 lightpink2 lightpink3 lightpink4 + lightsalmon lightsalmon1 lightsalmon2 lightsalmon3 + lightsalmon4 lightseagreen lightskyblue lightskyblue1 + lightskyblue2 lightskyblue3 lightskyblue4 + lightslateblue lightslategray lightslategrey + lightsteelblue lightsteelblue1 lightsteelblue2 + lightsteelblue3 lightsteelblue4 lightyellow + lightyellow1 lightyellow2 lightyellow3 lightyellow4 + limegreen linen magenta magenta1 magenta2 magenta3 + magenta4 maroon maroon1 maroon2 maroon3 maroon4 + mediumaquamarine mediumblue mediumorchid + mediumorchid1 mediumorchid2 mediumorchid3 + mediumorchid4 mediumpurple mediumpurple1 + mediumpurple2 mediumpurple3 mediumpurple4 + mediumseagreen mediumslateblue mediumspringgreen + mediumturquoise mediumvioletred midnightblue + mintcream mistyrose mistyrose1 mistyrose2 mistyrose3 + mistyrose4 moccasin navajowhite navajowhite1 + navajowhite2 navajowhite3 navajowhite4 navy navyblue + oldlace olivedrab olivedrap olivedrab1 olivedrab2 + olivedrap3 oragne palegoldenrod palegreen palegreen1 + palegreen2 palegreen3 palegreen4 paleturquoise + paleturquoise1 paleturquoise2 paleturquoise3 + paleturquoise4 palevioletred palevioletred1 + palevioletred2 palevioletred3 palevioletred4 + papayawhip peachpuff peachpuff1 peachpuff2 + peachpuff3 peachpuff4 peru pink pink1 pink2 pink3 + pink4 plum plum1 plum2 plum3 plum4 powderblue + purple purple1 purple2 purple3 purple4 red red1 red2 + red3 red4 rosybrown rosybrown1 rosybrown2 rosybrown3 + rosybrown4 royalblue royalblue1 royalblue2 royalblue3 + royalblue4 saddlebrown salmon salmon1 salmon2 salmon3 + salmon4 sandybrown seagreen seagreen1 seagreen2 + seagreen3 seagreen4 seashell seashell1 seashell2 + seashell3 seashell4 sienna sienna1 sienna2 sienna3 + sienna4 skyblue skyblue1 skyblue2 skyblue3 skyblue4 + slateblue slateblue1 slateblue2 slateblue3 slateblue4 + slategray slategray1 slategray2 slategray3 slategray4 + slategrey snow snow1 snow2 snow3 snow4 springgreen + springgreen1 springgreen2 springgreen3 springgreen4 + steelblue steelblue1 steelblue2 steelblue3 steelblue4 + tan tan1 tan2 tan3 tan4 thistle thistle1 thistle2 + thistle3 thistle4 tomato tomato1 tomato2 tomato3 + tomato4 transparent turquoise turquoise1 turquoise2 + turquoise3 turquoise4 violet violetred violetred1 + violetred2 violetred3 violetred4 wheat wheat1 wheat2 + wheat3 wheat4 white whitesmoke yellow yellow1 yellow2 + yellow3 yellow4 yellowgreen) + "Possible color constants in the dot language. +The list of constant is available at http://www.research.att.com/~erg/graphviz\ +/info/colors.html") + + +(defvar graphviz-dot-color-keywords + (mapcar 'symbol-name graphviz-dot-colors-list)) + +(defvar graphviz-attr-keywords + (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-attr-keywords)) + +(defvar graphviz-value-keywords + (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-value-keywords)) + +(defvar graphviz-color-keywords + (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-color-keywords)) + +;;; Key map +(defvar graphviz-dot-mode-map () + "Keymap used in Graphviz Dot mode.") + +(if graphviz-dot-mode-map + () + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'electric-graphviz-dot-terminate-line) + (define-key map "{" 'electric-graphviz-dot-open-brace) + (define-key map "}" 'electric-graphviz-dot-close-brace) + (define-key map ";" 'electric-graphviz-dot-semi) + (define-key map "\M-\t" 'graphviz-dot-complete-word) + (define-key map "\C-\M-q" 'graphviz-dot-indent-graph) + (define-key map "\C-cp" 'graphviz-dot-preview) + (define-key map "\C-cc" 'compile) + (define-key map "\C-cv" 'graphviz-dot-view) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-u" 'graphviz-dot-uncomment-region) + (setq graphviz-dot-mode-map map) + )) + +;;; Syntax table +(defvar graphviz-dot-mode-syntax-table nil + "Syntax table for `graphviz-dot-mode'.") + +(if graphviz-dot-mode-syntax-table + () + (let ((st (make-syntax-table))) + (modify-syntax-entry ?/ ". 124b" st) + (modify-syntax-entry ?* ". 23" st) + (modify-syntax-entry ?\n "> b" st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?_ "_" st) + (modify-syntax-entry ?- "_" st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?[ "(" st) + (modify-syntax-entry ?] ")" st) + (modify-syntax-entry ?\" "\"" st) + (setq graphviz-dot-mode-syntax-table st) + )) + +(defvar graphviz-dot-font-lock-keywords + `(("\\(:?di\\|sub\\)?graph \\(\\sw+\\)" + (2 font-lock-function-name-face)) + (,(regexp-opt graphviz-dot-value-keywords 'words) + . font-lock-reference-face) + ;; to build the font-locking for the colors, + ;; we need more room for max-specpdl-size, + ;; after that we take the list of symbols, + ;; convert them to a list of strings, and make + ;; an optimized regexp from them + (,(let ((max-specpdl-size (max max-specpdl-size 1200))) + (regexp-opt graphviz-dot-color-keywords)) + . font-lock-string-face) + (,(concat + (regexp-opt graphviz-dot-attr-keywords 'words) + "[ \\t\\n]*=") + ;; RR - ugly, really, but I dont know why xemacs does not work + ;; if I change the next car to "1"... + (0 font-lock-variable-name-face))) + "Keyword highlighting specification for `graphviz-dot-mode'.") + +;;;###autoload +(defun graphviz-dot-mode () + "Major mode for the dot language. \\<graphviz-dot-mode-map> +TAB indents for graph lines. + +\\[graphviz-dot-indent-graph]\t- Indentaion function. +\\[graphviz-dot-preview]\t- Previews graph in a buffer. +\\[graphviz-dot-view]\t- Views graph in an external viewer. +\\[graphviz-dot-indent-line]\t- Indents current line of code. +\\[graphviz-dot-complete-word]\t- Completes the current word. +\\[electric-graphviz-dot-terminate-line]\t- Electric newline. +\\[electric-graphviz-dot-open-brace]\t- Electric open braces. +\\[electric-graphviz-dot-close-brace]\t- Electric close braces. +\\[electric-graphviz-dot-semi]\t- Electric semi colons. + +Variables specific to this mode: + + graphviz-dot-dot-program (default `dot') + Location of the dot program. + graphviz-dot-view-command (default `doted %s') + Command to run when `graphviz-dot-view' is executed. + graphviz-dot-view-edit-command (default nil) + If the user should be asked to edit the view command. + graphviz-dot-save-before-view (default t) + Automatically save current buffer berore `graphviz-dot-view'. + graphviz-dot-preview-extension (default `png') + File type to use for `graphviz-dot-preview'. + graphviz-dot-auto-indent-on-newline (default t) + Whether to run `electric-graphviz-dot-terminate-line' when + newline is entered. + graphviz-dot-auto-indent-on-braces (default t) + Whether to run `electric-graphviz-dot-open-brace' and + `electric-graphviz-dot-close-brace' when braces are + entered. + graphviz-dot-auto-indent-on-semi (default t) + Whether to run `electric-graphviz-dot-semi' when semi colon + is typed. + graphviz-dot-toggle-completions (default nil) + If completions should be displayed in the buffer instead of a + completion buffer when \\[graphviz-dot-complete-word] is + pressed repeatedly. + +This mode can be customized by running \\[graphviz-dot-customize]. + +Turning on Graphviz Dot mode calls the value of the variable +`graphviz-dot-mode-hook' with no args, if that value is non-nil." + (interactive) + (kill-all-local-variables) + (use-local-map graphviz-dot-mode-map) + (setq major-mode 'graphviz-dot-mode) + (setq mode-name "dot") + (setq local-abbrev-table graphviz-dot-mode-abbrev-table) + (set-syntax-table graphviz-dot-mode-syntax-table) + (set (make-local-variable 'indent-line-function) 'graphviz-dot-indent-line) + (set (make-local-variable 'comment-start) "//") + (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *") + (set (make-local-variable 'font-lock-defaults) + '(graphviz-dot-font-lock-keywords)) + ;; RR - If user is running this in the scratch buffer, there is no + ;; buffer file name... + (if (buffer-file-name) + (set (make-local-variable 'compile-command) + (concat graphviz-dot-dot-program + " -T" graphviz-dot-preview-extension " " + buffer-file-name + " > " + (file-name-sans-extension + buffer-file-name) + "." graphviz-dot-preview-extension))) + (set (make-local-variable 'compilation-parse-errors-function) + 'graphviz-dot-compilation-parse-errors) + (if dot-menu + (easy-menu-add dot-menu)) + (run-hooks 'graphviz-dot-mode-hook) + ) + +;;;; Menu definitions + +(defvar dot-menu nil + "Menu for Graphviz Dot Mode. +This menu will get created automatically if you have the `easymenu' +package. Note that the latest X/Emacs releases contain this package.") + +(and (condition-case nil + (require 'easymenu) + (error nil)) + (easy-menu-define + dot-menu graphviz-dot-mode-map "Graphviz Mode menu" + '("Graphviz" + ["Indent Graph" graphviz-dot-indent-graph t] + ["Comment Out Region" comment-region (mark)] + ["Uncomment Region" graphviz-dot-uncomment-region (mark)] + "-" + ["Compile" compile t] + ["Preview" graphviz-dot-preview + (and (buffer-file-name) + (not (buffer-modified-p)))] + ["External Viewer" graphviz-dot-view (buffer-file-name)] + "-" + ["Customize..." graphviz-dot-customize t] + ))) + +;;;; Compilation + +;; note on graphviz-dot-compilation-parse-errors: +;; It would nicer if we could just use compilation-error-regexp-alist +;; to do that, 3 options: +;; - still write dot-compilation-parse-errors, don't build +;; a return list, but modify the *compilation* buffer +;; in a way compilation-error-regexp-alist recognizes the +;; format. +;; to do that, I should globally change compilation-parse-function +;; to this function, and call the old value of comp..-parse-fun.. +;; to provide the return value. +;; two drawbacks are that, every compilation would be run through +;; this function (performance) and that in autoload there would +;; be a chance that this function would not yet be known. +;; - let the compilation run through a filter that would +;; modify the output of dot or neato: +;; dot -Tpng input.dot | filter +;; drawback: ugly, extra work for user, extra decency ... +;; no-option +;; - modify dot and neato !!! (PP:15/02/2005 seems to have happend, +;; so version 0.4.0 should clean this mess up!) +(defun graphviz-dot-compilation-parse-errors (limit-search find-at-least) + "Parse the current buffer for dot errors. +See variable `compilation-parse-errors-functions' for interface." + (interactive) + (save-excursion + (set-buffer "*compilation*") + (goto-char (point-min)) + (setq compilation-error-list nil) + (let (buffer-of-error) + (while (not (eobp)) + (cond + ((looking-at "^dot\\( -[^ ]+\\)* \\(.*\\)") + (setq buffer-of-error (find-file-noselect + (buffer-substring-no-properties + (nth 4 (match-data t)) + (nth 5 (match-data t)))))) + ((looking-at ".*:.*line \\([0-9]+\\)") + (let ((line-of-error + (string-to-number (buffer-substring-no-properties + (nth 2 (match-data t)) + (nth 3 (match-data t)))))) + (setq compilation-error-list + (cons + (cons + (point-marker) + (save-excursion + (set-buffer buffer-of-error) + (goto-line line-of-error) + (beginning-of-line) + (point-marker))) + compilation-error-list)))) + (t t)) + (forward-line 1)) ))) + +;;;; +;;;; Indentation +;;;; +(defun graphviz-dot-uncomment-region (begin end) + "Uncomments a region of code." + (interactive "r") + (comment-region begin end '(4))) + +(defun graphviz-dot-indent-line () + "Indent current line of dot code." + (interactive) + (if (bolp) + (graphviz-dot-real-indent-line) + (save-excursion + (graphviz-dot-real-indent-line)))) + +(defun graphviz-dot-real-indent-line () + "Indent current line of dot code." + (beginning-of-line) + (cond + ((bobp) + ;; simple case, indent to 0 + (indent-line-to 0)) + ((looking-at "^[ \t]*}[ \t]*$") + ;; block closing, deindent relative to previous line + (indent-line-to (save-excursion + (forward-line -1) + (max 0 (- (current-indentation) graphviz-dot-indent-width))))) + ;; other cases need to look at previous lines + (t + (indent-line-to (save-excursion + (forward-line -1) + (cond + ((looking-at "\\(^.*{[^}]*$\\)") + ;; previous line opened a block + ;; indent to that line + (+ (current-indentation) graphviz-dot-indent-width)) + ((and (not (looking-at ".*\\[.*\\].*")) + (looking-at ".*\\[.*")) ; TODO:PP : can be 1 regex + ;; previous line started filling + ;; attributes, intend to that start + (search-forward "[") + (current-column)) + ((and (not (looking-at ".*\\[.*\\].*")) + (looking-at ".*\\].*")) ; TODO:PP : " + ;; previous line stopped filling + ;; attributes, find the line that started + ;; filling them and indent to that line + (while (or (looking-at ".*\\[.*\\].*") + (not (looking-at ".*\\[.*"))) ; TODO:PP : " + (forward-line -1)) + (current-indentation)) + (t + ;; default case, indent the + ;; same as previous line + (current-indentation)) ))) ))) + +(defun graphviz-dot-indent-graph () + "Indent the graph/digraph/subgraph where point is at. +This will first teach the beginning of the graph were point is at, and +then indent this and each subgraph in it." + (interactive) + (save-excursion + ;; position point at start of graph + (while (not (or (looking-at "\\(^.*{[^}]*$\\)") (bobp))) + (forward-line -1)) + ;; bracket { one +; bracket } one - + (let ((bracket-count 0)) + (while + (progn + (cond + ;; update bracket-count + ((looking-at "\\(^.*{[^}]*$\\)") + (setq bracket-count (+ bracket-count 1))) + ;; update bracket-count + ((looking-at "^[ \t]*}[ \t]*$") + (setq bracket-count (- bracket-count 1)))) + ;; indent this line and move on + (graphviz-dot-indent-line) + (forward-line 1) + ;; as long as we are not completed or at end of buffer + (and (> bracket-count 0) (not (eobp)))))))) + +;;;; +;;;; Electric indentation +;;;; +(defun graphviz-dot-comment-or-string-p () + (let ((state (parse-partial-sexp (point-min) (point)))) + (or (nth 4 state) (nth 3 state)))) + +(defun graphviz-dot-newline-and-indent () + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (graphviz-dot-indent-line)) + (delete-horizontal-space) + (newline) + (graphviz-dot-indent-line)) + +(defun electric-graphviz-dot-terminate-line () + "Terminate line and indent next line." + (interactive) + (if graphviz-dot-auto-indent-on-newline + (graphviz-dot-newline-and-indent) + (newline))) + +(defun electric-graphviz-dot-open-brace () + "Terminate line and indent next line." + (interactive) + (insert "{") + (if (and graphviz-dot-auto-indent-on-braces + (not (graphviz-dot-comment-or-string-p))) + (graphviz-dot-newline-and-indent))) + +(defun electric-graphviz-dot-close-brace () + "Terminate line and indent next line." + (interactive) + (insert "}") + (if (and graphviz-dot-auto-indent-on-braces + (not (graphviz-dot-comment-or-string-p))) + (progn + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (graphviz-dot-indent-line)) + (newline) + (graphviz-dot-indent-line)))) + +(defun electric-graphviz-dot-semi () + "Terminate line and indent next line." + (interactive) + (insert ";") + (if (and graphviz-dot-auto-indent-on-semi + (not (graphviz-dot-comment-or-string-p))) + (graphviz-dot-newline-and-indent))) + +;;;; +;;;; Preview +;;;; +(defun graphviz-dot-preview () + "Shows an example of the current dot file in an emacs buffer. +This assumes that we are running GNU Emacs or XEmacs under a windowing system. +See `image-file-name-extensions' for customizing the files that can be +loaded in GNU Emacs, and `image-formats-alist' for XEmacs." + (interactive) + ;; unsafe to compile ourself, ask it to the user + (if (buffer-modified-p) + (message "Buffer needs to be compiled.") + (if (string-match "XEmacs" emacs-version) + ;; things are easier in XEmacs... + (find-file-other-window (concat (file-name-sans-extension + buffer-file-name) + "." graphviz-dot-preview-extension)) + ;; run through all the extensions for images + (let ((l image-file-name-extensions)) + (while + (let ((f (concat (file-name-sans-extension (buffer-file-name)) + "." + (car l)))) + ;; see if a file matches, might be best also to check + ;; if file is up to date TODO:PP + (if (file-exists-p f) + (progn (auto-image-file-mode 1) + ;; OK, this is ugly, I would need to + ;; know how I can reload a file in an existing buffer + (if (get-buffer "*preview*") + (kill-buffer "*preview*")) + (set-buffer (find-file-noselect f)) + (rename-buffer "*preview*") + (display-buffer (get-buffer "*preview*")) + ;; stop iterating + '()) + ;; will stop iterating when l is nil + (setq l (cdr l))))) + ;; each extension tested and nothing found, let user know + (when (eq l '()) + (message "No image found.")))))) + +;;;; +;;;; View +;;;; +(defun graphviz-dot-view () + "Runs an external viewer. This creates an external process every time it +is executed. If `graphviz-dot-save-before-view' is set, the current +buffer is saved before the command is executed." + (interactive) + (let ((cmd (if graphviz-dot-view-edit-command + (if (string-match "XEmacs" emacs-version) + (read-shell-command "View command: " + (format graphviz-dot-view-command + (buffer-file-name))) + (read-from-minibuffer "View command: " + (format graphviz-dot-view-command + (buffer-file-name)))) + (format graphviz-dot-view-command (buffer-file-name))))) + (if graphviz-dot-save-before-view + (save-buffer)) + (setq novaproc (start-process-shell-command + (downcase mode-name) nil cmd)) + (message (format "Executing `%s'..." cmd)))) + +;;;; +;;;; Completion +;;;; +(defvar graphviz-dot-str nil) +(defvar graphviz-dot-all nil) +(defvar graphviz-dot-pred nil) +(defvar graphviz-dot-buffer-to-use nil) +(defvar graphviz-dot-flag nil) + +(defun graphviz-dot-get-state () + "Returns the syntax state of the current point." + (let ((state (parse-partial-sexp (point-min) (point)))) + (cond + ((nth 4 state) 'comment) + ((nth 3 state) 'string) + ((not (nth 1 state)) 'out) + (t (save-excursion + (skip-chars-backward "^[,=\\[]{};") + (backward-char) + (cond + ((looking-at "[\\[,]{};") 'attribute) + ((looking-at "=") (progn + (backward-word 1) + (if (looking-at "[a-zA-Z]*color") + 'color + 'value))) + (t 'other))))))) + +(defun graphviz-dot-get-keywords () + "Return possible completions for a word" + (let ((state (graphviz-dot-get-state))) + (cond + ((equal state 'comment) ()) + ((equal state 'string) ()) + ((equal state 'out) graphviz-attr-keywords) + ((equal state 'value) graphviz-value-keywords) + ((equal state 'color) graphviz-color-keywords) + ((equal state 'attribute) graphviz-attr-keywords) + (t graphviz-attr-keywords)))) + +(defvar graphviz-dot-last-word-numb 0) +(defvar graphviz-dot-last-word-shown nil) +(defvar graphviz-dot-last-completions nil) + +(defun graphviz-dot-complete-word () + "Complete word at current point." + (interactive) + (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) + (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) + (graphviz-dot-str (buffer-substring b e)) + (allcomp (if (and graphviz-dot-toggle-completions + (string= graphviz-dot-last-word-shown + graphviz-dot-str)) + graphviz-dot-last-completions + (all-completions graphviz-dot-str + (graphviz-dot-get-keywords)))) + (match (if graphviz-dot-toggle-completions + "" (try-completion + graphviz-dot-str (mapcar '(lambda (elm) + (cons elm 0)) allcomp))))) + ;; Delete old string + (delete-region b e) + + ;; Toggle-completions inserts whole labels + (if graphviz-dot-toggle-completions + (progn + ;; Update entry number in list + (setq graphviz-dot-last-completions allcomp + graphviz-dot-last-word-numb + (if (>= graphviz-dot-last-word-numb (1- (length allcomp))) + 0 + (1+ graphviz-dot-last-word-numb))) + (setq graphviz-dot-last-word-shown + (elt allcomp graphviz-dot-last-word-numb)) + ;; Display next match or same string if no match was found + (if (not (null allcomp)) + (insert "" graphviz-dot-last-word-shown) + (insert "" graphviz-dot-str) + (message "(No match)"))) + ;; The other form of completion does not necessarily do that. + + ;; Insert match if found, or the original string if no match + (if (or (null match) (equal match 't)) + (progn (insert "" graphviz-dot-str) + (message "(No match)")) + (insert "" match)) + ;; Give message about current status of completion + (cond ((equal match 't) + (if (not (null (cdr allcomp))) + (message "(Complete but not unique)") + (message "(Sole completion)"))) + ;; Display buffer if the current completion didn't help + ;; on completing the label. + ((and (not (null (cdr allcomp))) (= (length graphviz-dot-str) + (length match))) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list allcomp)) + ;; Wait for a keypress. Then delete *Completion* window + (momentary-string-display "" (point)) + (if graphviz-dot-delete-completions + (delete-window + (get-buffer-window (get-buffer "*Completions*")))) + ))))) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.dot\\'" . graphviz-dot-mode)) + +;;; graphviz-dot-mode.el ends here +
new file mode 100644 --- /dev/null +++ b/packages/markdown-mode.el @@ -0,0 +1,1470 @@ +;;; markdown-mode.el --- Major mode to edit Markdown files in Emacs + +;; Copyright (C) 2007, 2008, 2009 Jason Blevins + +;; Version: 1.7 +;; Keywords: Markdown major mode +;; Author: Jason Blevins <jrblevin@sdf.lonestar.org> +;; URL: http://jblevins.org/projects/markdown-mode/ + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; markdown-mode is a major mode for editing [Markdown][]-formatted +;; text files in GNU Emacs. markdown-mode is free software, licensed +;; under the GNU GPL. +;; +;; [Markdown]: http://daringfireball.net/projects/markdown/ +;; +;; The latest stable version is markdown-mode 1.7, released on October 1, 2009: +;; +;; * [markdown-mode.el][] +;; * [Screenshot][] +;; * [Release notes][] +;; +;; markdown-mode is also available in the Debian +;; [emacs-goodies-el](http://packages.debian.org/emacs-goodies-el) +;; package (beginning with revision 27.0-1) and the OpenBSD +;; [textproc/markdown-mode](http://pkgsrc.se/textproc/markdown-mode) package. +;; +;; [markdown-mode.el]: http://jblevins.org/projects/markdown-mode/markdown-mode.el +;; [screenshot]: http://jblevins.org/projects/markdown-mode/screenshots/20080604-001.png +;; [release notes]: http://jblevins.org/projects/markdown-mode/rev-1-7 + +;; The latest development version can be downloaded directly +;; ([markdown-mode.el][devel.el]) or it can be obtained from the +;; (browsable and clonable) Git repository at +;; <http://jblevins.org/git/markdown-mode.git>. The entire repository, +;; including the full project history, can be cloned via the Git protocol +;; by running +;; +;; git clone git://jblevins.org/git/markdown-mode.git +;; +;; [devel.el]: http://jblevins.org/git/markdown-mode.git/plain/markdown-mode.el + +;;; Dependencies: + +;; markdown-mode requires easymenu, a standard package since GNU Emacs +;; 19 and XEmacs 19, which provides a uniform interface for creating +;; menus in GNU Emacs and XEmacs. + +;;; Installation: + +;; Make sure to place `markdown-mode.el` somewhere in the load-path and add +;; the following lines to your `.emacs` file to associate markdown-mode +;; with `.text` files: +;; +;; (autoload 'markdown-mode "markdown-mode.el" +;; "Major mode for editing Markdown files" t) +;; (setq auto-mode-alist +;; (cons '("\\.text" . markdown-mode) auto-mode-alist)) +;; +;; There is no consensus on an official file extension so change `.text` to +;; `.mdwn`, `.md`, `.mdt`, or whatever you call your markdown files. + +;;; Customization: + +;; Although no configuration is *necessary* there are a few things +;; that can be customized. The `M-x customize-mode` command +;; provides an interface to all of the possible customizations: +;; +;; * `markdown-command` - the command used to run Markdown +;; (default: `markdown`). +;; +;; * `markdown-hr-length` - the length of horizontal rules +;; (default: `5`). +;; +;; * `markdown-bold-underscore` - set to a non-nil value to use two +;; underscores for bold instead of two asterisks (default: `nil`). +;; +;; * `markdown-italic-underscore` - set to a non-nil value to use +;; underscores for italic instead of asterisks (default: `nil`). +;; +;; * `markdown-indent-function` - the function to use for automatic +;; indentation (default: `markdown-indent-line`). +;; +;; * `markdown-indent-on-enter` - set to a non-nil value to +;; automatically indent new lines when the enter key is pressed +;; (default: `t`) +;; +;; * `markdown-uri-types` - a list of protocols for URIs that +;; `markdown-mode' should highlight. +;; +;; * `markdown-enable-math` - syntax highlighting for +;; LaTeX fragments (default: `nil`). +;; +;; Additionally, the faces used for syntax highlighting can be modified to +;; your liking by issuing `M-x customize-group RET markdown-faces` +;; or by using the "Markdown Faces" link at the bottom of the mode +;; customization screen. + +;;; Usage: + +;; Keybindings are grouped by prefixes based on their function. For +;; example, commands dealing with headers begin with `C-c C-t`. The +;; primary commands in each group will are described below. You can +;; obtain a list of all keybindings by pressing `C-c C-h`. +;; +;; * Anchors: `C-c C-a` +;; +;; `C-c C-a l` inserts inline links of the form `[text](url)`. If +;; there is an active region, text in the region is used for the +;; link text. `C-c C-a w` acts similarly for wiki links of the +;; form `[[WikiLink]]`. +;; +;; * Commands: `C-c C-c` +;; +;; `C-c C-c m` will run Markdown on the current buffer and preview +;; the output in another buffer while `C-c C-c p` runs Markdown on +;; the current buffer and previews the output in a browser. +;; +;; `C-c C-c c` will check for undefined references. If there are +;; any, a small buffer will open with a list of undefined +;; references and the line numbers on which they appear. In Emacs +;; 22 and greater, selecting a reference from this list and +;; pressing `RET` will insert an empty reference definition at the +;; end of the buffer. Similarly, selecting the line number will +;; jump to the corresponding line. +;; +;; * Images: `C-c C-i` +;; +;; `C-c C-i i` inserts an image, using the active region (if any) +;; as the alt text. +;; +;; * Physical styles: `C-c C-p` +;; +;; These commands all act on text in the active region, if any, +;; and insert empty markup fragments otherwise. `C-c C-p b` makes +;; the selected text bold, `C-c C-p f` formats the region as +;; fixed-width text, and `C-c C-p i` is used for italic text. +;; +;; * Logical styles: `C-c C-s` +;; +;; These commands all act on text in the active region, if any, +;; and insert empty markup fragments otherwise. Logical styles +;; include blockquote (`C-c C-s b`), preformatted (`C-c C-s p`), +;; code (`C-c C-s c`), emphasis (`C-c C-s e`), and strong (`C-c +;; C-s s`). +;; +;; * Headers: `C-c C-t` +;; +;; All header commands use text in the active region, if any, as +;; the header text. To insert an atx or hash style level-n +;; header, press `C-c C-t n` where n is between 1 and 6. For a +;; top-level setext or underline style header press `C-c C-t t` +;; (mnemonic: title) and for a second-level underline-style header +;; press `C-c C-t s` (mnemonic: section). +;; +;; * Other commands +;; +;; `C-c -` inserts a horizontal rule. +;; +;; Many of the commands described above behave differently depending on +;; whether Transient Mark mode is enabled or not. When it makes sense, +;; if Transient Mark mode is on and a region is active, the command +;; applies to the text in the region (e.g., `C-c C-p b` makes the region +;; bold). For users who prefer to work outside of Transient Mark mode, +;; in Emacs 22 it can be enabled temporarily by pressing `C-SPC C-SPC`. +;; +;; When applicable, commands that specifically act on the region even +;; outside of Transient Mark mode have the same keybinding as the with +;; the exception of an additional `C-` prefix. For example, +;; `markdown-insert-blockquote` is bound to `C-c C-s b` and only acts on +;; the region in Transient Mark mode while `markdown-blockquote-region` +;; is bound to `C-c C-s C-b` and always applies to the region (when +;; nonempty). +;; +;; markdown-mode supports outline-minor-mode as well as org-mode-style +;; visibility cycling for atx- or hash-style headers. There are two +;; types of visibility cycling: Pressing `S-TAB` cycles globally between +;; the table of contents view (headers only), outline view (top-level +;; headers only), and the full document view. Pressing `TAB` while the +;; point is at a header will cycle through levels of visibility for the +;; subtree: completely folded, visible children, and fully visible. +;; Note that mixing hash and underline style headers will give undesired +;; results. + +;;; Extensions: + +;; Besides supporting the basic Markdown syntax, markdown-mode also +;; includes syntax highlighting for `[[Wiki Links]]` by default. +;; +;; [SmartyPants][] support is possible by customizing `markdown-command`. +;; If you install `SmartyPants.pl` at, say, `/usr/local/bin/smartypants`, +;; then you can set `markdown-command` to `"markdown | smartypants"`. +;; You can do this either by using `M-x customize-group markdown` +;; or by placing the following in your `.emacs` file: +;; +;; (defun markdown-custom () +;; "markdown-mode-hook" +;; (setq markdown-command "markdown | smartypants")) +;; (add-hook 'markdown-mode-hook '(lambda() (markdown-custom))) +;; +;; [SmartyPants]: http://daringfireball.net/projects/smartypants/ +;; +;; Experimental syntax highlighting for mathematical expressions written +;; in LaTeX (only expressions denoted by `$..$`, `$$..$$`, or `\[..\]`) +;; can be enabled by setting `markdown-enable-math` to a non-nil value, +;; either via customize or by placing `(setq markdown-enable-itex t)` +;; in `.emacs`, and restarting Emacs. + +;;; Acknowledgments: + +;; markdown-mode has benefited greatly from the efforts of the +;; following people: +;; +;; * Cyril Brulebois <cyril.brulebois@enst-bretagne.fr> for Debian packaging. +;; * Conal Elliott <conal@conal.net> for a font-lock regexp patch. +;; * Edward O'Connor <hober0@gmail.com> for a font-lock regexp fix. +;; * Greg Bognar <greg_bognar@hms.harvard.edu> for menus and a patch. +;; * Daniel Burrows <dburrows@debian.org> for filing Debian bug #456592. +;; * Peter S. Galbraith <psg@debian.org> for maintaining emacs-goodies-el. +;; * Dmitry Dzhus <mail@sphinx.net.ru> for reference checking functions. +;; * Bryan Kyle <bryan.kyle@gmail.com> for indentation code. +;; * intrigeri <intrigeri@boum.org> for face customizations. +;; * Ankit Solanki <ankit.solanki@gmail.com> for longlines.el compatibility. +;; * Hilko Bengen <bengen@debian.org> for proper XHTML output. +;; * Jose A. Ortega Ruiz <jao@gnu.org> for Emacs 23 fixes. +;; * Alec Resnick <alec@sproutward.org> for bug reports. +;; * Peter Williams <pezra@barelyenough.org> for fill-paragraph enhancements. + +;;; Bugs: + +;; Although markdown-mode is developed and tested primarily using +;; GNU Emacs 23, compatibility with GNU Emacs 21 and 22 is also a +;; priority. +;; +;; markdown-mode's syntax highlighting is accomplished using the +;; search-based fontification features of Emacs through a series of +;; regular expressions. Unfortunately, Emacs has trouble highlighting +;; multi-line constructs using regular expressions and this creates +;; several syntax-highlighting quirks such as mistaking indented +;; lists for preformatted text, etc. Making markdown-mode's syntax +;; highlighting more robust through the use of matching functions +;; or syntactic font lock is a high-priority item for future work. +;; +;; If you find any bugs not mentioned here, please construct a test +;; case and/or a patch and email me at <jrblevin@sdf.lonestar.org>. + +;;; History: + +;; markdown-mode was written and is maintained by Jason Blevins. The +;; first version was released on May 24, 2007. +;; +;; * 2007-05-24: Version 1.1 +;; * 2007-05-25: Version 1.2 +;; * 2007-06-05: [Version 1.3][] +;; * 2007-06-29: Version 1.4 +;; * 2008-05-24: [Version 1.5][] +;; * 2008-06-04: [Version 1.6][] +;; * 2008-10-01: [Version 1.7][] +;; +;; [Version 1.3]: http://jblevins.org/projects/markdown-mode/rev-1-3 +;; [Version 1.5]: http://jblevins.org/projects/markdown-mode/rev-1-5 +;; [Version 1.6]: http://jblevins.org/projects/markdown-mode/rev-1-6 +;; [Version 1.7]: http://jblevins.org/projects/markdown-mode/rev-1-7 + + + + +;;; Code: + +(require 'easymenu) +(require 'outline) + + +;;; Customizable variables ==================================================== + +;; Current revision +(defconst markdown-mode-version "1.7-dev") + +;; A hook for users to run their own code when the mode is loaded. +(defvar markdown-mode-hook nil) + + +;;; Customizable variables ==================================================== + +(defgroup markdown nil + "Major mode for editing text files in Markdown format." + :prefix "markdown-" + :group 'wp + :link '(url-link "http://jblevins.org/projects/markdown-mode/")) + +(defcustom markdown-command "markdown" + "Command to run markdown." + :group 'markdown + :type 'string) + +(defcustom markdown-hr-length 5 + "Length of horizonal rules." + :group 'markdown + :type 'integer) + +(defcustom markdown-bold-underscore nil + "Use two underscores for bold instead of two asterisks." + :group 'markdown + :type 'boolean) + +(defcustom markdown-italic-underscore nil + "Use underscores for italic instead of asterisks." + :group 'markdown + :type 'boolean) + +(defcustom markdown-indent-function 'markdown-indent-line + "Function to use to indent." + :group 'markdown + :type 'function) + +(defcustom markdown-indent-on-enter t + "Automatically indent new lines when enter key is pressed." + :group 'markdown + :type 'boolean) + +(defcustom markdown-uri-types + '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https" + "imap" "ldap" "mailto" "mid" "modem" "news" "nfs" "nntp" "pop" "prospero" + "rtsp" "service" "sip" "tel" "telnet" "tip" "urn" "vemmi" "wais") + "Link types for syntax highlighting of URIs." + :group 'markdown + :type 'list) + +(defcustom markdown-enable-math nil + "Syntax highlighting for inline LaTeX expressions. +This will not take effect until Emacs is restarted." + :group 'markdown + :type 'boolean) + +(defcustom markdown-css-path nil + "CSS file to include in the output XHTML" + :group 'markdown + :type 'string) + +;;; Font lock ================================================================= + +(require 'font-lock) + + +(defvar markdown-italic-face 'markdown-italic-face + "Face name to use for italic text.") + +(defvar markdown-bold-face 'markdown-bold-face + "Face name to use for bold text.") + +(defvar markdown-header-face 'markdown-header-face + "Face name to use as a base for headers.") + +(defvar markdown-header-face-1 'markdown-header-face-1 + "Face name to use for level-1 headers.") + +(defvar markdown-header-face-2 'markdown-header-face-2 + "Face name to use for level-2 headers.") + +(defvar markdown-header-face-3 'markdown-header-face-3 + "Face name to use for level-3 headers.") + +(defvar markdown-header-face-4 'markdown-header-face-4 + "Face name to use for level-4 headers.") + +(defvar markdown-header-face-5 'markdown-header-face-5 + "Face name to use for level-5 headers.") + +(defvar markdown-header-face-6 'markdown-header-face-6 + "Face name to use for level-6 headers.") + +(defvar markdown-inline-code-face 'markdown-inline-code-face + "Face name to use for inline code.") + +(defvar markdown-list-face 'markdown-list-face + "Face name to use for list markers.") + +(defvar markdown-blockquote-face 'markdown-blockquote-face + "Face name to use for blockquote.") + +(defvar markdown-pre-face 'markdown-pre-face + "Face name to use for preformatted text.") + +(defvar markdown-link-face 'markdown-link-face + "Face name to use for links.") + +(defvar markdown-reference-face 'markdown-reference-face + "Face name to use for reference.") + +(defvar markdown-url-face 'markdown-url-face + "Face name to use for URLs.") + +(defvar markdown-link-title-face 'markdown-link-title-face + "Face name to use for reference link titles.") + +(defvar markdown-comment-face 'markdown-comment-face + "Face name to use for HTML comments.") + +(defvar markdown-math-face 'markdown-math-face + "Face name to use for LaTeX expressions.") + + +(defgroup markdown-faces nil + "Faces used in Markdown Mode" + :group 'markdown + :group 'faces) + +(defface markdown-italic-face + '((t :inherit font-lock-variable-name-face :italic t)) + "Face for italic text." + :group 'markdown-faces) + +(defface markdown-bold-face + '((t :inherit font-lock-variable-name-face :bold t)) + "Face for bold text." + :group 'markdown-faces) + +(defface markdown-header-face + '((t :inherit font-lock-function-name-face :weight bold)) + "Base face for headers." + :group 'markdown-faces) + +(defface markdown-header-face-1 + '((t :inherit markdown-header-face)) + "Face for level-1 headers." + :group 'markdown-faces) + +(defface markdown-header-face-2 + '((t :inherit markdown-header-face)) + "Face for level-2 headers." + :group 'markdown-faces) + +(defface markdown-header-face-3 + '((t :inherit markdown-header-face)) + "Face for level-3 headers." + :group 'markdown-faces) + +(defface markdown-header-face-4 + '((t :inherit markdown-header-face)) + "Face for level-4 headers." + :group 'markdown-faces) + +(defface markdown-header-face-5 + '((t :inherit markdown-header-face)) + "Face for level-5 headers." + :group 'markdown-faces) + +(defface markdown-header-face-6 + '((t :inherit markdown-header-face)) + "Face for level-6 headers." + :group 'markdown-faces) + +(defface markdown-inline-code-face + '((t :inherit font-lock-constant-face)) + "Face for inline code." + :group 'markdown-faces) + +(defface markdown-list-face + '((t :inherit font-lock-builtin-face)) + "Face for list item markers." + :group 'markdown-faces) + +(defface markdown-blockquote-face + '((t :inherit font-lock-doc-face)) + "Face for blockquote sections." + :group 'markdown-faces) + +(defface markdown-pre-face + '((t :inherit font-lock-constant-face)) + "Face for preformatted text." + :group 'markdown-faces) + +(defface markdown-link-face + '((t :inherit font-lock-keyword-face)) + "Face for links." + :group 'markdown-faces) + +(defface markdown-reference-face + '((t :inherit font-lock-type-face)) + "Face for link references." + :group 'markdown-faces) + +(defface markdown-url-face + '((t :inherit font-lock-string-face)) + "Face for URLs." + :group 'markdown-faces) + +(defface markdown-link-title-face + '((t :inherit font-lock-comment-face)) + "Face for reference link titles." + :group 'markdown-faces) + +(defface markdown-comment-face + '((t :inherit font-lock-comment-face)) + "Face for HTML comments." + :group 'markdown-faces) + +(defface markdown-math-face + '((t :inherit font-lock-string-face)) + "Face for LaTeX expressions." + :group 'markdown-faces) + +(defconst markdown-regex-link-inline + "\\(!?\\[[^]]*?\\]\\)\\(([^\\)]*)\\)" + "Regular expression for a [text](file) or an image link .") + +(defconst markdown-regex-link-reference + "\\(!?\\[[^]]+?\\]\\)[ ]?\\(\\[[^]]*?\\]\\)" + "Regular expression for a reference link [text][id].") + +(defconst markdown-regex-reference-definition + "^ \\{0,3\\}\\(\\[.+?\\]\\):\\s *\\(.*?\\)\\s *\\( \"[^\"]*\"$\\|$\\)" + "Regular expression for a link definition [id]: ...") + +(defconst markdown-regex-header-1-atx + "^\\(# \\)\\(.*?\\)\\($\\| #+$\\)" + "Regular expression for level 1 atx-style (hash mark) headers.") + +(defconst markdown-regex-header-2-atx + "^\\(## \\)\\(.*?\\)\\($\\| #+$\\)" + "Regular expression for level 2 atx-style (hash mark) headers.") + +(defconst markdown-regex-header-3-atx + "^\\(### \\)\\(.*?\\)\\($\\| #+$\\)" + "Regular expression for level 3 atx-style (hash mark) headers.") + +(defconst markdown-regex-header-4-atx + "^\\(#### \\)\\(.*?\\)\\($\\| #+$\\)" + "Regular expression for level 4 atx-style (hash mark) headers.") + +(defconst markdown-regex-header-5-atx + "^\\(##### \\)\\(.*?\\)\\($\\| #+$\\)" + "Regular expression for level 5 atx-style (hash mark) headers.") + +(defconst markdown-regex-header-6-atx + "^\\(###### \\)\\(.*?\\)\\($\\| #+$\\)" + "Regular expression for level 6 atx-style (hash mark) headers.") + +(defconst markdown-regex-header-1-setext + "^\\(.*\\)\n\\(===+\\)$" + "Regular expression for level 1 setext-style (underline) headers.") + +(defconst markdown-regex-header-2-setext + "^\\(.*\\)\n\\(---+\\)$" + "Regular expression for level 2 setext-style (underline) headers.") + +(defconst markdown-regex-hr + "^\\(\\*[ ]?\\*[ ]?\\*[ ]?[\\* ]*\\|-[ ]?-[ ]?-[--- ]*\\)$" + "Regular expression for matching Markdown horizontal rules.") + +(defconst markdown-regex-code + "\\(^\\|[^\\]\\)\\(\\(`\\{1,2\\}\\)\\([^ \\]\\|[^ ].*?[^ \\]\\)\\3\\)" + "Regular expression for matching inline code fragments.") + +(defconst markdown-regex-pre + "^\\( \\|\t\\).*$" + "Regular expression for matching preformatted text sections.") + +(defconst markdown-regex-list + "^[ \t]*\\([0-9]+\\.\\|[\\*\\+-]\\) " + "Regular expression for matching list markers.") + +(defconst markdown-regex-bold + "\\(^\\|[^\\]\\)\\(\\([*_]\\{2\\}\\)\\(.\\|\n\\)*?[^\\ ]\\3\\)" + "Regular expression for matching bold text.") + +(defconst markdown-regex-italic + "\\(^\\|[^\\]\\)\\(\\([*_]\\)\\([^ \\]\\3\\|[^ ]\\(.\\|\n\\)*?[^\\ ]\\3\\)\\)" + "Regular expression for matching italic text.") + +(defconst markdown-regex-blockquote + "^>.*$" + "Regular expression for matching blockquote lines.") + +(defconst markdown-regex-line-break + " $" + "Regular expression for matching line breaks.") + +(defconst markdown-regex-wiki-link + "\\[\\[[^]]+\\]\\]" + "Regular expression for matching wiki links.") + +(defconst markdown-regex-uri + (concat + "\\(" (mapconcat 'identity markdown-uri-types "\\|") + "\\):[^]\t\n\r<>,;() ]+") + "Regular expression for matching inline URIs.") + +(defconst markdown-regex-angle-uri + (concat + "\\(<\\)\\(" + (mapconcat 'identity markdown-uri-types "\\|") + "\\):[^]\t\n\r<>,;()]+\\(>\\)") + "Regular expression for matching inline URIs in angle brackets.") + +(defconst markdown-regex-email + "<\\(\\sw\\|\\s_\\|\\s.\\)+@\\(\\sw\\|\\s_\\|\\s.\\)+>" + "Regular expression for matching inline email addresses.") + +(defconst markdown-regex-latex-expression + "\\(^\\|[^\\]\\)\\(\\$\\($\\([^\\$]\\|\\\\.\\)*\\$\\|\\([^\\$]\\|\\\\.\\)*\\)\\$\\)" + "Regular expression for itex $..$ or $$..$$ math mode expressions.") + +(defconst markdown-regex-latex-display + "^\\\\\\[\\(.\\|\n\\)*?\\\\\\]$" + "Regular expression for itex \[..\] display mode expressions.") + +(defconst markdown-regex-list-indent + "^\\(\\s *\\)\\([0-9]+\\.\\|[\\*\\+-]\\)\\(\\s +\\)" + "Regular expression for matching indentation of list items.") + +; From html-helper-mode +(defun markdown-match-comments (last) + "Matches HTML comments from the point to LAST" + (cond ((search-forward "<!--" last t) + (backward-char 4) + (let ((beg (point))) + (cond ((search-forward-regexp "--[ \t]*>" last t) + (set-match-data (list beg (point))) + t) + (t nil)))) + (t nil))) + +(defvar markdown-mode-font-lock-keywords-basic + (list + '(markdown-match-comments 0 markdown-comment-face t t) + (cons markdown-regex-code '(2 markdown-inline-code-face)) + (cons markdown-regex-pre 'markdown-pre-face) + (cons markdown-regex-blockquote 'markdown-blockquote-face) + (cons markdown-regex-header-1-setext 'markdown-header-face-1) + (cons markdown-regex-header-2-setext 'markdown-header-face-2) + (cons markdown-regex-header-1-atx 'markdown-header-face-1) + (cons markdown-regex-header-2-atx 'markdown-header-face-2) + (cons markdown-regex-header-3-atx 'markdown-header-face-3) + (cons markdown-regex-header-4-atx 'markdown-header-face-4) + (cons markdown-regex-header-5-atx 'markdown-header-face-5) + (cons markdown-regex-header-6-atx 'markdown-header-face-6) + (cons markdown-regex-hr 'markdown-header-face) + (cons markdown-regex-list 'markdown-list-face) + (cons markdown-regex-link-inline + '((1 markdown-link-face t) + (2 markdown-url-face t))) + (cons markdown-regex-link-reference + '((1 markdown-link-face t) + (2 markdown-reference-face t))) + (cons markdown-regex-reference-definition + '((1 markdown-reference-face t) + (2 markdown-url-face t) + (3 markdown-link-title-face t))) + (cons markdown-regex-wiki-link 'markdown-link-face) + (cons markdown-regex-bold '(2 markdown-bold-face)) + (cons markdown-regex-italic '(2 markdown-italic-face)) + (cons markdown-regex-angle-uri 'markdown-link-face) + (cons markdown-regex-uri 'markdown-link-face) + (cons markdown-regex-email 'markdown-link-face) + ) + "Syntax highlighting for Markdown files.") + +(defconst markdown-mode-font-lock-keywords-latex + (list + ;; Math mode $..$ or $$..$$ + (cons markdown-regex-latex-expression '(2 markdown-math-face)) + ;; Display mode equations with brackets: \[ \] + (cons markdown-regex-latex-display 'markdown-math-face) + ;; Equation reference (eq:foo) + (cons "(eq:\\w+)" 'markdown-reference-face) + ;; Equation reference \eqref{foo} + (cons "\\\\eqref{\\w+}" 'markdown-reference-face)) + "Syntax highlighting for LaTeX fragments.") + +(defvar markdown-mode-font-lock-keywords + (append + (if markdown-enable-math + markdown-mode-font-lock-keywords-latex) + markdown-mode-font-lock-keywords-basic) + "Default highlighting expressions for Markdown mode.") + + + +;;; Syntax Table ============================================================== + +(defvar markdown-mode-syntax-table + (let ((markdown-mode-syntax-table (make-syntax-table))) + (modify-syntax-entry ?\" "w" markdown-mode-syntax-table) + markdown-mode-syntax-table) + "Syntax table for `markdown-mode'.") + + + +;;; Element Insertion ========================================================= + +(defun markdown-wrap-or-insert (s1 s2) + "Insert the strings S1 and S2. +If Transient Mark mode is on and a region is active, wrap the strings S1 +and S2 around the region." + (if (and transient-mark-mode mark-active) + (let ((a (region-beginning)) (b (region-end))) + (goto-char a) + (insert s1) + (goto-char (+ b (length s1))) + (insert s2)) + (insert s1 s2))) + +(defun markdown-insert-hr () + "Insert a horizonal rule." + (interactive) + (let (hr) + (dotimes (count (- markdown-hr-length 1) hr) ; Count to n - 1 + (setq hr (concat "* " hr))) ; Build HR string + (setq hr (concat hr "*\n")) ; Add the n-th * + (insert hr))) + +(defun markdown-insert-bold () + "Insert markup for a bold word or phrase. +If Transient Mark mode is on and a region is active, it is made bold." + (interactive) + (if markdown-bold-underscore + (markdown-wrap-or-insert "__" "__") + (markdown-wrap-or-insert "**" "**")) + (backward-char 2)) + +(defun markdown-insert-italic () + "Insert markup for an italic word or phrase. +If Transient Mark mode is on and a region is active, it is made italic." + (interactive) + (if markdown-italic-underscore + (markdown-wrap-or-insert "_" "_") + (markdown-wrap-or-insert "*" "*")) + (backward-char 1)) + +(defun markdown-insert-code () + "Insert markup for an inline code fragment. +If Transient Mark mode is on and a region is active, it is marked +as inline code." + (interactive) + (markdown-wrap-or-insert "`" "`") + (backward-char 1)) + +(defun markdown-insert-link () + "Insert an inline link of the form [](). +If Transient Mark mode is on and a region is active, it is used +as the link text." + (interactive) + (markdown-wrap-or-insert "[" "]") + (insert "()") + (backward-char 1)) + +(defun markdown-insert-wiki-link () + "Insert a wiki link of the form [[WikiLink]]. +If Transient Mark mode is on and a region is active, it is used +as the link text." + (interactive) + (markdown-wrap-or-insert "[[" "]]") + (backward-char 2)) + +(defun markdown-insert-image () + "Insert an inline image tag of the form ![](). +If Transient Mark mode is on and a region is active, it is used +as the alt text of the image." + (interactive) + (markdown-wrap-or-insert "![" "]") + (insert "()") + (backward-char 1)) + +(defun markdown-insert-header-1 () + "Insert a first level atx-style (hash mark) header. +If Transient Mark mode is on and a region is active, it is used +as the header text." + (interactive) + (markdown-insert-header 1)) + +(defun markdown-insert-header-2 () + "Insert a second level atx-style (hash mark) header. +If Transient Mark mode is on and a region is active, it is used +as the header text." + (interactive) + (markdown-insert-header 2)) + +(defun markdown-insert-header-3 () + "Insert a third level atx-style (hash mark) header. +If Transient Mark mode is on and a region is active, it is used +as the header text." + (interactive) + (markdown-insert-header 3)) + +(defun markdown-insert-header-4 () + "Insert a fourth level atx-style (hash mark) header. +If Transient Mark mode is on and a region is active, it is used +as the header text." + (interactive) + (markdown-insert-header 4)) + +(defun markdown-insert-header-5 () + "Insert a fifth level atx-style (hash mark) header. +If Transient Mark mode is on and a region is active, it is used +as the header text." + (interactive) + (markdown-insert-header 5)) + +(defun markdown-insert-header-6 () + "Insert a sixth level atx-style (hash mark) header. +If Transient Mark mode is on and a region is active, it is used +as the header text." + (interactive) + (markdown-insert-header 6)) + +(defun markdown-insert-header (n) + "Insert an atx-style (hash mark) header. +With no prefix argument, insert a level-1 header. With prefix N, +insert a level-N header. If Transient Mark mode is on and the +region is active, it is used as the header text." + (interactive "p") + (unless n ; Test to see if n is defined + (setq n 1)) ; Default to level 1 header + (let (hdr hdrl hdrr) + (dotimes (count n hdr) + (setq hdr (concat "#" hdr))) ; Build a hash mark header string + (setq hdrl (concat hdr " ")) + (setq hdrr (concat " " hdr)) + (markdown-wrap-or-insert hdrl hdrr)) + (backward-char (+ 1 n))) + +(defun markdown-insert-title () + "Insert a setext-style (underline) first level header. +If Transient Mark mode is on and a region is active, it is used +as the header text." + (interactive) + (if (and transient-mark-mode mark-active) + (let ((a (region-beginning)) + (b (region-end)) + (len 0) + (hdr)) + (setq len (- b a)) + (dotimes (count len hdr) + (setq hdr (concat "=" hdr))) ; Build a === title underline + (end-of-line) + (insert "\n" hdr "\n")) + (insert "\n==========\n") + (backward-char 12))) + +(defun markdown-insert-section () + "Insert a setext-style (underline) second level header. +If Transient Mark mode is on and a region is active, it is used +as the header text." + (interactive) + (if (and transient-mark-mode mark-active) + (let ((a (region-beginning)) + (b (region-end)) + (len 0) + (hdr)) + (setq len (- b a)) + (dotimes (count len hdr) + (setq hdr (concat "-" hdr))) ; Build a --- section underline + (end-of-line) + (insert "\n" hdr "\n")) + (insert "\n----------\n") + (backward-char 12))) + +(defun markdown-insert-blockquote () + "Start a blockquote section (or blockquote the region). +If Transient Mark mode is on and a region is active, it is used as +the blockquote text." + (interactive) + (if (and (boundp 'transient-mark-mode) transient-mark-mode mark-active) + (markdown-blockquote-region (region-beginning) (region-end)) + (insert "> "))) + +(defun markdown-block-region (beg end prefix) + "Format the region using a block prefix. +Arguments BEG and END specify the beginning and end of the +region.The characters PREFIX will appear at the beginning +of each line." + (if mark-active + (save-excursion + (let ((endpos end)) + ; Ensure that there is a leading blank line + (goto-char beg) + (while (not (looking-back "\n\n" 2)) + (insert "\n") + (setq endpos (+ 1 endpos))) + ; Insert blockquote characters + (move-to-left-margin) + (while (< (point-at-bol) endpos) + (insert prefix) + (setq endpos (+ (length prefix) endpos)) + (forward-line)) + ; Move back before any blank lines at the end + (goto-char endpos) + (while (looking-back "\n" 1) + (backward-char)) + ; Ensure one blank line at the end + (while (not (looking-at "\n\n")) + (insert "\n") + (backward-char)))))) + +(defun markdown-blockquote-region (beg end) + "Blockquote the region. +Arguments BEG and END specify the beginning and end of the region." + (interactive "*r") + (markdown-block-region beg end "> ")) + +(defun markdown-insert-pre () + "Start a preformatted section (or apply to the region). +If Transient Mark mode is on and a region is active, it is marked +as preformatted text." + (interactive) + (if (and (boundp 'transient-mark-mode) transient-mark-mode mark-active) + (markdown-pre-region (region-beginning) (region-end)) + (insert " "))) + +(defun markdown-pre-region (beg end) + "Format the region as preformatted text. +Arguments BEG and END specify the beginning and end of the region." + (interactive "*r") + (markdown-block-region beg end " ")) + +;;; Indentation ==================================================================== + +;;; Indentation functions contributed by Bryan Kyle <bryan.kyle@gmail.com>.. + +(defun markdown-indent-find-next-position (cur-pos positions) + "Return the position after the index of CUR-POS in POSITIONS." + (while (and positions + (not (equal cur-pos (car positions)))) + (setq positions (cdr positions))) + (or (cadr positions) 0)) + +(defun markdown-prev-line-indent-p () + "Return t if the previous line is indented." + (save-excursion + (forward-line -1) + (goto-char (point-at-bol)) + (if (re-search-forward "^\\s " (point-at-eol) t) t))) + +(defun markdown-prev-line-indent () + "Return the number of leading whitespace characters in the previous line." + (save-excursion + (forward-line -1) + (goto-char (point-at-bol)) + (when (re-search-forward "^\\s +" (point-at-eol) t) + (current-column)))) + +(defun markdown-prev-list-indent () + "Return position of the first non-list-marker on the previous line." + (save-excursion + (forward-line -1) + (goto-char (point-at-bol)) + (when (re-search-forward markdown-regex-list-indent (point-at-eol) t) + (current-column)))) + +(defun markdown-indent-line () + "Indent the current line using some heuristics." + (interactive) + (if (markdown-prev-line-indent-p) + ;; If the current column is any of the positions, remove all + ;; of the positions up-to and including the current column + (indent-line-to + (markdown-indent-find-next-position + (current-column) (markdown-calc-indents))))) + +(defun markdown-calc-indents () + "Return a list of indentation columns to cycle through." + (let (pos + prev-line-pos + positions + computed-pos) + + ;; Previous line indent + (setq prev-line-pos (markdown-prev-line-indent)) + (setq positions (cons prev-line-pos positions)) + + ;; Previous non-list-marker indent + (setq positions (cons (markdown-prev-list-indent) positions)) + + ;; Indentation of the previous line + tab-width + (cond + (prev-line-pos + (setq positions (cons (+ prev-line-pos tab-width) positions))) + (t + (setq positions (cons tab-width positions)))) + + ;; Indentation of the previous line - tab-width + (if (and prev-line-pos + (> prev-line-pos tab-width)) + (setq positions (cons (- prev-line-pos tab-width) positions))) + + ;; Indentation of preceeding list item + (setq pos + (save-excursion + (forward-line -1) + (catch 'break + (while (not (equal (point) (point-min))) + (forward-line -1) + (goto-char (point-at-bol)) + (when (re-search-forward markdown-regex-list-indent (point-at-eol) t) + (throw 'break (length (match-string 1))))) + nil))) + (if pos + (setq positions (cons pos positions))) + + ;; First column + (setq positions (cons 0 (reverse positions))) + + positions)) + +(defun markdown-enter-key () + "Insert a newline and optionally indent the next line." + (interactive) + (newline) + (if markdown-indent-on-enter + (funcall indent-line-function))) + + + +;;; Keymap ==================================================================== + +(defvar markdown-mode-map + (let ((markdown-mode-map (make-keymap))) + ;; Element insertion + (define-key markdown-mode-map "\C-c\C-al" 'markdown-insert-link) + (define-key markdown-mode-map "\C-c\C-aw" 'markdown-insert-wiki-link) + (define-key markdown-mode-map "\C-c\C-ii" 'markdown-insert-image) + (define-key markdown-mode-map "\C-c\C-t1" 'markdown-insert-header-1) + (define-key markdown-mode-map "\C-c\C-t2" 'markdown-insert-header-2) + (define-key markdown-mode-map "\C-c\C-t3" 'markdown-insert-header-3) + (define-key markdown-mode-map "\C-c\C-t4" 'markdown-insert-header-4) + (define-key markdown-mode-map "\C-c\C-t5" 'markdown-insert-header-5) + (define-key markdown-mode-map "\C-c\C-t6" 'markdown-insert-header-6) + (define-key markdown-mode-map "\C-c\C-pb" 'markdown-insert-bold) + (define-key markdown-mode-map "\C-c\C-ss" 'markdown-insert-bold) + (define-key markdown-mode-map "\C-c\C-pi" 'markdown-insert-italic) + (define-key markdown-mode-map "\C-c\C-se" 'markdown-insert-italic) + (define-key markdown-mode-map "\C-c\C-pf" 'markdown-insert-code) + (define-key markdown-mode-map "\C-c\C-sc" 'markdown-insert-code) + (define-key markdown-mode-map "\C-c\C-sb" 'markdown-insert-blockquote) + (define-key markdown-mode-map "\C-c\C-s\C-b" 'markdown-blockquote-region) + (define-key markdown-mode-map "\C-c\C-sp" 'markdown-insert-pre) + (define-key markdown-mode-map "\C-c\C-s\C-p" 'markdown-pre-region) + (define-key markdown-mode-map "\C-c-" 'markdown-insert-hr) + (define-key markdown-mode-map "\C-c\C-tt" 'markdown-insert-title) + (define-key markdown-mode-map "\C-c\C-ts" 'markdown-insert-section) + ;; Indentation + (define-key markdown-mode-map "\C-m" 'markdown-enter-key) + ;; Visibility cycling + (define-key markdown-mode-map (kbd "<tab>") 'markdown-cycle) + (define-key markdown-mode-map (kbd "<S-iso-lefttab>") 'markdown-shifttab) + ;; Markdown functions + (define-key markdown-mode-map "\C-c\C-cm" 'markdown) + (define-key markdown-mode-map "\C-c\C-cp" 'markdown-preview) + ;; References + (define-key markdown-mode-map "\C-c\C-cc" 'markdown-check-refs) + markdown-mode-map) + "Keymap for Markdown major mode.") + +;;; Menu ================================================================== + +(easy-menu-define markdown-mode-menu markdown-mode-map + "Menu for Markdown mode" + '("Markdown" + ("Show/Hide" + ["Cycle visibility" markdown-cycle (outline-on-heading-p)] + ["Cycle global visibility" markdown-shifttab]) + "---" + ["Compile" markdown] + ["Preview" markdown-preview] + "---" + ("Headers (setext)" + ["Insert Title" markdown-insert-title] + ["Insert Section" markdown-insert-section]) + ("Headers (atx)" + ["First level" markdown-insert-header-1] + ["Second level" markdown-insert-header-2] + ["Third level" markdown-insert-header-3] + ["Fourth level" markdown-insert-header-4] + ["Fifth level" markdown-insert-header-5] + ["Sixth level" markdown-insert-header-6]) + "---" + ["Bold" markdown-insert-bold] + ["Italic" markdown-insert-italic] + ["Blockquote" markdown-insert-blockquote] + ["Preformatted" markdown-insert-pre] + ["Code" markdown-insert-code] + "---" + ["Insert inline link" markdown-insert-link] + ["Insert image" markdown-insert-image] + ["Insert horizontal rule" markdown-insert-hr] + "---" + ["Check references" markdown-check-refs] + "---" + ["Version" markdown-show-version] + )) + + + +;;; References ================================================================ + +;;; Undefined reference checking code by Dmitry Dzhus <mail@sphinx.net.ru>. + +(defconst markdown-refcheck-buffer + "*Undefined references for %BUFFER%*" + "Pattern for name of buffer for listing undefined references. +The string %BUFFER% will be replaced by the corresponding +`markdown-mode' buffer name.") + +(defun markdown-has-reference-definition (reference) + "Find out whether Markdown REFERENCE is defined. + +REFERENCE should include the square brackets, like [this]." + (let ((reference (downcase reference))) + (save-excursion + (goto-char (point-min)) + (catch 'found + (while (re-search-forward markdown-regex-reference-definition nil t) + (when (string= reference (downcase (match-string-no-properties 1))) + (throw 'found t))))))) + +(defun markdown-get-undefined-refs () + "Return a list of undefined Markdown references. + +Result is an alist of pairs (reference . occurencies), where +occurencies is itself another alist of pairs (label . +line-number). + +For example, an alist corresponding to [Nice editor][Emacs] at line 12, +\[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is +\((\"[emacs]\" (\"[Nice editor]\" . 12) (\"[GNU Emacs]\" . 45)) (\"[elisp]\" (\"[manual]\" . 127)))." + (let ((missing)) + (save-excursion + (goto-char (point-min)) + (while + (re-search-forward markdown-regex-link-reference nil t) + (let* ((label (match-string-no-properties 1)) + (reference (match-string-no-properties 2)) + (target (downcase (if (string= reference "[]") label reference)))) + (unless (markdown-has-reference-definition target) + (let ((entry (assoc target missing))) + (if (not entry) + (add-to-list 'missing (cons target + (list (cons label (markdown-line-number-at-pos)))) t) + (setcdr entry + (append (cdr entry) (list (cons label (markdown-line-number-at-pos)))))))))) + missing))) + +(defun markdown-add-missing-ref-definition (ref buffer &optional recheck) + "Add blank REF definition to the end of BUFFER. + +REF is a Markdown reference in square brackets, like \"[lisp-history]\". + +When RECHECK is non-nil, BUFFER gets rechecked for undefined +references so that REF disappears from the list of those links." + (with-current-buffer buffer + (when (not (eq major-mode 'markdown-mode)) + (error "Not available in current mode")) + (goto-char (point-max)) + (indent-new-comment-line) + (insert (concat ref ": "))) + (switch-to-buffer-other-window buffer) + (goto-char (point-max)) + (when recheck + (markdown-check-refs t))) + +;; Button which adds an empty Markdown reference definition to the end +;; of buffer specified as its 'target-buffer property. Reference name +;; is button's label +(when (>= emacs-major-version 22) + (define-button-type 'markdown-ref-button + 'help-echo "Push to create an empty reference definition" + 'face 'bold + 'action (lambda (b) + (markdown-add-missing-ref-definition + (button-label b) (button-get b 'target-buffer) t)))) + +;; Button jumping to line in buffer specified as its 'target-buffer +;; property. Line number is button's 'line property. +(when (>= emacs-major-version 22) + (define-button-type 'goto-line-button + 'help-echo "Push to go to this line" + 'face 'italic + 'action (lambda (b) + (message (button-get b 'buffer)) + (switch-to-buffer-other-window (button-get b 'target-buffer)) + (goto-line (button-get b 'target-line))))) + +(defun markdown-check-refs (&optional silent) + "Show all undefined Markdown references in current `markdown-mode' buffer. + +If SILENT is non-nil, do not message anything when no undefined +references found. + +Links which have empty reference definitions are considered to be +defined." + (interactive "P") + (when (not (eq major-mode 'markdown-mode)) + (error "Not available in current mode")) + (let ((oldbuf (current-buffer)) + (refs (markdown-get-undefined-refs)) + (refbuf (get-buffer-create (replace-regexp-in-string + "%BUFFER%" (buffer-name) + markdown-refcheck-buffer t)))) + (if (null refs) + (progn + (when (not silent) + (message "No undefined references found")) + (kill-buffer refbuf)) + (with-current-buffer refbuf + (when view-mode + (View-exit-and-edit)) + (erase-buffer) + (insert "Following references lack definitions:") + (newline 2) + (dolist (ref refs) + (let ((button-label (format "%s" (car ref)))) + (if (>= emacs-major-version 22) + ;; Create a reference button in Emacs 22 + (insert-text-button button-label + :type 'markdown-ref-button + 'target-buffer oldbuf) + ;; Insert reference as text in Emacs < 22 + (insert button-label))) + (insert " (") + (dolist (occurency (cdr ref)) + (let ((line (cdr occurency))) + (if (>= emacs-major-version 22) + ;; Create a line number button in Emacs 22 + (insert-button (number-to-string line) + :type 'goto-line-button + 'target-buffer oldbuf + 'target-line line) + ;; Insert line number as text in Emacs < 22 + (insert (number-to-string line))) + (insert " "))) (delete-backward-char 1) + (insert ")") + (newline)) + (view-buffer-other-window refbuf) + (goto-line 4))))) + + +;;; Outline =================================================================== + +;; The following visibility cycling code was taken from org-mode +;; by Carsten Dominik and adapted for markdown-mode. + +(defvar markdown-cycle-global-status 1) +(defvar markdown-cycle-subtree-status nil) + +;; Based on org-end-of-subtree from org.el +(defun markdown-end-of-subtree (&optional invisible-OK) + "Move to the end of the current subtree. +Only visible heading lines are considered, unless INVISIBLE-OK is +non-nil." + (outline-back-to-heading invisible-OK) + (let ((first t) + (level (funcall outline-level))) + (while (and (not (eobp)) + (or first (> (funcall outline-level) level))) + (setq first nil) + (outline-next-heading)) + (if (memq (preceding-char) '(?\n ?\^M)) + (progn + ;; Go to end of line before heading + (forward-char -1) + (if (memq (preceding-char) '(?\n ?\^M)) + ;; leave blank line before heading + (forward-char -1))))) + (point)) + +;; Based on org-cycle from org.el. +(defun markdown-cycle (&optional arg) + "Visibility cycling for Markdown mode. +If ARG is t, perform global visibility cycling. If the point is +at an atx-style header, cycle visibility of the corresponding +subtree. Otherwise, insert a tab using `indent-relative'." + (interactive "P") + (cond + ((eq arg t) ;; Global cycling + (cond + ((and (eq last-command this-command) + (eq markdown-cycle-global-status 2)) + ;; Move from overview to contents + (hide-sublevels 1) + (message "CONTENTS") + (setq markdown-cycle-global-status 3)) + + ((and (eq last-command this-command) + (eq markdown-cycle-global-status 3)) + ;; Move from contents to all + (show-all) + (message "SHOW ALL") + (setq markdown-cycle-global-status 1)) + + (t + ;; Defaults to overview + (hide-body) + (message "OVERVIEW") + (setq markdown-cycle-global-status 2)))) + + ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) + ;; At a heading: rotate between three different views + (outline-back-to-heading) + (let ((goal-column 0) eoh eol eos) + ;; Determine boundaries + (save-excursion + (outline-back-to-heading) + (save-excursion + (beginning-of-line 2) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) (setq eol (point))) + (outline-end-of-heading) (setq eoh (point)) + (markdown-end-of-subtree t) + (skip-chars-forward " \t\n") + (beginning-of-line 1) ; in case this is an item + (setq eos (1- (point)))) + ;; Find out what to do next and set `this-command' + (cond + ((= eos eoh) + ;; Nothing is hidden behind this heading + (message "EMPTY ENTRY") + (setq markdown-cycle-subtree-status nil)) + ((>= eol eos) + ;; Entire subtree is hidden in one line: open it + (show-entry) + (show-children) + (message "CHILDREN") + (setq markdown-cycle-subtree-status 'children)) + ((and (eq last-command this-command) + (eq markdown-cycle-subtree-status 'children)) + ;; We just showed the children, now show everything. + (show-subtree) + (message "SUBTREE") + (setq markdown-cycle-subtree-status 'subtree)) + (t + ;; Default action: hide the subtree. + (hide-subtree) + (message "FOLDED") + (setq markdown-cycle-subtree-status 'folded))))) + + (t + (message "TAB") + (funcall indent-line-function)))) + +;; Based on org-shifttab from org.el. +(defun markdown-shifttab () + "Global visibility cycling. +Calls `markdown-cycle' with argument t." + (interactive) + (markdown-cycle t)) + +;;; Commands ================================================================== + +(defun markdown () + "Run markdown on the current buffer and preview the output in another buffer." + (interactive) + (if (and (boundp 'transient-mark-mode) transient-mark-mode mark-active) + (shell-command-on-region (region-beginning) (region-end) markdown-command + "*markdown-output*" nil) + (shell-command-on-region (point-min) (point-max) markdown-command + "*markdown-output*" nil)) + (let (title) + (setq title (buffer-name)) + (save-excursion + (set-buffer "*markdown-output*") + (goto-char (point-min)) + (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" + "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" + "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" + "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" + "<head>\n<title>") + (insert title) + (insert "</title>\n") + (if markdown-css-path + (insert "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" + markdown-css-path + "\" />\n")) + (insert "</head>\n\n" + "<body>\n\n") + (goto-char (point-max)) + (insert "\n" + "</body>\n" + "</html>\n")))) + +(defun markdown-preview () + "Run markdown on the current buffer and preview the output in a browser." + (interactive) + (markdown) + (browse-url-of-buffer "*markdown-output*")) + + +;;; Miscellaneous ============================================================= + +(defun markdown-line-number-at-pos (&optional pos) + "Return (narrowed) buffer line number at position POS. +If POS is nil, use current buffer location. +This is an exact copy of `line-number-at-pos' for use in emacs21." + (let ((opoint (or pos (point))) start) + (save-excursion + (goto-char (point-min)) + (setq start (point)) + (goto-char opoint) + (forward-line 0) + (1+ (count-lines start (point)))))) + +(defun markdown-nobreak-p () + "Returns nil if it is ok for fill-paragraph to insert a line + break at point" + ;; are we inside in square brackets + (looking-back "\\[[^]]*")) + + + +;;; Mode definition ========================================================== + +(defun markdown-show-version () + "Show the version number in the minibuffer." + (interactive) + (message "markdown-mode, version %s" markdown-mode-version)) + +;;;###autoload +(define-derived-mode markdown-mode text-mode "Markdown" + "Major mode for editing Markdown files." + ;; Comments + (make-local-variable 'comment-start) + (setq comment-start "<!-- ") + (make-local-variable 'comment-end) + (setq comment-end " -->") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "<!--[ \t]*") + (make-local-variable 'comment-column) + (setq comment-column 0) + ;; Font lock. + (set (make-local-variable 'font-lock-defaults) + '(markdown-mode-font-lock-keywords)) + (set (make-local-variable 'font-lock-multiline) t) + ;; For menu support in XEmacs + (easy-menu-add markdown-mode-menu markdown-mode-map) + ;; Make filling work with lists (unordered, ordered, and definition) + (set (make-local-variable 'paragraph-start) + "\f\\|[ \t]*$\\|^[ \t]*[*+-] \\|^[ \t*][0-9]+\\.\\|^[ \t]*: ") + ;; Outline mode + (make-local-variable 'outline-regexp) + (setq outline-regexp "#+") + ;; Cause use of ellipses for invisible text. + (add-to-invisibility-spec '(outline . t)) + ;; Indentation and filling + (make-local-variable 'fill-nobreak-predicate) + (add-hook 'fill-nobreak-predicate 'markdown-nobreak-p) + (setq indent-line-function markdown-indent-function)) + +;(add-to-list 'auto-mode-alist '("\\.text$" . markdown-mode)) + +(provide 'markdown-mode) + +;;; markdown-mode.el ends here