--- /dev/null
+;;; sregex.el --- symbolic regular expressions
+
+;; Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+
+;; Author: Bob Glickstein <bobg+sregex@zanshin.com>
+;; Maintainer: Bob Glickstein <bobg+sregex@zanshin.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package allows you to write regular expressions using a
+;; totally new, Lisp-like syntax.
+
+;; A "symbolic regular expression" (sregex for short) is a Lisp form
+;; that, when evaluated, produces the string form of the specified
+;; regular expression. Here's a simple example:
+
+;; (sregexq (or "Bob" "Robert")) => "Bob\\|Robert"
+
+;; As you can see, an sregex is specified by placing one or more
+;; special clauses in a call to `sregexq'. The clause in this case is
+;; the `or' of two strings (not to be confused with the Lisp function
+;; `or'). The list of allowable clauses appears below.
+
+;; With sregex, it is never necessary to "escape" magic characters
+;; that are meant to be taken literally; that happens automatically.
+;; For example:
+
+;; (sregexq "M*A*S*H") => "M\\*A\\*S\\*H"
+
+;; It is also unnecessary to "group" parts of the expression together
+;; to overcome operator precedence; that also happens automatically.
+;; For example:
+
+;; (sregexq (opt (or "Bob" "Robert"))) => "\\(Bob\\|Robert\\)?"
+
+;; It *is* possible to group parts of the expression in order to refer
+;; to them with numbered backreferences:
+
+;; (sregexq (group (or "Go" "Run"))
+;; ", Spot, "
+;; (backref 1)) => "\\(Go\\|Run\\), Spot, \\1"
+
+;; If `sregexq' needs to introduce its own grouping parentheses, it
+;; will automatically renumber your backreferences:
+
+;; (sregexq (opt "resent-")
+;; (group (or "to" "cc" "bcc"))
+;; ": "
+;; (backref 1)) => "\\(resent-\\)?\\(to\\|cc\\|bcc\\): \\2"
+
+;; `sregexq' is a macro. Each time it is used, it constructs a simple
+;; Lisp expression that then invokes a moderately complex engine to
+;; interpret the sregex and render the string form. Because of this,
+;; I don't recommend sprinkling calls to `sregexq' throughout your
+;; code, the way one normally does with string regexes (which are
+;; cheap to evaluate). Instead, it's wiser to precompute the regexes
+;; you need wherever possible instead of repeatedly constructing the
+;; same ones over and over. Example:
+
+;; (let ((field-regex (sregexq (opt "resent-")
+;; (or "to" "cc" "bcc"))))
+;; ...
+;; (while ...
+;; ...
+;; (re-search-forward field-regex ...)
+;; ...))
+
+;; The arguments to `sregexq' are automatically quoted, but the
+;; flipside of this is that it is not straightforward to include
+;; computed (i.e., non-constant) values in `sregexq' expressions. So
+;; `sregex' is a function that is like `sregexq' but which does not
+;; automatically quote its values. Literal sregex clauses must be
+;; explicitly quoted like so:
+
+;; (sregex '(or "Bob" "Robert")) => "Bob\\|Robert"
+
+;; but computed clauses can be included easily, allowing for the reuse
+;; of common clauses:
+
+;; (let ((dotstar '(0+ any))
+;; (whitespace '(1+ (syntax ?-)))
+;; (digits '(1+ (char (?0 . ?9)))))
+;; (sregex 'bol dotstar ":" whitespace digits)) => "^.*:\\s-+[0-9]+"
+
+;; This package also provides sregex-specific versions of the Emacs
+;; functions `replace-match', `match-string',
+;; `match-string-no-properties', `match-beginning', `match-end', and
+;; `match-data'. In each case, the sregex version's name begins with
+;; `sregex-' and takes one additional optional parameter, an sregex
+;; "info" object. Each of these functions is concerned with numbered
+;; submatches. Since sregex may renumber submatches, alternate
+;; versions of these functions are needed that know how to adjust the
+;; supplied number.
+
+;; The sregex info object for the most recently evaluated sregex can
+;; be obtained with `sregex-info'; so if you precompute your sregexes
+;; and you plan to use `replace-match' or one of the others with it,
+;; you need to record the info object for later use:
+
+;; (let* ((regex (sregexq (opt "resent-")
+;; (group (or "to" "cc" "bcc"))
+;; ":"))
+;; (regex-info (sregex-info)))
+;; ...
+;; (if (re-search-forward regex ...)
+;; (let ((which (sregex-match-string 1 nil regex-info)))
+;; ...)))
+
+;; In this example, `regex' is "\\(resent-\\)?\\(to\\|cc\\|bcc\\):",
+;; so the call to (sregex-match-string 1 ...) is automatically turned
+;; into a call to (match-string 2 ...).
+
+;; If the sregex info argument to `sregex-replace-match',
+;; `sregex-match-string', `sregex-match-string-no-properties',
+;; `sregex-match-beginning', `sregex-match-end', or
+;; `sregex-match-data' is omitted, the current value of (sregex-info)
+;; is used.
+
+;; You can do your own sregex submatch renumbering with
+;; `sregex-backref-num'.
+
+;; Finally, `sregex-save-match-data' is like `save-match-data' but
+;; also saves and restores the information maintained by
+;; `sregex-info'.
+
+;; To use this package in a Lisp program, simply (require 'sregex).
+
+;; Here are the clauses allowed in an `sregex' or `sregexq'
+;; expression:
+
+;; - a string
+;; This stands for the literal string. If it contains
+;; metacharacters, they will be escaped in the resulting regex
+;; (using `regexp-quote').
+
+;; - the symbol `any'
+;; This stands for ".", a regex matching any character except
+;; newline.
+
+;; - the symbol `bol'
+;; Stands for "^", matching the empty string at the beginning of a line
+
+;; - the symbol `eol'
+;; Stands for "$", matching the empty string at the end of a line
+
+;; - (group CLAUSE ...)
+;; Groups the given CLAUSEs using "\\(" and "\\)".
+
+;; - (sequence CLAUSE ...)
+
+;; Groups the given CLAUSEs; may or may not use "\\(" and "\\)".
+;; Clauses groups by `sequence' do not count for purposes of
+;; numbering backreferences. Use `sequence' in situations like
+;; this:
+
+;; (sregexq (or "dog" "cat"
+;; (sequence (opt "sea ") "monkey")))
+;; => "dog\\|cat\\|\\(sea \\)?monkey"
+
+;; where a single `or' alternate needs to contain multiple
+;; subclauses.
+
+;; - (backref N)
+;; Matches the same string previously matched by the Nth "group" in
+;; the same sregex. N is a positive integer. In the resulting
+;; regex, N may be adjusted to account for automatically introduced
+;; groups.
+
+;; - (or CLAUSE ...)
+;; Matches any one of the CLAUSEs by separating them with "\\|".
+
+;; - (0+ CLAUSE ...)
+;; Concatenates the given CLAUSEs and matches zero or more
+;; occurrences by appending "*".
+
+;; - (1+ CLAUSE ...)
+;; Concatenates the given CLAUSEs and matches one or more
+;; occurrences by appending "+".
+
+;; - (opt CLAUSE ...)
+;; Concatenates the given CLAUSEs and matches zero or one occurrence
+;; by appending "?".
+
+;; - (repeat MIN MAX CLAUSE ...)
+;; Concatenates the given CLAUSEs and constructs a regex matching at
+;; least MIN occurrences and at most MAX occurrences. MIN must be a
+;; non-negative integer. MAX must be a non-negative integer greater
+;; than or equal to MIN; or MAX can be nil to mean "infinity."
+
+;; - (char CHAR-CLAUSE ...)
+;; Creates a "character class" matching one character from the given
+;; set. See below for how to construct a CHAR-CLAUSE.
+
+;; - (not-char CHAR-CLAUSE ...)
+;; Creates a "character class" matching any one character not in the
+;; given set. See below for how to construct a CHAR-CLAUSE.
+
+;; - the symbol `bot'
+;; Stands for "\\`", matching the empty string at the beginning of
+;; text (beginning of a string or of a buffer).
+
+;; - the symbol `eot'
+;; Stands for "\\'", matching the empty string at the end of text.
+
+;; - the symbol `point'
+;; Stands for "\\=", matching the empty string at point.
+
+;; - the symbol `word-boundary'
+;; Stands for "\\b", matching the empty string at the beginning or
+;; end of a word.
+
+;; - the symbol `not-word-boundary'
+;; Stands for "\\B", matching the empty string not at the beginning
+;; or end of a word.
+
+;; - the symbol `bow'
+;; Stands for "\\<", matching the empty string at the beginning of a
+;; word.
+
+;; - the symbol `eow'
+;; Stands for "\\>", matching the empty string at the end of a word.
+
+;; - the symbol `wordchar'
+;; Stands for the regex "\\w", matching a word-constituent character
+;; (as determined by the current syntax table)
+
+;; - the symbol `not-wordchar'
+;; Stands for the regex "\\W", matching a non-word-constituent
+;; character.
+
+;; - (syntax CODE)
+;; Stands for the regex "\\sCODE", where CODE is a syntax table code
+;; (a single character). Matches any character with the requested
+;; syntax.
+
+;; - (not-syntax CODE)
+;; Stands for the regex "\\SCODE", where CODE is a syntax table code
+;; (a single character). Matches any character without the
+;; requested syntax.
+
+;; - (regex REGEX)
+;; This is a "trapdoor" for including ordinary regular expression
+;; strings in the result. Some regular expressions are clearer when
+;; written the old way: "[a-z]" vs. (sregexq (char (?a . ?z))), for
+;; instance. However, see the note under "Bugs," below.
+
+;; Each CHAR-CLAUSE that is passed to (char ...) and (not-char ...)
+;; has one of the following forms:
+
+;; - a character
+;; Adds that character to the set.
+
+;; - a string
+;; Adds all the characters in the string to the set.
+
+;; - A pair (MIN . MAX)
+;; Where MIN and MAX are characters, adds the range of characters
+;; from MIN through MAX to the set.
+
+;;; To do:
+
+;; Make (sregexq (or "a" (sequence "b" "c"))) return "a\\|bc" instead
+;; of "a\\|\\(bc\\)"
+
+;; An earlier version of this package could optionally translate the
+;; symbolic regex into other languages' syntaxes, e.g. Perl. For
+;; instance, with Perl syntax selected, (sregexq (or "ab" "cd")) would
+;; yield "ab|cd" instead of "ab\\|cd". It might be useful to restore
+;; such a facility.
+
+;;; Bugs:
+
+;; The (regex REGEX) form can confuse the code that distinguishes
+;; introduced groups from user-specified groups. Try to avoid using
+;; grouping within a `regex' form. Failing that, try to avoid using
+;; backrefs if you're using `regex'.
+
+;;; Code:
+
+(defsubst sregex--value-unitp (val) (nth 0 val))
+(defsubst sregex--value-groups (val) (nth 1 val))
+(defsubst sregex--value-tree (val) (nth 2 val))
+
+(defun sregex--make-value (unitp groups tree)
+ (list unitp groups tree))
+
+(defvar sregex--current-sregex nil
+ "Global state for `sregex-info'.")
+
+(defun sregex-info ()
+ "Return extra information about the latest call to `sregex'.
+This extra information is needed in order to adjust user-requested
+backreference numbers to numbers suitable for the generated regexp.
+See e.g. `sregex-match-string' and `sregex-backref-num'."
+ sregex--current-sregex)
+
+; (require 'advice)
+; (defadvice save-match-data (around sregex-save-match-data protect)
+; (let ((sregex--saved-sregex sregex--current-sregex))
+; (unwind-protect
+; ad-do-it
+; (setq sregex--current-sregex sregex--saved-sregex))))
+(defmacro sregex-save-match-data (&rest forms)
+ "Like `save-match-data', but also saves and restores `sregex-info' data."
+ `(let ((sregex--saved-sregex sregex--current-sregex))
+ (unwind-protect
+ (save-match-data ,@forms)
+ (setq sregex--current-sregex sregex--saved-sregex))))
+
+(defun sregex-replace-match (replacement
+ &optional fixedcase literal string subexp sregex)
+ "Like `replace-match', for a regexp made with `sregex'.
+This takes one additional optional argument, the `sregex' info, which
+can be obtained with `sregex-info'. The SUBEXP argument is adjusted
+to allow for \"introduced groups\". If the extra argument is omitted
+or nil, it defaults to the current value of (sregex-info)."
+ (replace-match replacement fixedcase literal string
+ (and subexp
+ (sregex-backref-num
+ subexp
+ (sregex--value-groups (or sregex
+ sregex--current-sregex))))))
+
+(defun sregex-match-string (count &optional in-string sregex)
+ "Like `match-string', for a regexp made with `sregex'.
+This takes one additional optional argument, the `sregex' info, which
+can be obtained with `sregex-info'. The COUNT argument is adjusted to
+allow for \"introduced groups\". If the extra argument is omitted or
+nil, it defaults to the current value of (sregex-info)."
+ (match-string (and count
+ (sregex-backref-num
+ count
+ (sregex--value-groups (or sregex
+ sregex--current-sregex))))
+ in-string))
+
+(defun sregex-match-string-no-properties (count &optional in-string sregex)
+ "Like `match-string-no-properties', for a regexp made with `sregex'.
+This takes one additional optional argument, the `sregex' info, which
+can be obtained with `sregex-info'. The COUNT argument is adjusted to
+allow for \"introduced groups\". If the extra argument is omitted or
+nil, it defaults to the current value of (sregex-info)."
+ (match-string-no-properties
+ (and count
+ (sregex-backref-num
+ count
+ (sregex--value-groups (or sregex
+ sregex--current-sregex))))
+ in-string))
+
+(defun sregex-match-beginning (count &optional sregex)
+ "Like `match-beginning', for a regexp made with `sregex'.
+This takes one additional optional argument, the `sregex' info, which
+can be obtained with `sregex-info'. The COUNT argument is adjusted to
+allow for \"introduced groups\". If the extra argument is omitted or
+nil, it defaults to the current value of (sregex-info)."
+ (match-beginning (sregex-backref-num
+ count
+ (sregex--value-groups (or sregex
+ sregex--current-sregex)))))
+
+(defun sregex-match-end (count &optional sregex)
+ "Like `match-end', for a regexp made with `sregex'.
+This takes one additional optional argument, the `sregex' info, which
+can be obtained with `sregex-info'. The COUNT argument is adjusted to
+allow for \"introduced groups\". If the extra argument is omitted or
+nil, it defaults to the current value of (sregex-info)."
+ (match-end (sregex-backref-num
+ count
+ (sregex--value-groups (or sregex
+ sregex--current-sregex)))))
+
+(defun sregex-match-data (&optional sregex)
+ "Like `match-data', for a regexp made with `sregex'.
+This takes one additional optional argument, the `sregex' info, which
+can be obtained with `sregex-info'. \"Introduced groups\" are removed
+from the result. If the extra argument is omitted or nil, it defaults
+to the current value of (sregex-info)."
+ (let* ((data (match-data))
+ (groups (sregex--value-groups (or sregex
+ sregex--current-sregex)))
+ (result (list (car (cdr data))
+ (car data))))
+ (setq data (cdr (cdr data)))
+ (while data
+ (if (car groups)
+ (setq result (append (list (car (cdr data))
+ (car data))
+ result)))
+ (setq groups (cdr groups)
+ data (cdr (cdr data))))
+ (reverse result)))
+
+(defun sregex--render-tree (tree sregex)
+ (let ((key (car tree)))
+ (cond ((eq key 'str)
+ (cdr tree))
+ ((eq key 'or)
+ (mapconcat '(lambda (x)
+ (sregex--render-tree x sregex))
+ (cdr tree)
+ "\\|"))
+ ((eq key 'sequence)
+ (apply 'concat
+ (mapcar '(lambda (x)
+ (sregex--render-tree x sregex))
+ (cdr tree))))
+ ((eq key 'group)
+ (concat "\\("
+ (sregex--render-tree (cdr tree) sregex)
+ "\\)"))
+ ((eq key 'opt)
+ (concat (sregex--render-tree (cdr tree) sregex)
+ "?"))
+ ((eq key '0+)
+ (concat (sregex--render-tree (cdr tree) sregex)
+ "*"))
+ ((eq key '1+)
+ (concat (sregex--render-tree (cdr tree) sregex)
+ "+"))
+ ((eq key 'backref)
+ (let ((num (sregex-backref-num (cdr tree) sregex)))
+ (if (> num 9)
+ (error "sregex: backref number %d too high after adjustment"
+ num)
+ (concat "\\" (int-to-string num)))))
+ (t (error "sregex internal error: unknown tree type %S"
+ key)))))
+
+(defun sregex (&rest exps)
+ "Symbolic regular expression interpreter.
+This is exactly like `sregexq' (q.v.) except that it evaluates all its
+arguments, so literal sregex clauses must be quoted. For example:
+
+ (sregex '(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
+
+An argument-evaluating sregex interpreter lets you reuse sregex
+subexpressions:
+
+ (let ((dotstar '(0+ any))
+ (whitespace '(1+ (syntax ?-)))
+ (digits '(1+ (char (?0 . ?9)))))
+ (sregex 'bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\""
+ (progn
+ (setq sregex--current-sregex (sregex--sequence exps nil))
+ (sregex--render-tree (sregex--value-tree sregex--current-sregex)
+ sregex--current-sregex)))
+
+(defmacro sregexq (&rest exps)
+ "Symbolic regular expression interpreter.
+This macro allows you to specify a regular expression (regexp) in
+symbolic form, and converts it into the string form required by Emacs's
+regex functions such as `re-search-forward' and `looking-at'. Here is
+a simple example:
+
+ (sregexq (or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
+
+As you can see, an sregex is specified by placing one or more special
+clauses in a call to `sregexq'. The clause in this case is the `or'
+of two strings (not to be confused with the Lisp function `or'). The
+list of allowable clauses appears below.
+
+With `sregex', it is never necessary to \"escape\" magic characters
+that are meant to be taken literally; that happens automatically.
+For example:
+
+ (sregexq \"M*A*S*H\") => \"M\\\\*A\\\\*S\\\\*H\"
+
+It is also unnecessary to \"group\" parts of the expression together
+to overcome operator precedence; that also happens automatically.
+For example:
+
+ (sregexq (opt (or \"Bob\" \"Robert\"))) => \"\\\\(Bob\\\\|Robert\\\\)?\"
+
+It *is* possible to group parts of the expression in order to refer
+to them with numbered backreferences:
+
+ (sregexq (group (or \"Go\" \"Run\"))
+ \", Spot, \"
+ (backref 1)) => \"\\\\(Go\\\\|Run\\\\), Spot, \\\\1\"
+
+If `sregexq' needs to introduce its own grouping parentheses, it will
+automatically renumber your backreferences:
+
+ (sregexq (opt \"resent-\")
+ (group (or \"to\" \"cc\" \"bcc\"))
+ \": \"
+ (backref 1)) => \"\\\\(resent-\\\\)?\\\\(to\\\\|cc\\\\|bcc\\\\): \\\\2\"
+
+`sregexq' is a macro. Each time it is used, it constructs a simple
+Lisp expression that then invokes a moderately complex engine to
+interpret the sregex and render the string form. Because of this, I
+don't recommend sprinkling calls to `sregexq' throughout your code,
+the way one normally does with string regexes (which are cheap to
+evaluate). Instead, it's wiser to precompute the regexes you need
+wherever possible instead of repeatedly constructing the same ones
+over and over. Example:
+
+ (let ((field-regex (sregexq (opt \"resent-\")
+ (or \"to\" \"cc\" \"bcc\"))))
+ ...
+ (while ...
+ ...
+ (re-search-forward field-regex ...)
+ ...))
+
+The arguments to `sregexq' are automatically quoted, but the
+flipside of this is that it is not straightforward to include
+computed (i.e., non-constant) values in `sregexq' expressions. So
+`sregex' is a function that is like `sregexq' but which does not
+automatically quote its values. Literal sregex clauses must be
+explicitly quoted like so:
+
+ (sregex '(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
+
+but computed clauses can be included easily, allowing for the reuse
+of common clauses:
+
+ (let ((dotstar '(0+ any))
+ (whitespace '(1+ (syntax ?-)))
+ (digits '(1+ (char (?0 . ?9)))))
+ (sregex 'bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\"
+
+Here are the clauses allowed in an `sregex' or `sregexq' expression:
+
+- a string
+ This stands for the literal string. If it contains
+ metacharacters, they will be escaped in the resulting regex
+ (using `regexp-quote').
+
+- the symbol `any'
+ This stands for \".\", a regex matching any character except
+ newline.
+
+- the symbol `bol'
+ Stands for \"^\", matching the empty string at the beginning of a line
+
+- the symbol `eol'
+ Stands for \"$\", matching the empty string at the end of a line
+
+- (group CLAUSE ...)
+ Groups the given CLAUSEs using \"\\\\(\" and \"\\\\)\".
+
+- (sequence CLAUSE ...)
+
+ Groups the given CLAUSEs; may or may not use \"\\\\(\" and \"\\\\)\".
+ Clauses groups by `sequence' do not count for purposes of
+ numbering backreferences. Use `sequence' in situations like
+ this:
+
+ (sregexq (or \"dog\" \"cat\"
+ (sequence (opt \"sea \") \"monkey\")))
+ => \"dog\\\\|cat\\\\|\\\\(sea \\\\)?monkey\"
+
+ where a single `or' alternate needs to contain multiple
+ subclauses.
+
+- (backref N)
+ Matches the same string previously matched by the Nth \"group\" in
+ the same sregex. N is a positive integer. In the resulting
+ regex, N may be adjusted to account for automatically introduced
+ groups.
+
+- (or CLAUSE ...)
+ Matches any one of the CLAUSEs by separating them with \"\\\\|\".
+
+- (0+ CLAUSE ...)
+ Concatenates the given CLAUSEs and matches zero or more
+ occurrences by appending \"*\".
+
+- (1+ CLAUSE ...)
+ Concatenates the given CLAUSEs and matches one or more
+ occurrences by appending \"+\".
+
+- (opt CLAUSE ...)
+ Concatenates the given CLAUSEs and matches zero or one occurrence
+ by appending \"?\".
+
+- (repeat MIN MAX CLAUSE ...)
+ Concatenates the given CLAUSEs and constructs a regex matching at
+ least MIN occurrences and at most MAX occurrences. MIN must be a
+ non-negative integer. MAX must be a non-negative integer greater
+ than or equal to MIN; or MAX can be nil to mean \"infinity.\"
+
+- (char CHAR-CLAUSE ...)
+ Creates a \"character class\" matching one character from the given
+ set. See below for how to construct a CHAR-CLAUSE.
+
+- (not-char CHAR-CLAUSE ...)
+ Creates a \"character class\" matching any one character not in the
+ given set. See below for how to construct a CHAR-CLAUSE.
+
+- the symbol `bot'
+ Stands for \"\\\\`\", matching the empty string at the beginning of
+ text (beginning of a string or of a buffer).
+
+- the symbol `eot'
+ Stands for \"\\\\'\", matching the empty string at the end of text.
+
+- the symbol `point'
+ Stands for \"\\\\=\", matching the empty string at point.
+
+- the symbol `word-boundary'
+ Stands for \"\\\\b\", matching the empty string at the beginning or
+ end of a word.
+
+- the symbol `not-word-boundary'
+ Stands for \"\\\\B\", matching the empty string not at the beginning
+ or end of a word.
+
+- the symbol `bow'
+ Stands for \"\\\\\\=<\", matching the empty string at the beginning of a
+ word.
+
+- the symbol `eow'
+ Stands for \"\\\\\\=>\", matching the empty string at the end of a word.
+
+- the symbol `wordchar'
+ Stands for the regex \"\\\\w\", matching a word-constituent character
+ (as determined by the current syntax table)
+
+- the symbol `not-wordchar'
+ Stands for the regex \"\\\\W\", matching a non-word-constituent
+ character.
+
+- (syntax CODE)
+ Stands for the regex \"\\\\sCODE\", where CODE is a syntax table code
+ (a single character). Matches any character with the requested
+ syntax.
+
+- (not-syntax CODE)
+ Stands for the regex \"\\\\SCODE\", where CODE is a syntax table code
+ (a single character). Matches any character without the
+ requested syntax.
+
+- (regex REGEX)
+ This is a \"trapdoor\" for including ordinary regular expression
+ strings in the result. Some regular expressions are clearer when
+ written the old way: \"[a-z]\" vs. (sregexq (char (?a . ?z))), for
+ instance. However, using this can confuse the code that
+ distinguishes introduced groups from user-specified groups. Avoid
+ using grouping within a `regex' form. Failing that, avoid using
+ backrefs if you're using `regex'.
+
+Each CHAR-CLAUSE that is passed to (char ...) and (not-char ...)
+has one of the following forms:
+
+- a character
+ Adds that character to the set.
+
+- a string
+ Adds all the characters in the string to the set.
+
+- A pair (MIN . MAX)
+ Where MIN and MAX are characters, adds the range of characters
+ from MIN through MAX to the set."
+ `(apply 'sregex ',exps))
+
+(defun sregex--engine (exp combine)
+ (let* ((val (cond ((stringp exp)
+ (sregex--make-value (or (not (eq combine 'suffix))
+ (= (length exp) 1))
+ nil
+ (cons 'str
+ (regexp-quote exp))))
+ ((symbolp exp)
+ (funcall (intern (concat "sregex--"
+ (symbol-name exp)))
+ combine))
+ ((consp exp)
+ (funcall (intern (concat "sregex--"
+ (symbol-name (car exp))))
+ (cdr exp)
+ combine))
+ (t (error "Invalid expression: %s" exp))))
+ (unitp (sregex--value-unitp val))
+ (groups (sregex--value-groups val))
+ (tree (sregex--value-tree val)))
+ (if (and combine (not unitp))
+ (sregex--make-value t
+ (cons nil groups)
+ (cons 'group tree))
+ (sregex--make-value unitp groups tree))))
+
+(defun sregex--sequence (exps combine)
+ (if (= (length exps) 1)
+ (sregex--engine (car exps) combine)
+ (let ((groups nil)
+ (trees nil)) ;grows in reverse
+ (while exps
+ (let ((val (sregex--engine (car exps) 'concat)))
+ (setq groups (append groups
+ (sregex--value-groups val))
+ trees (cons (sregex--value-tree val) trees)
+ exps (cdr exps))))
+ (setq trees (nreverse trees))
+ (if (eq combine 'suffix)
+ (sregex--make-value t
+ (cons nil groups)
+ (cons 'group
+ (cons 'sequence trees)))
+ (sregex--make-value (not (eq combine 'suffix))
+ groups
+ (cons 'sequence trees))))))
+
+(defun sregex--group (exps combine)
+ (let ((val (sregex--sequence exps nil)))
+ (sregex--make-value t
+ (cons t (sregex--value-groups val))
+ (cons 'group (sregex--value-tree val)))))
+
+(defun sregex-backref-num (n &optional sregex)
+ "Adjust backreference number N according to SREGEX.
+When `sregex' introduces parenthesized groups that the user didn't ask
+for, the numbering of the groups that the user *did* ask for gets all
+out of whack. This function accounts for introduced groups. Example:
+
+ (sregexq (opt \"ab\")
+ (group (or \"c\" \"d\"))) => \"\\\\(ab\\\\)?\\\\(c\\\\|d\\\\)\"
+ (setq info (sregex-info))
+ (sregex-backref-num 1 info) => 2
+
+The SREGEX parameter is optional and defaults to the current value of
+`sregex-info'."
+ (let ((groups (sregex--value-groups (or sregex
+ sregex--current-sregex)))
+ (result 0))
+ (while (and groups (> n 0))
+ (if (car groups)
+ (setq n (1- n)))
+ (setq result (1+ result)
+ groups (cdr groups)))
+ result))
+
+(defun sregex--backref (exps combine)
+ (sregex--make-value t nil (cons 'backref (car exps))))
+
+(defun sregex--any (combine)
+ (sregex--make-value t nil '(str . ".")))
+
+(defun sregex--opt (exps combine)
+ (let ((val (sregex--sequence exps 'suffix)))
+ (sregex--make-value t
+ (sregex--value-groups val)
+ (cons 'opt (sregex--value-tree val)))))
+
+(defun sregex--0+ (exps combine)
+ (let ((val (sregex--sequence exps 'suffix)))
+ (sregex--make-value t
+ (sregex--value-groups val)
+ (cons '0+ (sregex--value-tree val)))))
+(defun sregex--1+ (exps combine)
+ (let ((val (sregex--sequence exps 'suffix)))
+ (sregex--make-value t
+ (sregex--value-groups val)
+ (cons '1+ (sregex--value-tree val)))))
+
+(defun sregex--repeat (exps combine)
+ (let ((min (or (car exps) 0))
+ (max (car (cdr exps))))
+ (setq exps (cdr (cdr exps)))
+ (cond ((zerop min)
+ (cond ((equal max 0) ;degenerate
+ (sregex--make-value t nil nil))
+ ((equal max 1)
+ (sregex--opt exps combine))
+ ((not max)
+ (sregex--0+ exps combine))
+ (t (sregex--sequence (make-list max
+ (cons 'opt exps))
+ combine))))
+ ((= min 1)
+ (cond ((equal max 1)
+ (sregex--sequence exps combine))
+ ((not max)
+ (sregex--1+ exps combine))
+ (t (sregex--sequence (append exps
+ (make-list (1- max)
+ (cons 'opt exps)))
+ combine))))
+ (t (sregex--sequence (append exps
+ (list (append (list 'repeat
+ (1- min)
+ (and max
+ (1- max)))
+ exps)))
+ combine)))))
+
+(defun sregex--or (exps combine)
+ (if (= (length exps) 1)
+ (sregex--engine (car exps) combine)
+ (let ((groups nil)
+ (trees nil))
+ (while exps
+ (let ((val (sregex--engine (car exps) 'or)))
+ (setq groups (append groups
+ (sregex--value-groups val))
+ trees (cons (sregex--value-tree val) trees)
+ exps (cdr exps))))
+ (sregex--make-value (eq combine 'or)
+ groups
+ (cons 'or (nreverse trees))))))
+
+(defmacro sregex--char-range-aux ()
+ '(if start
+ (let (startc endc)
+ (if (and (<= 32 start)
+ (<= start 127))
+ (setq startc (char-to-string start)
+ endc (char-to-string end))
+ (setq startc (format "\\%03o" start)
+ endc (format "\\%03o" end)))
+ (if (> end start)
+ (if (> end (+ start 1))
+ (setq class (concat class startc "-" endc))
+ (setq class (concat class startc endc)))
+ (setq class (concat class startc))))))
+
+(defmacro sregex--char-range (rstart rend)
+ `(let ((i ,rstart)
+ start end)
+ (while (<= i ,rend)
+ (if (aref chars i)
+ (progn
+ (if start
+ (setq end i)
+ (setq start i
+ end i))
+ (aset chars i nil))
+ (sregex--char-range-aux)
+ (setq start nil
+ end nil))
+ (setq i (1+ i)))
+ (sregex--char-range-aux)))
+
+(defun sregex--char-aux (complement args)
+ (let ((chars (make-vector 256 nil)))
+ (while args
+ (let ((arg (car args)))
+ (cond ((integerp arg)
+ (aset chars arg t))
+ ((stringp arg)
+ (mapcar (function
+ (lambda (c)
+ (aset chars c t)))
+ arg))
+ ((consp arg)
+ (let ((start (car arg))
+ (end (cdr arg)))
+ (if (> start end)
+ (let ((tmp start))
+ (setq start end
+ end tmp)))
+ ;; now start <= end
+ (let ((i start))
+ (while (<= i end)
+ (aset chars i t)
+ (setq i (1+ i))))))))
+ (setq args (cdr args)))
+ ;; now chars is a map of the characters in the class
+ (let ((class "")
+ (caret (aref chars ?^)))
+ (aset chars ?^ nil)
+ (if (aref chars ?\])
+ (progn
+ (setq class (concat class "]"))
+ (aset chars ?\] nil)))
+ (if (aref chars ?-)
+ (progn
+ (setq class (concat class "-"))
+ (aset chars ?- nil)))
+ (if (aref chars ?\\)
+ (progn
+ (setq class (concat class "\\\\"))
+ (aset chars ?\\ nil)))
+
+ (sregex--char-range ?A ?Z)
+ (sregex--char-range ?a ?z)
+ (sregex--char-range ?0 ?9)
+
+ (let ((i 32))
+ (while (< i 128)
+ (if (aref chars i)
+ (progn
+ (setq class (concat class (char-to-string i)))
+ (aset chars i nil)))
+ (setq i (1+ i))))
+
+ (sregex--char-range 0 31)
+ (sregex--char-range 128 255)
+
+ (let ((i 0))
+ (while (< i 256)
+ (if (aref chars i)
+ (setq class (concat class (format "\\%03o" i))))
+ (setq i (1+ i))))
+
+ (if caret
+ (setq class (concat class "^")))
+ (concat "[" (if complement "^") class "]"))))
+
+(defun sregex--char (exps combine)
+ (sregex--make-value t nil (cons 'str (sregex--char-aux nil exps))))
+(defun sregex--not-char (exps combine)
+ (sregex--make-value t nil (cons 'str (sregex--char-aux t exps))))
+
+(defun sregex--bol (combine)
+ (sregex--make-value t nil '(str . "^")))
+(defun sregex--eol (combine)
+ (sregex--make-value t nil '(str . "$")))
+
+(defun sregex--wordchar (combine)
+ (sregex--make-value t nil '(str . "\\w")))
+(defun sregex--not-wordchar (combine)
+ (sregex--make-value t nil '(str . "\\W")))
+
+(defun sregex--syntax (exps combine)
+ (sregex--make-value t nil (cons 'str (format "\\s%c" (car exps)))))
+(defun sregex--not-syntax (exps combine)
+ (sregex--make-value t nil (cons 'str (format "\\S%c" (car exps)))))
+
+(defun sregex--bot (combine)
+ (sregex--make-value t nil (cons 'str "\\`")))
+(defun sregex--eot (combine)
+ (sregex--make-value t nil (cons 'str "\\'")))
+
+(defun sregex--point (combine)
+ (sregex--make-value t nil '(str . "\\=")))
+
+(defun sregex--word-boundary (combine)
+ (sregex--make-value t nil '(str . "\\b")))
+(defun sregex--not-word-boundary (combine)
+ (sregex--make-value t nil '(str . "\\B")))
+
+(defun sregex--bow (combine)
+ (sregex--make-value t nil '(str . "\\<")))
+(defun sregex--eow (combine)
+ (sregex--make-value t nil '(str . "\\>")))
+
+
+;; trapdoor - usage discouraged
+(defun sregex--regex (exps combine)
+ (sregex--make-value nil nil (car exps)))
+
+(provide 'sregex)
+
+;;; sregex.el ends here
+
--- /dev/null
+;;; net-utils.el --- Network functions
+
+;; Author: Peter Breton <pbreton@cs.umb.edu>
+;; Created: Sun Mar 16 1997
+;; Keywords: network communications
+;; Time-stamp: <1998-06-13 06:19:01 pbreton>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; There are three main areas of functionality:
+;;
+;; * Wrap common network utility programs (ping, traceroute, netstat,
+;; nslookup, arp, route). Note that these wrappers are of the diagnostic
+;; functions of these programs only.
+;;
+;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
+;;
+;; * Support connections to HOST/PORT, generally for debugging and the like.
+;; In other words, for doing much the same thing as "telnet HOST PORT", and
+;; then typing commands.
+;;
+;; PATHS
+;;
+;; On some systems, some of these programs are not in normal user path,
+;; but rather in /sbin, /usr/sbin, and so on.
+
+
+;;; Code:
+(eval-when-compile
+ (require 'comint)
+ (require 'ffap))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Customization Variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgroup net-utils nil
+ "Network utility functions."
+ :prefix "net-utils-"
+ :group 'comm
+ :version "20.3"
+ )
+
+(defcustom net-utils-remove-ctl-m
+ (member system-type (list 'windows-nt 'msdos))
+ "If non-nil, remove control-Ms from output."
+ :group 'net-utils
+ :type 'boolean
+ )
+
+(defcustom traceroute-program
+ (if (eq system-type 'windows-nt)
+ "tracert"
+ "traceroute")
+ "Program to trace network hops to a destination."
+ :group 'net-utils
+ :type 'string
+ )
+
+(defcustom traceroute-program-options nil
+ "Options for the traceroute program."
+ :group 'net-utils
+ :type '(repeat 'string)
+ )
+
+(defcustom ping-program "ping"
+ "Program to send network test packets to a host."
+ :group 'net-utils
+ :type 'string
+ )
+
+;; On Linux and Irix, the system's ping program seems to send packets
+;; indefinitely unless told otherwise
+(defcustom ping-program-options
+ (and (memq system-type (list 'linux 'gnu/linux 'irix))
+ (list "-c" "4"))
+ "Options for the ping program.
+These options can be used to limit how many ICMP packets are emitted."
+ :group 'net-utils
+ :type '(repeat 'string)
+ )
+
+(defcustom ipconfig-program
+ (if (eq system-type 'windows-nt)
+ "ipconfig"
+ "ifconfig")
+ "Program to print network configuration information."
+ :group 'net-utils
+ :type 'string
+ )
+
+(defcustom ipconfig-program-options
+ (list
+ (if (eq system-type 'windows-nt)
+ "/all" "-a"))
+ "Options for ipconfig-program."
+ :group 'net-utils
+ :type '(repeat 'string)
+ )
+
+(defcustom netstat-program "netstat"
+ "Program to print network statistics."
+ :group 'net-utils
+ :type 'string
+ )
+
+(defcustom netstat-program-options nil
+ "Options for netstat-program."
+ :group 'net-utils
+ :type '(repeat 'string)
+ )
+
+(defcustom arp-program "arp"
+ "Program to print IP to address translation tables."
+ :group 'net-utils
+ :type 'string
+ )
+
+(defcustom arp-program-options
+ (list "-a")
+ "Options for arp-program."
+ :group 'net-utils
+ :type '(repeat 'string)
+ )
+
+(defcustom route-program
+ (if (eq system-type 'windows-nt)
+ "route"
+ "netstat")
+ "Program to print routing tables."
+ :group 'net-utils
+ :type 'string
+ )
+
+(defcustom route-program-options
+ (if (eq system-type 'windows-nt)
+ (list "print")
+ (list "-r"))
+ "Options for route-program."
+ :group 'net-utils
+ :type '(repeat 'string)
+ )
+
+(defcustom nslookup-program "nslookup"
+ "Program to interactively query DNS information."
+ :group 'net-utils
+ :type 'string
+ )
+
+(defcustom nslookup-program-options nil
+ "List of options to pass to the nslookup program."
+ :group 'net-utils
+ :type '(repeat 'string)
+ )
+
+(defcustom nslookup-prompt-regexp "^> "
+ "Regexp to match the nslookup prompt."
+ :group 'net-utils
+ :type 'regexp
+ )
+
+(defcustom ftp-program "ftp"
+ "Progam to run to do FTP transfers."
+ :group 'net-utils
+ :type 'string
+ )
+
+(defcustom ftp-program-options nil
+ "List of options to pass to the FTP program."
+ :group 'net-utils
+ :type '(repeat 'string)
+ )
+
+(defcustom ftp-prompt-regexp "^ftp>"
+ "Regexp which matches the FTP program's prompt."
+ :group 'net-utils
+ :type 'regexp
+ )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Nslookup goodies
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst nslookup-font-lock-keywords
+ (and window-system
+ (progn
+ (require 'font-lock)
+ (list
+ (list nslookup-prompt-regexp 0 font-lock-reference-face)
+ (list "^[A-Za-z0-9 _]+:" 0 font-lock-type-face)
+ (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
+ 1 font-lock-keyword-face)
+ ;; Dotted quads
+ (list
+ (mapconcat 'identity
+ (make-list 4 "[0-9]+")
+ "\\.")
+ 0 font-lock-variable-name-face)
+ ;; Host names
+ (list
+ (let ((host-expression "[-A-Za-z0-9]+"))
+ (concat
+ (mapconcat 'identity
+ (make-list 2 host-expression)
+ "\\.")
+ "\\(\\." host-expression "\\)*")
+ )
+ 0 font-lock-variable-name-face)
+ )))
+ "Expressions to font-lock for nslookup.")
+
+(defvar nslookup-abbrev-table (make-abbrev-table)
+ "Abbrev table for nslookup.")
+
+(define-abbrev nslookup-abbrev-table "e" "exit")
+(define-abbrev nslookup-abbrev-table "f" "finger")
+(define-abbrev nslookup-abbrev-table "h" "help")
+(define-abbrev nslookup-abbrev-table "lse" "lserver")
+(define-abbrev nslookup-abbrev-table "r" "root")
+(define-abbrev nslookup-abbrev-table "s" "set")
+(define-abbrev nslookup-abbrev-table "se" "server")
+(define-abbrev nslookup-abbrev-table "v" "viewer")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; FTP goodies
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar ftp-abbrev-table (make-abbrev-table)
+ "Abbrev table for ftp.")
+
+(define-abbrev ftp-abbrev-table "q" "quit")
+(define-abbrev ftp-abbrev-table "g" "get")
+(define-abbrev ftp-abbrev-table "p" "prompt")
+(define-abbrev ftp-abbrev-table "anon" "anonymous")
+
+(defconst ftp-font-lock-keywords
+ (and window-system
+ (progn
+ (require 'font-lock)
+ (list
+ (list ftp-prompt-regexp 0 font-lock-reference-face)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Utility functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun net-utils-remove-ctrl-m-filter (process output-string)
+ "Remove trailing control Ms."
+ (let ((old-buffer (current-buffer))
+ (filtered-string output-string))
+ (unwind-protect
+ (let ((moving))
+ (set-buffer (process-buffer process))
+ (setq moving (= (point) (process-mark process)))
+
+ (while (string-match "\r" filtered-string)
+ (setq filtered-string
+ (replace-match "" nil nil filtered-string)))
+
+ (save-excursion
+ ;; Insert the text, moving the process-marker.
+ (goto-char (process-mark process))
+ (insert filtered-string)
+ (set-marker (process-mark process) (point)))
+ (if moving (goto-char (process-mark process))))
+ (set-buffer old-buffer))))
+
+(defmacro net-utils-run-program (name header program &rest args)
+ "Run a network information program."
+ (`
+ (let ((buf (get-buffer-create (concat "*" (, name) "*"))))
+ (set-buffer buf)
+ (erase-buffer)
+ (insert (, header) "\n")
+ (set-process-filter
+ (apply 'start-process (, name) buf (, program) (,@ args))
+ 'net-utils-remove-ctrl-m-filter)
+ (display-buffer buf))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Wrappers for external network programs
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun traceroute (target)
+ "Run traceroute program for TARGET."
+ (interactive "sTarget: ")
+ (let ((options
+ (if traceroute-program-options
+ (append traceroute-program-options (list target))
+ (list target))))
+ (net-utils-run-program
+ (concat "Traceroute" " " target)
+ (concat "** Traceroute ** " traceroute-program " ** " target)
+ traceroute-program
+ options
+ )))
+
+;;;###autoload
+(defun ping (host)
+ "Ping HOST.
+If your system's ping continues until interrupted, you can try setting
+`ping-program-options'."
+ (interactive
+ (list
+ (progn
+ (require 'ffap)
+ (read-from-minibuffer
+ "Ping host: "
+ (or (ffap-string-at-point 'machine) "")))))
+ (let ((options
+ (if ping-program-options
+ (append ping-program-options (list host))
+ (list host))))
+ (net-utils-run-program
+ (concat "Ping" " " host)
+ (concat "** Ping ** " ping-program " ** " host)
+ ping-program
+ options
+ )))
+
+;;;###autoload
+(defun ipconfig ()
+ "Run ipconfig program."
+ (interactive)
+ (net-utils-run-program
+ "Ipconfig"
+ (concat "** Ipconfig ** " ipconfig-program " ** ")
+ ipconfig-program
+ ipconfig-program-options
+ ))
+
+;; This is the normal name on most Unixes.
+;;;###autoload
+(defalias 'ifconfig 'ipconfig)
+
+;;;###autoload
+(defun netstat ()
+ "Run netstat program."
+ (interactive)
+ (net-utils-run-program
+ "Netstat"
+ (concat "** Netstat ** " netstat-program " ** ")
+ netstat-program
+ netstat-program-options
+ ))
+
+;;;###autoload
+(defun arp ()
+ "Run the arp program."
+ (interactive)
+ (net-utils-run-program
+ "Arp"
+ (concat "** Arp ** " arp-program " ** ")
+ arp-program
+ arp-program-options
+ ))
+
+;;;###autoload
+(defun route ()
+ "Run the route program."
+ (interactive)
+ (net-utils-run-program
+ "Route"
+ (concat "** Route ** " route-program " ** ")
+ route-program
+ route-program-options
+ ))
+
+;; FIXME -- Needs to be a process filter
+;; (defun netstat-with-filter (filter)
+;; "Run netstat program."
+;; (interactive "sFilter: ")
+;; (netstat)
+;; (set-buffer (get-buffer "*Netstat*"))
+;; (goto-char (point-min))
+;; (delete-matching-lines filter)
+;; )
+
+;;;###autoload
+(defun nslookup-host (host)
+ "Lookup the DNS information for HOST."
+ (interactive
+ (list
+ (read-from-minibuffer
+ "Lookup host: "
+ (or (ffap-string-at-point 'machine) ""))))
+ (let ((options
+ (if nslookup-program-options
+ (append nslookup-program-options (list host))
+ (list host))))
+ (net-utils-run-program
+ "Nslookup"
+ (concat "** "
+ (mapconcat 'identity
+ (list "Nslookup" host nslookup-program)
+ " ** "))
+ nslookup-program
+ options
+ )))
+
+
+;;;###autoload
+(defun nslookup ()
+ "Run nslookup program."
+ (interactive)
+ (comint-run nslookup-program)
+ (set-process-filter (get-buffer-process "*nslookup*")
+ 'net-utils-remove-ctrl-m-filter)
+ (set
+ (make-local-variable 'font-lock-defaults)
+ '((nslookup-font-lock-keywords)))
+ (set
+ (make-local-variable 'local-abbrev-table)
+ nslookup-abbrev-table)
+ (abbrev-mode t)
+ (make-local-variable 'comint-prompt-regexp)
+ (setq comint-prompt-regexp nslookup-prompt-regexp)
+ )
+
+;; This is a lot less than ange-ftp, but much simpler.
+;;;###autoload
+(defun ftp (host)
+ "Run ftp program."
+ (interactive "sFtp to Host: ")
+ (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
+ (set-buffer buf)
+ (comint-mode)
+ (comint-exec buf (concat "ftp-" host) ftp-program nil
+ (if ftp-program-options
+ (append (list host) ftp-program-options)
+ (list host)))
+ (set
+ (make-local-variable 'font-lock-defaults)
+ '((ftp-font-lock-keywords)))
+
+ (make-local-variable 'comint-prompt-regexp)
+ (setq comint-prompt-regexp ftp-prompt-regexp)
+
+ ;; Already buffer local!
+ (setq comint-output-filter-functions
+ (list 'comint-watch-for-password-prompt))
+ (set
+ (make-local-variable 'local-abbrev-table)
+ ftp-abbrev-table)
+ (abbrev-mode t)
+ (switch-to-buffer-other-window buf)
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Network Connections
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Full list is available at:
+;; ftp://ftp.isi.edu/in-notes/iana/assignments/port-numbers
+(defvar network-connection-service-alist
+ (list
+ (cons 'echo 7)
+ (cons 'active-users 11)
+ (cons 'daytime 13)
+ (cons 'chargen 19)
+ (cons 'ftp 21)
+ (cons 'telnet 23)
+ (cons 'smtp 25)
+ (cons 'time 37)
+ (cons 'whois 43)
+ (cons 'gopher 70)
+ (cons 'finger 79)
+ (cons 'www 80)
+ (cons 'pop2 109)
+ (cons 'pop3 110)
+ (cons 'sun-rpc 111)
+ (cons 'nntp 119)
+ (cons 'ntp 123)
+ (cons 'netbios-name 137)
+ (cons 'netbios-data 139)
+ (cons 'irc 194)
+ (cons 'https 443)
+ (cons 'rlogin 513)
+ )
+ "Alist of services and associated TCP port numbers.
+This list in not complete.")
+
+;; Workhorse macro
+(defmacro run-network-program (process-name host port
+ &optional initial-string)
+ (`
+ (let ((tcp-connection)
+ (buf)
+ )
+ (setq buf (get-buffer-create (concat "*" (, process-name) "*")))
+ (set-buffer buf)
+ (or
+ (setq tcp-connection
+ (open-network-stream
+ (, process-name)
+ buf
+ (, host)
+ (, port)
+ ))
+ (error "Could not open connection to %s" (, host)))
+ (erase-buffer)
+ (set-marker (process-mark tcp-connection) (point-min))
+ (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
+ (and (, initial-string)
+ (process-send-string tcp-connection
+ (concat (, initial-string) "\r\n")))
+ (display-buffer buf))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Simple protocols
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Finger protocol
+;;;###autoload
+(defun finger (user host)
+ "Finger USER on HOST."
+ ;; One of those great interactive statements that's actually
+ ;; longer than the function call! The idea is that if the user
+ ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
+ ;; host name. If we don't see an "@", we'll prompt for the host.
+ (interactive
+ (progn
+ (require 'ffap)
+ (let* ((answer (read-from-minibuffer "Finger User: "
+ (ffap-string-at-point 'url)))
+ (index (string-match (regexp-quote "@") answer))
+ )
+ (if index
+ (list
+ (substring answer 0 index)
+ (substring answer (1+ index)))
+ (list
+ answer
+ (read-from-minibuffer
+ "At Host: "
+ (or (ffap-string-at-point 'machine) "")))))))
+ (let* (
+ (user-and-host (concat user "@" host))
+ (process-name
+ (concat "Finger [" user-and-host "]"))
+ )
+ (run-network-program
+ process-name
+ host
+ (cdr (assoc 'finger network-connection-service-alist))
+ user-and-host
+ )))
+
+(defcustom whois-server-name "whois.internic.net"
+ "Host name for the whois service."
+ :group 'net-utils
+ :type 'string
+ )
+
+;; Whois protocol
+;;;###autoload
+(defun whois (arg search-string)
+ "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
+With argument, prompt for whois server."
+ (interactive "P\nsWhois: ")
+ (let ((host
+ (if arg
+ (read-from-minibuffer "Whois server name: ")
+ whois-server-name))
+ )
+ (run-network-program
+ "Whois"
+ host
+ (cdr (assoc 'whois network-connection-service-alist))
+ search-string
+ )))
+
+(defcustom whois-reverse-lookup-server "whois.arin.net"
+ "Server which provides inverse DNS mapping."
+ :group 'net-utils
+ :type 'string
+ )
+
+;;;###autoload
+(defun whois-reverse-lookup ()
+ (interactive)
+ (let ((whois-server-name whois-reverse-lookup-server))
+ (call-interactively 'whois)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; General Network connection
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun network-connection-to-service (host service)
+ "Open a network connection to SERVICE on HOST."
+ (interactive
+ (list
+ (progn
+ (require 'ffap)
+ (read-from-minibuffer "Host: "
+ (ffap-string-at-point 'machine)))
+ (completing-read "Service: "
+ (mapcar
+ (function
+ (lambda (elt)
+ (list (symbol-name (car elt)))))
+ network-connection-service-alist))))
+ (network-connection
+ host
+ (cdr (assoc (intern service) network-connection-service-alist)))
+ )
+
+;;;###autoload
+(defun network-connection (host port)
+ "Open a network connection to HOST on PORT."
+ (interactive "sHost: \nnPort: ")
+ (network-service-connection host (number-to-string port)))
+
+(defun network-service-connection (host service)
+ "Open a network connection to SERVICE on HOST."
+ (let (
+ (process-name (concat "Network Connection [" host " " service "]"))
+ (portnum (string-to-number service))
+ )
+ (or (zerop portnum) (setq service portnum))
+ (make-comint
+ process-name
+ (cons host service))
+ (pop-to-buffer (get-buffer (concat "*" process-name "*")))
+ ))
+
+(provide 'net-utils)
+
+;;; net-utils.el ends here
projects / emacs.git / commitdiff