February 2013 - XEmacs-Patches - XEmacs Mailing List Archives

Add rx.el from GNU Emacs 11 years, 10 months

Michael Sperber

I've attached a patch to add the increasingly popular rx.el to xemacs-base. (Hope that's the right place.) 2013-02-19 Michael Sperber <mike(a)xemacs.org> * rx.el: Added port from GNU Emacs 24.2. -- Regards, Mike diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile ＠＠ -38,7 +38,7 ＠＠ helper.elc imenu.elc iso-syntax.elc macros.elc novice.elc outline.elc \ passwd.elc pp.elc regexp-opt.elc regi.elc ring.elc shell.elc \ skeleton.elc sort.elc thing.elc time-stamp.elc timer-funcs.elc \ - timezone.elc tq.elc xbm-button.elc xpm-button.elc + timezone.elc tq.elc xbm-button.elc xpm-button.elc rx.elc DATA_FILES = etc/enriched.doc DATA_DEST = . diff --git a/rx.el b/rx.el new file mode 100644 --- /dev/null +++ b/rx.el ＠＠ -0,0 +1,1182 ＠＠ +;;; rx.el --- sexp notation for regular expressions + +;; Copyright (C) 2001-2012 Free Software Foundation, Inc. + +;; Author: Gerd Moellmann <gerd(a)gnu.org> +;; Maintainer: FSF +;; Keywords: strings, regexps, extensions + +;; This file is part of XEmacs. + +;; XEmacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; XEmacs 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 XEmacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Synched up with: Emacs 24.2 + +;;; Commentary: + +;; This is another implementation of sexp-form regular expressions. +;; It was unfortunately written without being aware of the Sregex +;; package coming with Emacs, but as things stand, Rx completely +;; covers all regexp features, which Sregex doesn't, doesn't suffer +;; from the bugs mentioned in the commentary section of Sregex, and +;; uses a nicer syntax (IMHO, of course :-). + +;; This significantly extended version of the original, is almost +;; compatible with Sregex. The only incompatibility I (fx) know of is +;; that the `repeat' form can't have multiple regexp args. + +;; Now alternative forms are provided for a degree of compatibility +;; with Shivers' attempted definitive SRE notation +;; <URL:http://www.ai.mit.edu/~/shivers/sre.txt>. SRE forms not +;; catered for include: dsm, uncase, w/case, w/nocase, ,＠<exp>, +;; ,<exp>, (word ...), word+, posix-string, and character class forms. +;; Some forms are inconsistent with SRE, either for historical reasons +;; or because of the implementation -- simple translation into Emacs +;; regexp strings. These include: any, word. Also, case-sensitivity +;; and greediness are controlled by variables external to the regexp, +;; and you need to feed the forms to the `posix-' functions to get +;; SRE's POSIX semantics. There are probably more difficulties. + +;; Rx translates a sexp notation for regular expressions into the +;; usual string notation. The translation can be done at compile-time +;; by using the `rx' macro. It can be done at run-time by calling +;; function `rx-to-string'. See the documentation of `rx' for a +;; complete description of the sexp notation. +;; +;; Some examples of string regexps and their sexp counterparts: +;; +;; "^[a-z]*" +;; (rx (and line-start (0+ (in "a-z")))) +;; +;; "\n[^ \t]" +;; (rx (and "\n" (not blank))), or +;; (rx (and "\n" (not (any " \t")))) +;; +;; "\\*\\*\\* EOOH \\*\\*\\*\n" +;; (rx "*** EOOH ***\n") +;; +;; "\\<\$catch\\|finally\$\\>[^_]" +;; (rx (and word-start (submatch (or "catch" "finally")) word-end +;; (not (any ?_)))) +;; +;; "[ \t\n]*:\$[^:]+\\|$\$" +;; (rx (and (zero-or-more (in " \t\n")) ":" +;; (submatch (or line-end (one-or-more (not (any ?:))))))) +;; +;; "^content-transfer-encoding:\$\n?[\t ]\$*quoted-printable\$\n?[\t ]\$*" +;; (rx (and line-start +;; "content-transfer-encoding:" +;; (+ (? ?\n)) blank +;; "quoted-printable" +;; (+ (? ?\n)) blank)) +;; +;; (concat "^\$?:" something-else "\$") +;; (rx (and line-start (eval something-else))), statically or +;; (rx-to-string '(and line-start ,something-else)), dynamically. +;; +;; (regexp-opt '(STRING1 STRING2 ...)) +;; (rx (or STRING1 STRING2 ...)), or in other words, `or' automatically +;; calls `regexp-opt' as needed. +;; +;; "^;;\\s-*\n\\|^\n" +;; (rx (or (and line-start ";;" (0+ space) ?\n) +;; (and line-start ?\n))) +;; +;; "\\$[I]d: [^ ]+ \$[^ ]+\$ " +;; (rx (and "$Id: " +;; (1+ (not (in " "))) +;; " " +;; (submatch (1+ (not (in " ")))) +;; " ")) +;; +;; "\\\\\\\\\\[\\w+" +;; (rx (and ?\\ ?\\ ?\[ (1+ word))) +;; +;; etc. + +;;; History: +;; + +;;; Code: + +(defconst rx-constituents + '((and . (rx-and 1 nil)) + (seq . and) ; SRE + (: . and) ; SRE + (sequence . and) ; sregex + (or . (rx-or 1 nil)) + (| . or) ; SRE + (not-newline . ".") + (nonl . not-newline) ; SRE + (anything . (rx-anything 0 nil)) + (any . (rx-any 1 nil rx-check-any)) ; inconsistent with SRE + (any . ".") ; sregex + (in . any) + (char . any) ; sregex + (not-char . (rx-not-char 1 nil rx-check-any)) ; sregex + (not . (rx-not 1 1 rx-check-not)) + (repeat . (rx-repeat 2 nil)) + (= . (rx-= 2 nil)) ; SRE + (>= . (rx->= 2 nil)) ; SRE + (** . (rx-** 2 nil)) ; SRE + (submatch . (rx-submatch 1 nil)) ; SRE + (group . submatch) ; sregex + (submatch-n . (rx-submatch-n 2 nil)) + (group-n . submatch-n) + (zero-or-more . (rx-kleene 1 nil)) + (one-or-more . (rx-kleene 1 nil)) + (zero-or-one . (rx-kleene 1 nil)) + (\? . zero-or-one) ; SRE + (\?? . zero-or-one) + (* . zero-or-more) ; SRE + (*? . zero-or-more) + (0+ . zero-or-more) + (+ . one-or-more) ; SRE + (+? . one-or-more) + (1+ . one-or-more) + (optional . zero-or-one) + (opt . zero-or-one) ; sregex + (minimal-match . (rx-greedy 1 1)) + (maximal-match . (rx-greedy 1 1)) + (backref . (rx-backref 1 1 rx-check-backref)) + (line-start . "^") + (bol . line-start) ; SRE + (line-end . "$") + (eol . line-end) ; SRE + (string-start . "\\`") + (bos . string-start) ; SRE + (bot . string-start) ; sregex + (string-end . "\\'") + (eos . string-end) ; SRE + (eot . string-end) ; sregex + (buffer-start . "\\`") + (buffer-end . "\\'") + (point . "\\=") + (word-start . "\\<") + (bow . word-start) ; SRE + (word-end . "\\>") + (eow . word-end) ; SRE + (word-boundary . "\\b") + (not-word-boundary . "\\B") ; sregex + (symbol-start . "\\_<") + (symbol-end . "\\_>") + (syntax . (rx-syntax 1 1)) + (not-syntax . (rx-not-syntax 1 1)) ; sregex + (category . (rx-category 1 1 rx-check-category)) + (eval . (rx-eval 1 1)) + (regexp . (rx-regexp 1 1 stringp)) + (regex . regexp) ; sregex + (digit . "[[:digit:]]") + (numeric . digit) ; SRE + (num . digit) ; SRE + (control . "[[:cntrl:]]") ; SRE + (cntrl . control) ; SRE + (hex-digit . "[[:xdigit:]]") ; SRE + (hex . hex-digit) ; SRE + (xdigit . hex-digit) ; SRE + (blank . "[[:blank:]]") ; SRE + (graphic . "[[:graph:]]") ; SRE + (graph . graphic) ; SRE + (printing . "[[:print:]]") ; SRE + (print . printing) ; SRE + (alphanumeric . "[[:alnum:]]") ; SRE + (alnum . alphanumeric) ; SRE + (letter . "[[:alpha:]]") + (alphabetic . letter) ; SRE + (alpha . letter) ; SRE + (ascii . "[[:ascii:]]") ; SRE + (nonascii . "[[:nonascii:]]") + (lower . "[[:lower:]]") ; SRE + (lower-case . lower) ; SRE + (punctuation . "[[:punct:]]") ; SRE + (punct . punctuation) ; SRE + (space . "[[:space:]]") ; SRE + (whitespace . space) ; SRE + (white . space) ; SRE + (upper . "[[:upper:]]") ; SRE + (upper-case . upper) ; SRE + (word . "[[:word:]]") ; inconsistent with SRE + (wordchar . word) ; sregex + (not-wordchar . "\\W")) + "Alist of sexp form regexp constituents. +Each element of the alist has the form (SYMBOL . DEFN). +SYMBOL is a valid constituent of sexp regular expressions. +If DEFN is a string, SYMBOL is translated into DEFN. +If DEFN is a symbol, use the definition of DEFN, recursively. +Otherwise, DEFN must be a list (FUNCTION MIN-ARGS MAX-ARGS PREDICATE). +FUNCTION is used to produce code for SYMBOL. MIN-ARGS and MAX-ARGS +are the minimum and maximum number of arguments the function-form +sexp constituent SYMBOL may have in sexp regular expressions. +MAX-ARGS nil means no limit. PREDICATE, if specified, means that +all arguments must satisfy PREDICATE.") + + +(defconst rx-syntax + '((whitespace . ?-) + (punctuation . ?.) + (word . ?w) + (symbol . ?_) + (open-parenthesis . ?$) + (close-parenthesis . ?$) + (expression-prefix . ?\') + (string-quote . ?\") + (paired-delimiter . ?$) + (escape . ?\\) + (character-quote . ?/) + (comment-start . ?<) + (comment-end . ?>) + (string-delimiter . ?|) + (comment-delimiter . ?!)) + "Alist mapping Rx syntax symbols to syntax characters. +Each entry has the form (SYMBOL . CHAR), where SYMBOL is a valid +symbol in `(syntax SYMBOL)', and CHAR is the syntax character +corresponding to SYMBOL, as it would be used with \\s or \\S in +regular expressions.") + + +(defconst rx-categories + '((consonant . ?0) + (base-vowel . ?1) + (upper-diacritical-mark . ?2) + (lower-diacritical-mark . ?3) + (tone-mark . ?4) + (symbol . ?5) + (digit . ?6) + (vowel-modifying-diacritical-mark . ?7) + (vowel-sign . ?8) + (semivowel-lower . ?9) + (not-at-end-of-line . ?<) + (not-at-beginning-of-line . ?>) + (alpha-numeric-two-byte . ?A) + (chinse-two-byte . ?C) + (greek-two-byte . ?G) + (japanese-hiragana-two-byte . ?H) + (indian-two-byte . ?I) + (japanese-katakana-two-byte . ?K) + (korean-hangul-two-byte . ?N) + (cyrillic-two-byte . ?Y) + (combining-diacritic . ?^) + (ascii . ?a) + (arabic . ?b) + (chinese . ?c) + (ethiopic . ?e) + (greek . ?g) + (korean . ?h) + (indian . ?i) + (japanese . ?j) + (japanese-katakana . ?k) + (latin . ?l) + (lao . ?o) + (tibetan . ?q) + (japanese-roman . ?r) + (thai . ?t) + (vietnamese . ?v) + (hebrew . ?w) + (cyrillic . ?y) + (can-break . ?|)) + "Alist mapping symbols to category characters. +Each entry has the form (SYMBOL . CHAR), where SYMBOL is a valid +symbol in `(category SYMBOL)', and CHAR is the category character +corresponding to SYMBOL, as it would be used with `\\c' or `\\C' in +regular expression strings.") + + +(defvar rx-greedy-flag t + "Non-nil means produce greedy regular expressions for `zero-or-one', +`zero-or-more', and `one-or-more'. Dynamically bound.") + + +(defun rx-info (op head) + "Return parsing/code generation info for OP. +If OP is the space character ASCII 32, return info for the symbol `?'. +If OP is the character `?', return info for the symbol `??'. +See also `rx-constituents'. +If HEAD is non-nil, then OP is the head of a sexp, otherwise it's +a standalone symbol." + (cond ((eq op ? ) (setq op '\?)) + ((eq op ??) (setq op '\??))) + (let (old-op) + (while (and (not (null op)) (symbolp op)) + (setq old-op op) + (setq op (cdr (assq op rx-constituents))) + (when (if head (stringp op) (consp op)) + ;; We found something but of the wrong kind. Let's look for an + ;; alternate definition for the other case. + (let ((new-op + (cdr (assq old-op (cdr (memq (assq old-op rx-constituents) + rx-constituents)))))) + (if (and new-op (not (if head (stringp new-op) (consp new-op)))) + (setq op new-op)))))) + op) + + +(defun rx-check (form) + "Check FORM according to its car's parsing info." + (unless (listp form) + (error "rx `%s' needs argument(s)" form)) + (let* ((rx (rx-info (car form) 'head)) + (nargs (1- (length form))) + (min-args (nth 1 rx)) + (max-args (nth 2 rx)) + (type-pred (nth 3 rx))) + (when (and (not (null min-args)) + (< nargs min-args)) + (error "rx form `%s' requires at least %d args" + (car form) min-args)) + (when (and (not (null max-args)) + (> nargs max-args)) + (error "rx form `%s' accepts at most %d args" + (car form) max-args)) + (when (not (null type-pred)) + (dolist (sub-form (cdr form)) + (unless (funcall type-pred sub-form) + (error "rx form `%s' requires args satisfying `%s'" + (car form) type-pred)))))) + + +(defun rx-group-if (regexp group) + "Put shy groups around REGEXP if seemingly necessary when GROUP +is non-nil." + (cond + ;; for some repetition + ((eq group '*) (if (rx-atomic-p regexp) (setq group nil))) + ;; for concatenation + ((eq group ':) + (if (rx-atomic-p + (if (string-match + "\$?:[?*+]\\??\\|\\\\{[0-9]*,?[0-9]*\\\\}\$\\'" regexp) + (substring regexp 0 (match-beginning 0)) + regexp)) + (setq group nil))) + ;; for OR + ((eq group '|) (setq group nil)) + ;; do anyway + ((eq group t)) + ((rx-atomic-p regexp t) (setq group nil))) + (if group + (concat "\$?:" regexp "\$") + regexp)) + + +(defvar rx-parent) +;; dynamically bound in some functions. + + +(defun rx-and (form) + "Parse and produce code from FORM. +FORM is of the form `(and FORM1 ...)'." + (rx-check form) + (rx-group-if + (mapconcat (lambda (x) (rx-form x ':)) (cdr form) nil) + (and (memq rx-parent '(* t)) rx-parent))) + + +(defun rx-or (form) + "Parse and produce code from FORM, which is `(or FORM1 ...)'." + (rx-check form) + (rx-group-if + (if (memq nil (mapcar 'stringp (cdr form))) + (mapconcat (lambda (x) (rx-form x '|)) (cdr form) "\\|") + (regexp-opt (cdr form))) + (and (memq rx-parent '(: * t)) rx-parent))) + + +(defun rx-anything (form) + "Match any character." + (if (consp form) + (error "rx `anything' syntax error: %s" form)) + (rx-or (list 'or 'not-newline ?\n))) + + +(defun rx-any-delete-from-range (char ranges) + "Delete by side effect character CHAR from RANGES. +Only both edges of each range is checked." + (let (m) + (cond + ((memq char ranges) (setq ranges (delq char ranges))) + ((setq m (assq char ranges)) + (if (eq (int-char (1+ char)) (cdr m)) + (setcar (memq m ranges) (int-char (1+ char))) + (setcar m (int-char (1+ char))))) + ((setq m (rassq char ranges)) + (if (eq (int-char (1- char)) (car m)) + (setcar (memq m ranges) (int-char (1- char))) + (setcdr m (int-char (1- char)))))) + ranges)) + + +(defun rx-any-condense-range (args) + "Condense by side effect ARGS as range for Rx `any'." + (let (str + l) + ;; set STR list of all strings + ;; set L list of all ranges + (mapc (lambda (e) (cond ((stringp e) (push e str)) + ((characterp e) (push (cons e e) l)) + (t (push e l)))) + args) + ;; condense overlapped ranges in L + (let ((tail (setq l (sort l #'car-less-than-car))) + d) + (while (setq d (cdr tail)) + (if (>= (cdar tail) (1- (caar d))) + (progn + (setcdr (car tail) (int-char (max (cdar tail) (cdar d)))) + (setcdr tail (cdr d))) + (setq tail d)))) + ;; Separate small ranges to single number, and delete dups. + (nconc + (apply #'nconc + (mapcar (lambda (e) + (cond + ((= (car e) (cdr e)) (list (car e))) + ((= (int-char (1+ (car e))) (cdr e)) (list (car e) (cdr e))) + ((list e)))) + l)) + (delete-dups str)))) + + +(defun rx-check-any-string (str) + "Check string argument STR for Rx `any'." + (let ((i 0) + c1 c2 l) + (if (= 0 (length str)) + (error "String arg for Rx `any' must not be empty")) + (while (string-match ".-." str i) + ;; string before range: convert it to characters + (if (< i (match-beginning 0)) + (setq l (nconc + l + (append (substring str i (match-beginning 0)) nil)))) + ;; range + (setq i (match-end 0) + c1 (aref str (match-beginning 0)) + c2 (aref str (1- i))) + (cond + ((< c1 c2) (setq l (nconc l (list (cons c1 c2))))) + ((= c1 c2) (setq l (nconc l (list c1)))))) + ;; rest? + (if (< i (length str)) + (setq l (nconc l (append (substring str i) nil)))) + l)) + + +(defun rx-check-any (arg) + "Check arg ARG for Rx `any'." + (cond + ((characterp arg) (list arg)) + ((symbolp arg) + (let ((translation (condition-case nil + (rx-form arg) + (error nil)))) + (if (or (null translation) + (null (string-match "\\`\\[\\[:[-a-z]+:\\]\\]\\'" translation))) + (error "Invalid char class `%s' in Rx `any'" arg)) + (list (substring translation 1 -1)))) ; strip outer brackets + ((and (characterp (car-safe arg)) (characterp (cdr-safe arg))) + (list arg)) + ((stringp arg) (rx-check-any-string arg)) + ((error + "rx `any' requires string, character, char pair or char class args")))) + + +(defun rx-any (form) + "Parse and produce code from FORM, which is `(any ARG ...)'. +ARG is optional." + (rx-check form) + (let* ((args (rx-any-condense-range + (apply + #'nconc + (mapcar #'rx-check-any (cdr form))))) + m + s) + (cond + ;; single close bracket + ;; => "[]...-]" or "[]...--.]" + ((memq ?\] args) + ;; set ] at the beginning + (setq args (cons ?\] (delq ?\] args))) + ;; set - at the end + (if (or (memq ?- args) (assq ?- args)) + (setq args (nconc (rx-any-delete-from-range ?- args) + (list ?-))))) + ;; close bracket starts a range + ;; => "[]-....-]" or "[]-.--....]" + ((setq m (assq ?\] args)) + ;; bring it to the beginning + (setq args (cons m (delq m args))) + (cond ((memq ?- args) + ;; to the end + (setq args (nconc (delq ?- args) (list ?-)))) + ((setq m (assq ?- args)) + ;; next to the bracket's range, make the second range + (setcdr args (cons m (delq m args)))))) + ;; bracket in the end range + ;; => "[]...-]" + ((setq m (rassq ?\] args)) + ;; set ] at the beginning + (setq args (cons ?\] (rx-any-delete-from-range ?\] args))) + ;; set - at the end + (if (or (memq ?- args) (assq ?- args)) + (setq args (nconc (rx-any-delete-from-range ?- args) + (list ?-))))) + ;; {no close bracket appears} + ;; + ;; bring single bar to the beginning + ((memq ?- args) + (setq args (cons ?- (delq ?- args)))) + ;; bar start a range, bring it to the beginning + ((setq m (assq ?- args)) + (setq args (cons m (delq m args)))) + ;; + ;; hat at the beginning? + ((or (eq (car args) ?^) (eq (car-safe (car args)) ?^)) + (setq args (if (cdr args) + `(,(cadr args) ,(car args) ,＠(cddr args)) + (nconc (rx-any-delete-from-range ?^ args) + (list ?^)))))) + ;; some 1-char? + (if (and (null (cdr args)) (characterp (car args)) + (or (= 1 (length + (setq s (regexp-quote (string (car args)))))) + (and (equal (car args) ?^) ;; unnecessary predicate? + (null (eq rx-parent '!))))) + s + (concat "[" + (mapconcat + (lambda (e) (cond + ((characterp e) (string e)) + ((consp e) + (if (and (= (1+ (car e)) (cdr e)) + ;; rx-any-condense-range should + ;; prevent this case from happening. + (null (memq (car e) '(?\] ?-))) + (null (memq (cdr e) '(?\] ?-)))) + (string (car e) (cdr e)) + (string (car e) ?- (cdr e)))) + (e))) + args + nil) + "]")))) + + +(defun rx-check-not (arg) + "Check arg ARG for Rx `not'." + (unless (or (and (symbolp arg) + (string-match "\\`\\[\\[:[-a-z]+:\\]\\]\\'" + (condition-case nil + (rx-form arg) + (error "")))) + (eq arg 'word-boundary) + (and (consp arg) + (memq (car arg) '(not any in syntax category)))) + (error "rx `not' syntax error: %s" arg)) + t) + + +(defun rx-not (form) + "Parse and produce code from FORM. FORM is `(not ...)'." + (rx-check form) + (let ((result (rx-form (cadr form) '!)) + case-fold-search) + (cond ((string-match "\\`\\[^" result) + (cond + ((equal result "[^]") "[^^]") + ((and (= (length result) 4) (null (eq rx-parent '!))) + (regexp-quote (substring result 2 3))) + ((concat "[" (substring result 2))))) + ((eq ?\[ (aref result 0)) + (concat "[^" (substring result 1))) + ((string-match "\\`\\\\[scbw]" result) + (concat (upcase (substring result 0 2)) + (substring result 2))) + ((string-match "\\`\\\\[SCBW]" result) + (concat (downcase (substring result 0 2)) + (substring result 2))) + (t + (concat "[^" result "]"))))) + + +(defun rx-not-char (form) + "Parse and produce code from FORM. FORM is `(not-char ...)'." + (rx-check form) + (rx-not `(not (in ,＠(cdr form))))) + + +(defun rx-not-syntax (form) + "Parse and produce code from FORM. FORM is `(not-syntax SYNTAX)'." + (rx-check form) + (rx-not `(not (syntax ,＠(cdr form))))) + + +(defun rx-trans-forms (form &optional skip) + "If FORM's length is greater than two, transform it to length two. +A form (HEAD REST ...) becomes (HEAD (and REST ...)). +If SKIP is non-nil, allow that number of items after the head, i.e. +`(= N REST ...)' becomes `(= N (and REST ...))' if SKIP is 1." + (unless skip (setq skip 0)) + (let ((tail (nthcdr (1+ skip) form))) + (if (= (length tail) 1) + form + (let ((form (copy-sequence form))) + (setcdr (nthcdr skip form) (list (cons 'and tail))) + form)))) + + +(defun rx-= (form) + "Parse and produce code from FORM `(= N ...)'." + (rx-check form) + (setq form (rx-trans-forms form 1)) + (unless (and (integerp (nth 1 form)) + (> (nth 1 form) 0)) + (error "rx `=' requires positive integer first arg")) + (format "%s\\{%d\\}" (rx-form (nth 2 form) '*) (nth 1 form))) + + +(defun rx->= (form) + "Parse and produce code from FORM `(>= N ...)'." + (rx-check form) + (setq form (rx-trans-forms form 1)) + (unless (and (integerp (nth 1 form)) + (> (nth 1 form) 0)) + (error "rx `>=' requires positive integer first arg")) + (format "%s\\{%d,\\}" (rx-form (nth 2 form) '*) (nth 1 form))) + + +(defun rx-** (form) + "Parse and produce code from FORM `(** N M ...)'." + (rx-check form) + (rx-form (cons 'repeat (cdr (rx-trans-forms form 2))) '*)) + + +(defun rx-repeat (form) + "Parse and produce code from FORM. +FORM is either `(repeat N FORM1)' or `(repeat N M FORMS...)'." + (rx-check form) + (if (> (length form) 4) + (setq form (rx-trans-forms form 2))) + (if (null (nth 2 form)) + (setq form (cons (nth 0 form) (cons (nth 1 form) (nthcdr 3 form))))) + (cond ((= (length form) 3) + (unless (and (integerp (nth 1 form)) + (> (nth 1 form) 0)) + (error "rx `repeat' requires positive integer first arg")) + (format "%s\\{%d\\}" (rx-form (nth 2 form) '*) (nth 1 form))) + ((or (not (integerp (nth 2 form))) + (< (nth 2 form) 0) + (not (integerp (nth 1 form))) + (< (nth 1 form) 0) + (< (nth 2 form) (nth 1 form))) + (error "rx `repeat' range error")) + (t + (format "%s\\{%d,%d\\}" (rx-form (nth 3 form) '*) + (nth 1 form) (nth 2 form))))) + + +(defun rx-submatch (form) + "Parse and produce code from FORM, which is `(submatch ...)'." + (concat "\$" + (if (= 2 (length form)) + ;; Only one sub-form. + (rx-form (cadr form)) + ;; Several sub-forms implicitly concatenated. + (mapconcat (lambda (re) (rx-form re ':)) (cdr form) nil)) + "\$")) + +(defun rx-submatch-n (form) + "Parse and produce code from FORM, which is `(submatch-n N ...)'." + (let ((n (nth 1 form))) + (concat "\$?" (number-to-string n) ":" + (if (= 3 (length form)) + ;; Only one sub-form. + (rx-form (nth 2 form)) + ;; Several sub-forms implicitly concatenated. + (mapconcat (lambda (re) (rx-form re ':)) (cddr form) nil)) + "\$"))) + +(defun rx-backref (form) + "Parse and produce code from FORM, which is `(backref N)'." + (rx-check form) + (format "\\%d" (nth 1 form))) + +(defun rx-check-backref (arg) + "Check arg ARG for Rx `backref'." + (or (and (integerp arg) (>= arg 1) (<= arg 9)) + (error "rx `backref' requires numeric 1<=arg<=9: %s" arg))) + +(defun rx-kleene (form) + "Parse and produce code from FORM. +FORM is `(OP FORM1)', where OP is one of the `zero-or-one', +`zero-or-more' etc. operators. +If OP is one of `*', `+', `?', produce a greedy regexp. +If OP is one of `*?', `+?', `??', produce a non-greedy regexp. +If OP is anything else, produce a greedy regexp if `rx-greedy-flag' +is non-nil." + (rx-check form) + (setq form (rx-trans-forms form)) + (let ((suffix (cond ((memq (car form) '(* + ?\s)) "") + ((memq (car form) '(*? +? ??)) "?") + (rx-greedy-flag "") + (t "?"))) + (op (cond ((memq (car form) '(* *? 0+ zero-or-more)) "*") + ((memq (car form) '(+ +? 1+ one-or-more)) "+") + (t "?")))) + (rx-group-if + (concat (rx-form (cadr form) '*) op suffix) + (and (memq rx-parent '(t *)) rx-parent)))) + + +(defun rx-atomic-p (r &optional lax) + "Return non-nil if regexp string R is atomic. +An atomic regexp R is one such that a suffix operator +appended to R will apply to all of R. For example, \"a\" +\"[abc]\" and \"\$ab\\|ab*c\$\" are atomic and \"ab\", +\"[ab]c\", and \"ab\\|ab*c\" are not atomic. + +This function may return false negatives, but it will not +return false positives. It is nevertheless useful in +situations where an efficiency shortcut can be taken only if a +regexp is atomic. The function can be improved to detect +more cases of atomic regexps. Presently, this function +detects the following categories of atomic regexp; + + a group or shy group: \$...\$ + a character class: [...] + a single character: a + +On the other hand, false negatives will be returned for +regexps that are atomic but end in operators, such as +\"a+\". I think these are rare. Probably such cases could +be detected without much effort. A guarantee of no false +negatives would require a theoretic specification of the set +of all atomic regexps." + (let ((l (length r))) + (cond + ((<= l 1)) + ((= l 2) (= (aref r 0) ?\\)) + ((= l 3) (string-match "\\`\$?:\\\\[cCsS_]\\|\\[[^^]\\]\$" r)) + ((null lax) + (cond + ((string-match "\\`\\[^?\]?\$?:\\[:[a-z]+:]\\|[^\]]\$*\\]\\'" r)) + ((string-match "\\`\\\$\\(?:[^\\]\\|\\\\[^$]\\)*\\\\)\\'" r))))))) + + +(defun rx-syntax (form) + "Parse and produce code from FORM, which is `(syntax SYMBOL)'." + (rx-check form) + (let* ((sym (cadr form)) + (syntax (cdr (assq sym rx-syntax)))) + (unless syntax + ;; Try sregex compatibility. + (cond + ((characterp sym) (setq syntax sym)) + ((symbolp sym) + (let ((name (symbol-name sym))) + (if (= 1 (length name)) + (setq syntax (aref name 0)))))) + (unless syntax + (error "Unknown rx syntax `%s'" sym))) + (format "\\s%c" syntax))) + + +(defun rx-check-category (form) + "Check the argument FORM of a `(category FORM)'." + (unless (or (characterp form) + (cdr (assq form rx-categories))) + (error "Unknown category `%s'" form)) + t) + + +(defun rx-category (form) + "Parse and produce code from FORM, which is `(category SYMBOL)'." + (rx-check form) + (let ((char (if (characterp (cadr form)) + (cadr form) + (cdr (assq (cadr form) rx-categories))))) + (format "\\c%c" char))) + + +(defun rx-eval (form) + "Parse and produce code from FORM, which is `(eval FORM)'." + (rx-check form) + (rx-form (eval (cadr form)) rx-parent)) + + +(defun rx-greedy (form) + "Parse and produce code from FORM. +If FORM is '(minimal-match FORM1)', non-greedy versions of `*', +`+', and `?' operators will be used in FORM1. If FORM is +'(maximal-match FORM1)', greedy operators will be used." + (rx-check form) + (let ((rx-greedy-flag (eq (car form) 'maximal-match))) + (rx-form (cadr form) rx-parent))) + + +(defun rx-regexp (form) + "Parse and produce code from FORM, which is `(regexp STRING)'." + (rx-check form) + (rx-group-if (cadr form) rx-parent)) + + +(defun rx-form (form &optional rx-parent) + "Parse and produce code for regular expression FORM. +FORM is a regular expression in sexp form. +RX-PARENT shows which type of expression calls and controls putting of +shy groups around the result and some more in other functions." + (if (stringp form) + (rx-group-if (regexp-quote form) + (if (and (eq rx-parent '*) (< 1 (length form))) + rx-parent)) + (cond ((characterp form) + (regexp-quote (char-to-string form))) + ((symbolp form) + (let ((info (rx-info form nil))) + (cond ((stringp info) + info) + ((null info) + (error "Unknown rx form `%s'" form)) + (t + (funcall (nth 0 info) form))))) + ((consp form) + (let ((info (rx-info (car form) 'head))) + (unless (consp info) + (error "Unknown rx form `%s'" (car form))) + (funcall (nth 0 info) form))) + (t + (error "rx syntax error at `%s'" form))))) + + +;;;###autoload +(defun rx-to-string (form &optional no-group) + "Parse and produce code for regular expression FORM. +FORM is a regular expression in sexp form. +NO-GROUP non-nil means don't put shy groups around the result." + (rx-group-if (rx-form form) (null no-group))) + + +;;;###autoload +(defmacro rx (&rest regexps) + "Translate regular expressions REGEXPS in sexp form to a regexp string. +REGEXPS is a non-empty sequence of forms of the sort listed below. + +Note that `rx' is a Lisp macro; when used in a Lisp program being + compiled, the translation is performed by the compiler. +See `rx-to-string' for how to do such a translation at run-time. + +The following are valid subforms of regular expressions in sexp +notation. + +STRING + matches string STRING literally. + +CHAR + matches character CHAR literally. + +`not-newline', `nonl' + matches any character except a newline. + +`anything' + matches any character + +`(any SET ...)' +`(in SET ...)' +`(char SET ...)' + matches any character in SET .... SET may be a character or string. + Ranges of characters can be specified as `A-Z' in strings. + Ranges may also be specified as conses like `(?A . ?Z)'. + + SET may also be the name of a character class: `digit', + `control', `hex-digit', `blank', `graph', `print', `alnum', + `alpha', `ascii', `nonascii', `lower', `punct', `space', `upper', + `word', or one of their synonyms. + +`(not (any SET ...))' + matches any character not in SET ... + +`line-start', `bol' + matches the empty string, but only at the beginning of a line + in the text being matched + +`line-end', `eol' + is similar to `line-start' but matches only at the end of a line + +`string-start', `bos', `bot' + matches the empty string, but only at the beginning of the + string being matched against. + +`string-end', `eos', `eot' + matches the empty string, but only at the end of the + string being matched against. + +`buffer-start' + matches the empty string, but only at the beginning of the + buffer being matched against. Actually equivalent to `string-start'. + +`buffer-end' + matches the empty string, but only at the end of the + buffer being matched against. Actually equivalent to `string-end'. + +`point' + matches the empty string, but only at point. + +`word-start', `bow' + matches the empty string, but only at the beginning of a word. + +`word-end', `eow' + matches the empty string, but only at the end of a word. + +`word-boundary' + matches the empty string, but only at the beginning or end of a + word. + +`(not word-boundary)' +`not-word-boundary' + matches the empty string, but not at the beginning or end of a + word. + +`symbol-start' + matches the empty string, but only at the beginning of a symbol. + +`symbol-end' + matches the empty string, but only at the end of a symbol. + +`digit', `numeric', `num' + matches 0 through 9. + +`control', `cntrl' + matches ASCII control characters. + +`hex-digit', `hex', `xdigit' + matches 0 through 9, a through f and A through F. + +`blank' + matches space and tab only. + +`graphic', `graph' + matches graphic characters--everything except ASCII control chars, + space, and DEL. + +`printing', `print' + matches printing characters--everything except ASCII control chars + and DEL. + +`alphanumeric', `alnum' + matches letters and digits. (But at present, for multibyte characters, + it matches anything that has word syntax.) + +`letter', `alphabetic', `alpha' + matches letters. (But at present, for multibyte characters, + it matches anything that has word syntax.) + +`ascii' + matches ASCII (unibyte) characters. + +`nonascii' + matches non-ASCII (multibyte) characters. + +`lower', `lower-case' + matches anything lower-case. + +`upper', `upper-case' + matches anything upper-case. + +`punctuation', `punct' + matches punctuation. (But at present, for multibyte characters, + it matches anything that has non-word syntax.) + +`space', `whitespace', `white' + matches anything that has whitespace syntax. + +`word', `wordchar' + matches anything that has word syntax. + +`not-wordchar' + matches anything that has non-word syntax. + +`(syntax SYNTAX)' + matches a character with syntax SYNTAX. SYNTAX must be one + of the following symbols, or a symbol corresponding to the syntax + character, e.g. `\\.' for `\\s.'. + + `whitespace' (\\s- in string notation) + `punctuation' (\\s.) + `word' (\\sw) + `symbol' (\\s_) + `open-parenthesis' (\\s() + `close-parenthesis' (\\s)) + `expression-prefix' (\\s') + `string-quote' (\\s\") + `paired-delimiter' (\\s$) + `escape' (\\s\\) + `character-quote' (\\s/) + `comment-start' (\\s<) + `comment-end' (\\s>) + `string-delimiter' (\\s|) + `comment-delimiter' (\\s!) + +`(not (syntax SYNTAX))' + matches a character that doesn't have syntax SYNTAX. + +`(category CATEGORY)' + matches a character with category CATEGORY. CATEGORY must be + either a character to use for C, or one of the following symbols. + + `consonant' (\\c0 in string notation) + `base-vowel' (\\c1) + `upper-diacritical-mark' (\\c2) + `lower-diacritical-mark' (\\c3) + `tone-mark' (\\c4) + `symbol' (\\c5) + `digit' (\\c6) + `vowel-modifying-diacritical-mark' (\\c7) + `vowel-sign' (\\c8) + `semivowel-lower' (\\c9) + `not-at-end-of-line' (\\c<) + `not-at-beginning-of-line' (\\c>) + `alpha-numeric-two-byte' (\\cA) + `chinse-two-byte' (\\cC) + `greek-two-byte' (\\cG) + `japanese-hiragana-two-byte' (\\cH) + `indian-tow-byte' (\\cI) + `japanese-katakana-two-byte' (\\cK) + `korean-hangul-two-byte' (\\cN) + `cyrillic-two-byte' (\\cY) + `combining-diacritic' (\\c^) + `ascii' (\\ca) + `arabic' (\\cb) + `chinese' (\\cc) + `ethiopic' (\\ce) + `greek' (\\cg) + `korean' (\\ch) + `indian' (\\ci) + `japanese' (\\cj) + `japanese-katakana' (\\ck) + `latin' (\\cl) + `lao' (\\co) + `tibetan' (\\cq) + `japanese-roman' (\\cr) + `thai' (\\ct) + `vietnamese' (\\cv) + `hebrew' (\\cw) + `cyrillic' (\\cy) + `can-break' (\\c|) + +`(not (category CATEGORY))' + matches a character that doesn't have category CATEGORY. + +`(and SEXP1 SEXP2 ...)' +`(: SEXP1 SEXP2 ...)' +`(seq SEXP1 SEXP2 ...)' +`(sequence SEXP1 SEXP2 ...)' + matches what SEXP1 matches, followed by what SEXP2 matches, etc. + +`(submatch SEXP1 SEXP2 ...)' +`(group SEXP1 SEXP2 ...)' + like `and', but makes the match accessible with `match-end', + `match-beginning', and `match-string'. + +`(submatch-n N SEXP1 SEXP2 ...)' +`(group-n N SEXP1 SEXP2 ...)' + like `group', but make it an explicitly-numbered group with + group number N. + +`(or SEXP1 SEXP2 ...)' +`(| SEXP1 SEXP2 ...)' + matches anything that matches SEXP1 or SEXP2, etc. If all + args are strings, use `regexp-opt' to optimize the resulting + regular expression. + +`(minimal-match SEXP)' + produce a non-greedy regexp for SEXP. Normally, regexps matching + zero or more occurrences of something are \"greedy\" in that they + match as much as they can, as long as the overall regexp can + still match. A non-greedy regexp matches as little as possible. + +`(maximal-match SEXP)' + produce a greedy regexp for SEXP. This is the default. + +Below, `SEXP ...' represents a sequence of regexp forms, treated as if +enclosed in `(and ...)'. + +`(zero-or-more SEXP ...)' +`(0+ SEXP ...)' + matches zero or more occurrences of what SEXP ... matches. + +`(* SEXP ...)' + like `zero-or-more', but always produces a greedy regexp, independent + of `rx-greedy-flag'. + +`(*? SEXP ...)' + like `zero-or-more', but always produces a non-greedy regexp, + independent of `rx-greedy-flag'. + +`(one-or-more SEXP ...)' +`(1+ SEXP ...)' + matches one or more occurrences of SEXP ... + +`(+ SEXP ...)' + like `one-or-more', but always produces a greedy regexp. + +`(+? SEXP ...)' + like `one-or-more', but always produces a non-greedy regexp. + +`(zero-or-one SEXP ...)' +`(optional SEXP ...)' +`(opt SEXP ...)' + matches zero or one occurrences of A. + +`(? SEXP ...)' + like `zero-or-one', but always produces a greedy regexp. + +`(?? SEXP ...)' + like `zero-or-one', but always produces a non-greedy regexp. + +`(repeat N SEXP)' +`(= N SEXP ...)' + matches N occurrences. + +`(>= N SEXP ...)' + matches N or more occurrences. + +`(repeat N M SEXP)' +`(** N M SEXP ...)' + matches N to M occurrences. + +`(backref N)' + matches what was matched previously by submatch N. + +`(eval FORM)' + evaluate FORM and insert result. If result is a string, + `regexp-quote' it. + +`(regexp REGEXP)' + include REGEXP in string notation in the result." + (cond ((null regexps) + (error "No regexp")) + ((cdr regexps) + (rx-to-string `(and ,＠regexps) t)) + (t + (rx-to-string (car regexps) t)))) + +;; ;; sregex.el replacement + +;; ;;;###autoload (provide 'sregex) +;; ;;;###autoload (autoload 'sregex "rx") +;; (defalias 'sregex 'rx-to-string) +;; ;;;###autoload (autoload 'sregexq "rx" nil nil 'macro) +;; (defalias 'sregexq 'rx) + +(provide 'rx) + +;;; rx.el ends here _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

3 participants
3 comments

commit/xemacs-base: sperber: Add rx.el. 11 years, 10 months

Bitbucket

1 new commit in xemacs-base: https://bitbucket.org/xemacs/xemacs-base/commits/8f81f441c070/ changeset: 8f81f441c070 user: sperber date: 2013-02-19 17:44:15 summary: Add rx.el. 2013-02-19 Michael Sperber <mike(a)xemacs.org> * rx.el: Added port from GNU Emacs 24.2. affected #: 3 files diff -r 190b20ac84fc380fba1dabcf04b0181f3ac13353 -r 8f81f441c070adfd90fedb59c13bb6f69dab39a4 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-02-19 Michael Sperber <mike(a)xemacs.org> + + * rx.el: Added port from GNU Emacs 24.2. + 2012-05-11 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 2.32 released. diff -r 190b20ac84fc380fba1dabcf04b0181f3ac13353 -r 8f81f441c070adfd90fedb59c13bb6f69dab39a4 Makefile --- a/Makefile +++ b/Makefile ＠＠ -38,7 +38,7 ＠＠ helper.elc imenu.elc iso-syntax.elc macros.elc novice.elc outline.elc \ passwd.elc pp.elc regexp-opt.elc regi.elc ring.elc shell.elc \ skeleton.elc sort.elc thing.elc time-stamp.elc timer-funcs.elc \ - timezone.elc tq.elc xbm-button.elc xpm-button.elc + timezone.elc tq.elc xbm-button.elc xpm-button.elc rx.elc DATA_FILES = etc/enriched.doc DATA_DEST = . diff -r 190b20ac84fc380fba1dabcf04b0181f3ac13353 -r 8f81f441c070adfd90fedb59c13bb6f69dab39a4 rx.el --- /dev/null +++ b/rx.el ＠＠ -0,0 +1,1182 ＠＠ +;;; rx.el --- sexp notation for regular expressions + +;; Copyright (C) 2001-2012 Free Software Foundation, Inc. + +;; Author: Gerd Moellmann <gerd(a)gnu.org> +;; Maintainer: FSF +;; Keywords: strings, regexps, extensions + +;; This file is part of XEmacs. + +;; XEmacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; XEmacs 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 XEmacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Synched up with: Emacs 24.2 + +;;; Commentary: + +;; This is another implementation of sexp-form regular expressions. +;; It was unfortunately written without being aware of the Sregex +;; package coming with Emacs, but as things stand, Rx completely +;; covers all regexp features, which Sregex doesn't, doesn't suffer +;; from the bugs mentioned in the commentary section of Sregex, and +;; uses a nicer syntax (IMHO, of course :-). + +;; This significantly extended version of the original, is almost +;; compatible with Sregex. The only incompatibility I (fx) know of is +;; that the `repeat' form can't have multiple regexp args. + +;; Now alternative forms are provided for a degree of compatibility +;; with Shivers' attempted definitive SRE notation +;; <URL:http://www.ai.mit.edu/~/shivers/sre.txt>. SRE forms not +;; catered for include: dsm, uncase, w/case, w/nocase, ,＠<exp>, +;; ,<exp>, (word ...), word+, posix-string, and character class forms. +;; Some forms are inconsistent with SRE, either for historical reasons +;; or because of the implementation -- simple translation into Emacs +;; regexp strings. These include: any, word. Also, case-sensitivity +;; and greediness are controlled by variables external to the regexp, +;; and you need to feed the forms to the `posix-' functions to get +;; SRE's POSIX semantics. There are probably more difficulties. + +;; Rx translates a sexp notation for regular expressions into the +;; usual string notation. The translation can be done at compile-time +;; by using the `rx' macro. It can be done at run-time by calling +;; function `rx-to-string'. See the documentation of `rx' for a +;; complete description of the sexp notation. +;; +;; Some examples of string regexps and their sexp counterparts: +;; +;; "^[a-z]*" +;; (rx (and line-start (0+ (in "a-z")))) +;; +;; "\n[^ \t]" +;; (rx (and "\n" (not blank))), or +;; (rx (and "\n" (not (any " \t")))) +;; +;; "\\*\\*\\* EOOH \\*\\*\\*\n" +;; (rx "*** EOOH ***\n") +;; +;; "\\<\$catch\\|finally\$\\>[^_]" +;; (rx (and word-start (submatch (or "catch" "finally")) word-end +;; (not (any ?_)))) +;; +;; "[ \t\n]*:\$[^:]+\\|$\$" +;; (rx (and (zero-or-more (in " \t\n")) ":" +;; (submatch (or line-end (one-or-more (not (any ?:))))))) +;; +;; "^content-transfer-encoding:\$\n?[\t ]\$*quoted-printable\$\n?[\t ]\$*" +;; (rx (and line-start +;; "content-transfer-encoding:" +;; (+ (? ?\n)) blank +;; "quoted-printable" +;; (+ (? ?\n)) blank)) +;; +;; (concat "^\$?:" something-else "\$") +;; (rx (and line-start (eval something-else))), statically or +;; (rx-to-string '(and line-start ,something-else)), dynamically. +;; +;; (regexp-opt '(STRING1 STRING2 ...)) +;; (rx (or STRING1 STRING2 ...)), or in other words, `or' automatically +;; calls `regexp-opt' as needed. +;; +;; "^;;\\s-*\n\\|^\n" +;; (rx (or (and line-start ";;" (0+ space) ?\n) +;; (and line-start ?\n))) +;; +;; "\\$[I]d: [^ ]+ \$[^ ]+\$ " +;; (rx (and "$Id: " +;; (1+ (not (in " "))) +;; " " +;; (submatch (1+ (not (in " ")))) +;; " ")) +;; +;; "\\\\\\\\\\[\\w+" +;; (rx (and ?\\ ?\\ ?\[ (1+ word))) +;; +;; etc. + +;;; History: +;; + +;;; Code: + +(defconst rx-constituents + '((and . (rx-and 1 nil)) + (seq . and) ; SRE + (: . and) ; SRE + (sequence . and) ; sregex + (or . (rx-or 1 nil)) + (| . or) ; SRE + (not-newline . ".") + (nonl . not-newline) ; SRE + (anything . (rx-anything 0 nil)) + (any . (rx-any 1 nil rx-check-any)) ; inconsistent with SRE + (any . ".") ; sregex + (in . any) + (char . any) ; sregex + (not-char . (rx-not-char 1 nil rx-check-any)) ; sregex + (not . (rx-not 1 1 rx-check-not)) + (repeat . (rx-repeat 2 nil)) + (= . (rx-= 2 nil)) ; SRE + (>= . (rx->= 2 nil)) ; SRE + (** . (rx-** 2 nil)) ; SRE + (submatch . (rx-submatch 1 nil)) ; SRE + (group . submatch) ; sregex + (submatch-n . (rx-submatch-n 2 nil)) + (group-n . submatch-n) + (zero-or-more . (rx-kleene 1 nil)) + (one-or-more . (rx-kleene 1 nil)) + (zero-or-one . (rx-kleene 1 nil)) + (\? . zero-or-one) ; SRE + (\?? . zero-or-one) + (* . zero-or-more) ; SRE + (*? . zero-or-more) + (0+ . zero-or-more) + (+ . one-or-more) ; SRE + (+? . one-or-more) + (1+ . one-or-more) + (optional . zero-or-one) + (opt . zero-or-one) ; sregex + (minimal-match . (rx-greedy 1 1)) + (maximal-match . (rx-greedy 1 1)) + (backref . (rx-backref 1 1 rx-check-backref)) + (line-start . "^") + (bol . line-start) ; SRE + (line-end . "$") + (eol . line-end) ; SRE + (string-start . "\\`") + (bos . string-start) ; SRE + (bot . string-start) ; sregex + (string-end . "\\'") + (eos . string-end) ; SRE + (eot . string-end) ; sregex + (buffer-start . "\\`") + (buffer-end . "\\'") + (point . "\\=") + (word-start . "\\<") + (bow . word-start) ; SRE + (word-end . "\\>") + (eow . word-end) ; SRE + (word-boundary . "\\b") + (not-word-boundary . "\\B") ; sregex + (symbol-start . "\\_<") + (symbol-end . "\\_>") + (syntax . (rx-syntax 1 1)) + (not-syntax . (rx-not-syntax 1 1)) ; sregex + (category . (rx-category 1 1 rx-check-category)) + (eval . (rx-eval 1 1)) + (regexp . (rx-regexp 1 1 stringp)) + (regex . regexp) ; sregex + (digit . "[[:digit:]]") + (numeric . digit) ; SRE + (num . digit) ; SRE + (control . "[[:cntrl:]]") ; SRE + (cntrl . control) ; SRE + (hex-digit . "[[:xdigit:]]") ; SRE + (hex . hex-digit) ; SRE + (xdigit . hex-digit) ; SRE + (blank . "[[:blank:]]") ; SRE + (graphic . "[[:graph:]]") ; SRE + (graph . graphic) ; SRE + (printing . "[[:print:]]") ; SRE + (print . printing) ; SRE + (alphanumeric . "[[:alnum:]]") ; SRE + (alnum . alphanumeric) ; SRE + (letter . "[[:alpha:]]") + (alphabetic . letter) ; SRE + (alpha . letter) ; SRE + (ascii . "[[:ascii:]]") ; SRE + (nonascii . "[[:nonascii:]]") + (lower . "[[:lower:]]") ; SRE + (lower-case . lower) ; SRE + (punctuation . "[[:punct:]]") ; SRE + (punct . punctuation) ; SRE + (space . "[[:space:]]") ; SRE + (whitespace . space) ; SRE + (white . space) ; SRE + (upper . "[[:upper:]]") ; SRE + (upper-case . upper) ; SRE + (word . "[[:word:]]") ; inconsistent with SRE + (wordchar . word) ; sregex + (not-wordchar . "\\W")) + "Alist of sexp form regexp constituents. +Each element of the alist has the form (SYMBOL . DEFN). +SYMBOL is a valid constituent of sexp regular expressions. +If DEFN is a string, SYMBOL is translated into DEFN. +If DEFN is a symbol, use the definition of DEFN, recursively. +Otherwise, DEFN must be a list (FUNCTION MIN-ARGS MAX-ARGS PREDICATE). +FUNCTION is used to produce code for SYMBOL. MIN-ARGS and MAX-ARGS +are the minimum and maximum number of arguments the function-form +sexp constituent SYMBOL may have in sexp regular expressions. +MAX-ARGS nil means no limit. PREDICATE, if specified, means that +all arguments must satisfy PREDICATE.") + + +(defconst rx-syntax + '((whitespace . ?-) + (punctuation . ?.) + (word . ?w) + (symbol . ?_) + (open-parenthesis . ?$) + (close-parenthesis . ?$) + (expression-prefix . ?\') + (string-quote . ?\") + (paired-delimiter . ?$) + (escape . ?\\) + (character-quote . ?/) + (comment-start . ?<) + (comment-end . ?>) + (string-delimiter . ?|) + (comment-delimiter . ?!)) + "Alist mapping Rx syntax symbols to syntax characters. +Each entry has the form (SYMBOL . CHAR), where SYMBOL is a valid +symbol in `(syntax SYMBOL)', and CHAR is the syntax character +corresponding to SYMBOL, as it would be used with \\s or \\S in +regular expressions.") + + +(defconst rx-categories + '((consonant . ?0) + (base-vowel . ?1) + (upper-diacritical-mark . ?2) + (lower-diacritical-mark . ?3) + (tone-mark . ?4) + (symbol . ?5) + (digit . ?6) + (vowel-modifying-diacritical-mark . ?7) + (vowel-sign . ?8) + (semivowel-lower . ?9) + (not-at-end-of-line . ?<) + (not-at-beginning-of-line . ?>) + (alpha-numeric-two-byte . ?A) + (chinse-two-byte . ?C) + (greek-two-byte . ?G) + (japanese-hiragana-two-byte . ?H) + (indian-two-byte . ?I) + (japanese-katakana-two-byte . ?K) + (korean-hangul-two-byte . ?N) + (cyrillic-two-byte . ?Y) + (combining-diacritic . ?^) + (ascii . ?a) + (arabic . ?b) + (chinese . ?c) + (ethiopic . ?e) + (greek . ?g) + (korean . ?h) + (indian . ?i) + (japanese . ?j) + (japanese-katakana . ?k) + (latin . ?l) + (lao . ?o) + (tibetan . ?q) + (japanese-roman . ?r) + (thai . ?t) + (vietnamese . ?v) + (hebrew . ?w) + (cyrillic . ?y) + (can-break . ?|)) + "Alist mapping symbols to category characters. +Each entry has the form (SYMBOL . CHAR), where SYMBOL is a valid +symbol in `(category SYMBOL)', and CHAR is the category character +corresponding to SYMBOL, as it would be used with `\\c' or `\\C' in +regular expression strings.") + + +(defvar rx-greedy-flag t + "Non-nil means produce greedy regular expressions for `zero-or-one', +`zero-or-more', and `one-or-more'. Dynamically bound.") + + +(defun rx-info (op head) + "Return parsing/code generation info for OP. +If OP is the space character ASCII 32, return info for the symbol `?'. +If OP is the character `?', return info for the symbol `??'. +See also `rx-constituents'. +If HEAD is non-nil, then OP is the head of a sexp, otherwise it's +a standalone symbol." + (cond ((eq op ? ) (setq op '\?)) + ((eq op ??) (setq op '\??))) + (let (old-op) + (while (and (not (null op)) (symbolp op)) + (setq old-op op) + (setq op (cdr (assq op rx-constituents))) + (when (if head (stringp op) (consp op)) + ;; We found something but of the wrong kind. Let's look for an + ;; alternate definition for the other case. + (let ((new-op + (cdr (assq old-op (cdr (memq (assq old-op rx-constituents) + rx-constituents)))))) + (if (and new-op (not (if head (stringp new-op) (consp new-op)))) + (setq op new-op)))))) + op) + + +(defun rx-check (form) + "Check FORM according to its car's parsing info." + (unless (listp form) + (error "rx `%s' needs argument(s)" form)) + (let* ((rx (rx-info (car form) 'head)) + (nargs (1- (length form))) + (min-args (nth 1 rx)) + (max-args (nth 2 rx)) + (type-pred (nth 3 rx))) + (when (and (not (null min-args)) + (< nargs min-args)) + (error "rx form `%s' requires at least %d args" + (car form) min-args)) + (when (and (not (null max-args)) + (> nargs max-args)) + (error "rx form `%s' accepts at most %d args" + (car form) max-args)) + (when (not (null type-pred)) + (dolist (sub-form (cdr form)) + (unless (funcall type-pred sub-form) + (error "rx form `%s' requires args satisfying `%s'" + (car form) type-pred)))))) + + +(defun rx-group-if (regexp group) + "Put shy groups around REGEXP if seemingly necessary when GROUP +is non-nil." + (cond + ;; for some repetition + ((eq group '*) (if (rx-atomic-p regexp) (setq group nil))) + ;; for concatenation + ((eq group ':) + (if (rx-atomic-p + (if (string-match + "\$?:[?*+]\\??\\|\\\\{[0-9]*,?[0-9]*\\\\}\$\\'" regexp) + (substring regexp 0 (match-beginning 0)) + regexp)) + (setq group nil))) + ;; for OR + ((eq group '|) (setq group nil)) + ;; do anyway + ((eq group t)) + ((rx-atomic-p regexp t) (setq group nil))) + (if group + (concat "\$?:" regexp "\$") + regexp)) + + +(defvar rx-parent) +;; dynamically bound in some functions. + + +(defun rx-and (form) + "Parse and produce code from FORM. +FORM is of the form `(and FORM1 ...)'." + (rx-check form) + (rx-group-if + (mapconcat (lambda (x) (rx-form x ':)) (cdr form) nil) + (and (memq rx-parent '(* t)) rx-parent))) + + +(defun rx-or (form) + "Parse and produce code from FORM, which is `(or FORM1 ...)'." + (rx-check form) + (rx-group-if + (if (memq nil (mapcar 'stringp (cdr form))) + (mapconcat (lambda (x) (rx-form x '|)) (cdr form) "\\|") + (regexp-opt (cdr form))) + (and (memq rx-parent '(: * t)) rx-parent))) + + +(defun rx-anything (form) + "Match any character." + (if (consp form) + (error "rx `anything' syntax error: %s" form)) + (rx-or (list 'or 'not-newline ?\n))) + + +(defun rx-any-delete-from-range (char ranges) + "Delete by side effect character CHAR from RANGES. +Only both edges of each range is checked." + (let (m) + (cond + ((memq char ranges) (setq ranges (delq char ranges))) + ((setq m (assq char ranges)) + (if (eq (int-char (1+ char)) (cdr m)) + (setcar (memq m ranges) (int-char (1+ char))) + (setcar m (int-char (1+ char))))) + ((setq m (rassq char ranges)) + (if (eq (int-char (1- char)) (car m)) + (setcar (memq m ranges) (int-char (1- char))) + (setcdr m (int-char (1- char)))))) + ranges)) + + +(defun rx-any-condense-range (args) + "Condense by side effect ARGS as range for Rx `any'." + (let (str + l) + ;; set STR list of all strings + ;; set L list of all ranges + (mapc (lambda (e) (cond ((stringp e) (push e str)) + ((characterp e) (push (cons e e) l)) + (t (push e l)))) + args) + ;; condense overlapped ranges in L + (let ((tail (setq l (sort l #'car-less-than-car))) + d) + (while (setq d (cdr tail)) + (if (>= (cdar tail) (1- (caar d))) + (progn + (setcdr (car tail) (int-char (max (cdar tail) (cdar d)))) + (setcdr tail (cdr d))) + (setq tail d)))) + ;; Separate small ranges to single number, and delete dups. + (nconc + (apply #'nconc + (mapcar (lambda (e) + (cond + ((= (car e) (cdr e)) (list (car e))) + ((= (int-char (1+ (car e))) (cdr e)) (list (car e) (cdr e))) + ((list e)))) + l)) + (delete-dups str)))) + + +(defun rx-check-any-string (str) + "Check string argument STR for Rx `any'." + (let ((i 0) + c1 c2 l) + (if (= 0 (length str)) + (error "String arg for Rx `any' must not be empty")) + (while (string-match ".-." str i) + ;; string before range: convert it to characters + (if (< i (match-beginning 0)) + (setq l (nconc + l + (append (substring str i (match-beginning 0)) nil)))) + ;; range + (setq i (match-end 0) + c1 (aref str (match-beginning 0)) + c2 (aref str (1- i))) + (cond + ((< c1 c2) (setq l (nconc l (list (cons c1 c2))))) + ((= c1 c2) (setq l (nconc l (list c1)))))) + ;; rest? + (if (< i (length str)) + (setq l (nconc l (append (substring str i) nil)))) + l)) + + +(defun rx-check-any (arg) + "Check arg ARG for Rx `any'." + (cond + ((characterp arg) (list arg)) + ((symbolp arg) + (let ((translation (condition-case nil + (rx-form arg) + (error nil)))) + (if (or (null translation) + (null (string-match "\\`\\[\\[:[-a-z]+:\\]\\]\\'" translation))) + (error "Invalid char class `%s' in Rx `any'" arg)) + (list (substring translation 1 -1)))) ; strip outer brackets + ((and (characterp (car-safe arg)) (characterp (cdr-safe arg))) + (list arg)) + ((stringp arg) (rx-check-any-string arg)) + ((error + "rx `any' requires string, character, char pair or char class args")))) + + +(defun rx-any (form) + "Parse and produce code from FORM, which is `(any ARG ...)'. +ARG is optional." + (rx-check form) + (let* ((args (rx-any-condense-range + (apply + #'nconc + (mapcar #'rx-check-any (cdr form))))) + m + s) + (cond + ;; single close bracket + ;; => "[]...-]" or "[]...--.]" + ((memq ?\] args) + ;; set ] at the beginning + (setq args (cons ?\] (delq ?\] args))) + ;; set - at the end + (if (or (memq ?- args) (assq ?- args)) + (setq args (nconc (rx-any-delete-from-range ?- args) + (list ?-))))) + ;; close bracket starts a range + ;; => "[]-....-]" or "[]-.--....]" + ((setq m (assq ?\] args)) + ;; bring it to the beginning + (setq args (cons m (delq m args))) + (cond ((memq ?- args) + ;; to the end + (setq args (nconc (delq ?- args) (list ?-)))) + ((setq m (assq ?- args)) + ;; next to the bracket's range, make the second range + (setcdr args (cons m (delq m args)))))) + ;; bracket in the end range + ;; => "[]...-]" + ((setq m (rassq ?\] args)) + ;; set ] at the beginning + (setq args (cons ?\] (rx-any-delete-from-range ?\] args))) + ;; set - at the end + (if (or (memq ?- args) (assq ?- args)) + (setq args (nconc (rx-any-delete-from-range ?- args) + (list ?-))))) + ;; {no close bracket appears} + ;; + ;; bring single bar to the beginning + ((memq ?- args) + (setq args (cons ?- (delq ?- args)))) + ;; bar start a range, bring it to the beginning + ((setq m (assq ?- args)) + (setq args (cons m (delq m args)))) + ;; + ;; hat at the beginning? + ((or (eq (car args) ?^) (eq (car-safe (car args)) ?^)) + (setq args (if (cdr args) + `(,(cadr args) ,(car args) ,＠(cddr args)) + (nconc (rx-any-delete-from-range ?^ args) + (list ?^)))))) + ;; some 1-char? + (if (and (null (cdr args)) (characterp (car args)) + (or (= 1 (length + (setq s (regexp-quote (string (car args)))))) + (and (equal (car args) ?^) ;; unnecessary predicate? + (null (eq rx-parent '!))))) + s + (concat "[" + (mapconcat + (lambda (e) (cond + ((characterp e) (string e)) + ((consp e) + (if (and (= (1+ (car e)) (cdr e)) + ;; rx-any-condense-range should + ;; prevent this case from happening. + (null (memq (car e) '(?\] ?-))) + (null (memq (cdr e) '(?\] ?-)))) + (string (car e) (cdr e)) + (string (car e) ?- (cdr e)))) + (e))) + args + nil) + "]")))) + + +(defun rx-check-not (arg) + "Check arg ARG for Rx `not'." + (unless (or (and (symbolp arg) + (string-match "\\`\\[\\[:[-a-z]+:\\]\\]\\'" + (condition-case nil + (rx-form arg) + (error "")))) + (eq arg 'word-boundary) + (and (consp arg) + (memq (car arg) '(not any in syntax category)))) + (error "rx `not' syntax error: %s" arg)) + t) + + +(defun rx-not (form) + "Parse and produce code from FORM. FORM is `(not ...)'." + (rx-check form) + (let ((result (rx-form (cadr form) '!)) + case-fold-search) + (cond ((string-match "\\`\\[^" result) + (cond + ((equal result "[^]") "[^^]") + ((and (= (length result) 4) (null (eq rx-parent '!))) + (regexp-quote (substring result 2 3))) + ((concat "[" (substring result 2))))) + ((eq ?\[ (aref result 0)) + (concat "[^" (substring result 1))) + ((string-match "\\`\\\\[scbw]" result) + (concat (upcase (substring result 0 2)) + (substring result 2))) + ((string-match "\\`\\\\[SCBW]" result) + (concat (downcase (substring result 0 2)) + (substring result 2))) + (t + (concat "[^" result "]"))))) + + +(defun rx-not-char (form) + "Parse and produce code from FORM. FORM is `(not-char ...)'." + (rx-check form) + (rx-not `(not (in ,＠(cdr form))))) + + +(defun rx-not-syntax (form) + "Parse and produce code from FORM. FORM is `(not-syntax SYNTAX)'." + (rx-check form) + (rx-not `(not (syntax ,＠(cdr form))))) + + +(defun rx-trans-forms (form &optional skip) + "If FORM's length is greater than two, transform it to length two. +A form (HEAD REST ...) becomes (HEAD (and REST ...)). +If SKIP is non-nil, allow that number of items after the head, i.e. +`(= N REST ...)' becomes `(= N (and REST ...))' if SKIP is 1." + (unless skip (setq skip 0)) + (let ((tail (nthcdr (1+ skip) form))) + (if (= (length tail) 1) + form + (let ((form (copy-sequence form))) + (setcdr (nthcdr skip form) (list (cons 'and tail))) + form)))) + + +(defun rx-= (form) + "Parse and produce code from FORM `(= N ...)'." + (rx-check form) + (setq form (rx-trans-forms form 1)) + (unless (and (integerp (nth 1 form)) + (> (nth 1 form) 0)) + (error "rx `=' requires positive integer first arg")) + (format "%s\\{%d\\}" (rx-form (nth 2 form) '*) (nth 1 form))) + + +(defun rx->= (form) + "Parse and produce code from FORM `(>= N ...)'." + (rx-check form) + (setq form (rx-trans-forms form 1)) + (unless (and (integerp (nth 1 form)) + (> (nth 1 form) 0)) + (error "rx `>=' requires positive integer first arg")) + (format "%s\\{%d,\\}" (rx-form (nth 2 form) '*) (nth 1 form))) + + +(defun rx-** (form) + "Parse and produce code from FORM `(** N M ...)'." + (rx-check form) + (rx-form (cons 'repeat (cdr (rx-trans-forms form 2))) '*)) + + +(defun rx-repeat (form) + "Parse and produce code from FORM. +FORM is either `(repeat N FORM1)' or `(repeat N M FORMS...)'." + (rx-check form) + (if (> (length form) 4) + (setq form (rx-trans-forms form 2))) + (if (null (nth 2 form)) + (setq form (cons (nth 0 form) (cons (nth 1 form) (nthcdr 3 form))))) + (cond ((= (length form) 3) + (unless (and (integerp (nth 1 form)) + (> (nth 1 form) 0)) + (error "rx `repeat' requires positive integer first arg")) + (format "%s\\{%d\\}" (rx-form (nth 2 form) '*) (nth 1 form))) + ((or (not (integerp (nth 2 form))) + (< (nth 2 form) 0) + (not (integerp (nth 1 form))) + (< (nth 1 form) 0) + (< (nth 2 form) (nth 1 form))) + (error "rx `repeat' range error")) + (t + (format "%s\\{%d,%d\\}" (rx-form (nth 3 form) '*) + (nth 1 form) (nth 2 form))))) + + +(defun rx-submatch (form) + "Parse and produce code from FORM, which is `(submatch ...)'." + (concat "\$" + (if (= 2 (length form)) + ;; Only one sub-form. + (rx-form (cadr form)) + ;; Several sub-forms implicitly concatenated. + (mapconcat (lambda (re) (rx-form re ':)) (cdr form) nil)) + "\$")) + +(defun rx-submatch-n (form) + "Parse and produce code from FORM, which is `(submatch-n N ...)'." + (let ((n (nth 1 form))) + (concat "\$?" (number-to-string n) ":" + (if (= 3 (length form)) + ;; Only one sub-form. + (rx-form (nth 2 form)) + ;; Several sub-forms implicitly concatenated. + (mapconcat (lambda (re) (rx-form re ':)) (cddr form) nil)) + "\$"))) + +(defun rx-backref (form) + "Parse and produce code from FORM, which is `(backref N)'." + (rx-check form) + (format "\\%d" (nth 1 form))) + +(defun rx-check-backref (arg) + "Check arg ARG for Rx `backref'." + (or (and (integerp arg) (>= arg 1) (<= arg 9)) + (error "rx `backref' requires numeric 1<=arg<=9: %s" arg))) + +(defun rx-kleene (form) + "Parse and produce code from FORM. +FORM is `(OP FORM1)', where OP is one of the `zero-or-one', +`zero-or-more' etc. operators. +If OP is one of `*', `+', `?', produce a greedy regexp. +If OP is one of `*?', `+?', `??', produce a non-greedy regexp. +If OP is anything else, produce a greedy regexp if `rx-greedy-flag' +is non-nil." + (rx-check form) + (setq form (rx-trans-forms form)) + (let ((suffix (cond ((memq (car form) '(* + ?\s)) "") + ((memq (car form) '(*? +? ??)) "?") + (rx-greedy-flag "") + (t "?"))) + (op (cond ((memq (car form) '(* *? 0+ zero-or-more)) "*") + ((memq (car form) '(+ +? 1+ one-or-more)) "+") + (t "?")))) + (rx-group-if + (concat (rx-form (cadr form) '*) op suffix) + (and (memq rx-parent '(t *)) rx-parent)))) + + +(defun rx-atomic-p (r &optional lax) + "Return non-nil if regexp string R is atomic. +An atomic regexp R is one such that a suffix operator +appended to R will apply to all of R. For example, \"a\" +\"[abc]\" and \"\$ab\\|ab*c\$\" are atomic and \"ab\", +\"[ab]c\", and \"ab\\|ab*c\" are not atomic. + +This function may return false negatives, but it will not +return false positives. It is nevertheless useful in +situations where an efficiency shortcut can be taken only if a +regexp is atomic. The function can be improved to detect +more cases of atomic regexps. Presently, this function +detects the following categories of atomic regexp; + + a group or shy group: \$...\$ + a character class: [...] + a single character: a + +On the other hand, false negatives will be returned for +regexps that are atomic but end in operators, such as +\"a+\". I think these are rare. Probably such cases could +be detected without much effort. A guarantee of no false +negatives would require a theoretic specification of the set +of all atomic regexps." + (let ((l (length r))) + (cond + ((<= l 1)) + ((= l 2) (= (aref r 0) ?\\)) + ((= l 3) (string-match "\\`\$?:\\\\[cCsS_]\\|\\[[^^]\\]\$" r)) + ((null lax) + (cond + ((string-match "\\`\\[^?\]?\$?:\\[:[a-z]+:]\\|[^\]]\$*\\]\\'" r)) + ((string-match "\\`\\\$\\(?:[^\\]\\|\\\\[^$]\\)*\\\\)\\'" r))))))) + + +(defun rx-syntax (form) + "Parse and produce code from FORM, which is `(syntax SYMBOL)'." + (rx-check form) + (let* ((sym (cadr form)) + (syntax (cdr (assq sym rx-syntax)))) + (unless syntax + ;; Try sregex compatibility. + (cond + ((characterp sym) (setq syntax sym)) + ((symbolp sym) + (let ((name (symbol-name sym))) + (if (= 1 (length name)) + (setq syntax (aref name 0)))))) + (unless syntax + (error "Unknown rx syntax `%s'" sym))) + (format "\\s%c" syntax))) + + +(defun rx-check-category (form) + "Check the argument FORM of a `(category FORM)'." + (unless (or (characterp form) + (cdr (assq form rx-categories))) + (error "Unknown category `%s'" form)) + t) + + +(defun rx-category (form) + "Parse and produce code from FORM, which is `(category SYMBOL)'." + (rx-check form) + (let ((char (if (characterp (cadr form)) + (cadr form) + (cdr (assq (cadr form) rx-categories))))) + (format "\\c%c" char))) + + +(defun rx-eval (form) + "Parse and produce code from FORM, which is `(eval FORM)'." + (rx-check form) + (rx-form (eval (cadr form)) rx-parent)) + + +(defun rx-greedy (form) + "Parse and produce code from FORM. +If FORM is '(minimal-match FORM1)', non-greedy versions of `*', +`+', and `?' operators will be used in FORM1. If FORM is +'(maximal-match FORM1)', greedy operators will be used." + (rx-check form) + (let ((rx-greedy-flag (eq (car form) 'maximal-match))) + (rx-form (cadr form) rx-parent))) + + +(defun rx-regexp (form) + "Parse and produce code from FORM, which is `(regexp STRING)'." + (rx-check form) + (rx-group-if (cadr form) rx-parent)) + + +(defun rx-form (form &optional rx-parent) + "Parse and produce code for regular expression FORM. +FORM is a regular expression in sexp form. +RX-PARENT shows which type of expression calls and controls putting of +shy groups around the result and some more in other functions." + (if (stringp form) + (rx-group-if (regexp-quote form) + (if (and (eq rx-parent '*) (< 1 (length form))) + rx-parent)) + (cond ((characterp form) + (regexp-quote (char-to-string form))) + ((symbolp form) + (let ((info (rx-info form nil))) + (cond ((stringp info) + info) + ((null info) + (error "Unknown rx form `%s'" form)) + (t + (funcall (nth 0 info) form))))) + ((consp form) + (let ((info (rx-info (car form) 'head))) + (unless (consp info) + (error "Unknown rx form `%s'" (car form))) + (funcall (nth 0 info) form))) + (t + (error "rx syntax error at `%s'" form))))) + + +;;;###autoload +(defun rx-to-string (form &optional no-group) + "Parse and produce code for regular expression FORM. +FORM is a regular expression in sexp form. +NO-GROUP non-nil means don't put shy groups around the result." + (rx-group-if (rx-form form) (null no-group))) + + +;;;###autoload +(defmacro rx (&rest regexps) + "Translate regular expressions REGEXPS in sexp form to a regexp string. +REGEXPS is a non-empty sequence of forms of the sort listed below. + +Note that `rx' is a Lisp macro; when used in a Lisp program being + compiled, the translation is performed by the compiler. +See `rx-to-string' for how to do such a translation at run-time. + +The following are valid subforms of regular expressions in sexp +notation. + +STRING + matches string STRING literally. + +CHAR + matches character CHAR literally. + +`not-newline', `nonl' + matches any character except a newline. + +`anything' + matches any character + +`(any SET ...)' +`(in SET ...)' +`(char SET ...)' + matches any character in SET .... SET may be a character or string. + Ranges of characters can be specified as `A-Z' in strings. + Ranges may also be specified as conses like `(?A . ?Z)'. + + SET may also be the name of a character class: `digit', + `control', `hex-digit', `blank', `graph', `print', `alnum', + `alpha', `ascii', `nonascii', `lower', `punct', `space', `upper', + `word', or one of their synonyms. + +`(not (any SET ...))' + matches any character not in SET ... + +`line-start', `bol' + matches the empty string, but only at the beginning of a line + in the text being matched + +`line-end', `eol' + is similar to `line-start' but matches only at the end of a line + +`string-start', `bos', `bot' + matches the empty string, but only at the beginning of the + string being matched against. + +`string-end', `eos', `eot' + matches the empty string, but only at the end of the + string being matched against. + +`buffer-start' + matches the empty string, but only at the beginning of the + buffer being matched against. Actually equivalent to `string-start'. + +`buffer-end' + matches the empty string, but only at the end of the + buffer being matched against. Actually equivalent to `string-end'. + +`point' + matches the empty string, but only at point. + +`word-start', `bow' + matches the empty string, but only at the beginning of a word. + +`word-end', `eow' + matches the empty string, but only at the end of a word. + +`word-boundary' + matches the empty string, but only at the beginning or end of a + word. + +`(not word-boundary)' +`not-word-boundary' + matches the empty string, but not at the beginning or end of a + word. + +`symbol-start' + matches the empty string, but only at the beginning of a symbol. + +`symbol-end' + matches the empty string, but only at the end of a symbol. + +`digit', `numeric', `num' + matches 0 through 9. + +`control', `cntrl' + matches ASCII control characters. + +`hex-digit', `hex', `xdigit' + matches 0 through 9, a through f and A through F. + +`blank' + matches space and tab only. + +`graphic', `graph' + matches graphic characters--everything except ASCII control chars, + space, and DEL. + +`printing', `print' + matches printing characters--everything except ASCII control chars + and DEL. + +`alphanumeric', `alnum' + matches letters and digits. (But at present, for multibyte characters, + it matches anything that has word syntax.) + +`letter', `alphabetic', `alpha' + matches letters. (But at present, for multibyte characters, + it matches anything that has word syntax.) + +`ascii' + matches ASCII (unibyte) characters. + +`nonascii' + matches non-ASCII (multibyte) characters. + +`lower', `lower-case' + matches anything lower-case. + +`upper', `upper-case' + matches anything upper-case. + +`punctuation', `punct' + matches punctuation. (But at present, for multibyte characters, + it matches anything that has non-word syntax.) + +`space', `whitespace', `white' + matches anything that has whitespace syntax. + +`word', `wordchar' + matches anything that has word syntax. + +`not-wordchar' + matches anything that has non-word syntax. + +`(syntax SYNTAX)' + matches a character with syntax SYNTAX. SYNTAX must be one + of the following symbols, or a symbol corresponding to the syntax + character, e.g. `\\.' for `\\s.'. + + `whitespace' (\\s- in string notation) + `punctuation' (\\s.) + `word' (\\sw) + `symbol' (\\s_) + `open-parenthesis' (\\s() + `close-parenthesis' (\\s)) + `expression-prefix' (\\s') + `string-quote' (\\s\") + `paired-delimiter' (\\s$) + `escape' (\\s\\) + `character-quote' (\\s/) + `comment-start' (\\s<) + `comment-end' (\\s>) + `string-delimiter' (\\s|) + `comment-delimiter' (\\s!) + +`(not (syntax SYNTAX))' + matches a character that doesn't have syntax SYNTAX. + +`(category CATEGORY)' + matches a character with category CATEGORY. CATEGORY must be + either a character to use for C, or one of the following symbols. + + `consonant' (\\c0 in string notation) + `base-vowel' (\\c1) + `upper-diacritical-mark' (\\c2) + `lower-diacritical-mark' (\\c3) + `tone-mark' (\\c4) + `symbol' (\\c5) + `digit' (\\c6) + `vowel-modifying-diacritical-mark' (\\c7) + `vowel-sign' (\\c8) + `semivowel-lower' (\\c9) + `not-at-end-of-line' (\\c<) + `not-at-beginning-of-line' (\\c>) + `alpha-numeric-two-byte' (\\cA) + `chinse-two-byte' (\\cC) + `greek-two-byte' (\\cG) + `japanese-hiragana-two-byte' (\\cH) + `indian-tow-byte' (\\cI) + `japanese-katakana-two-byte' (\\cK) + `korean-hangul-two-byte' (\\cN) + `cyrillic-two-byte' (\\cY) + `combining-diacritic' (\\c^) + `ascii' (\\ca) + `arabic' (\\cb) + `chinese' (\\cc) + `ethiopic' (\\ce) + `greek' (\\cg) + `korean' (\\ch) + `indian' (\\ci) + `japanese' (\\cj) + `japanese-katakana' (\\ck) + `latin' (\\cl) + `lao' (\\co) + `tibetan' (\\cq) + `japanese-roman' (\\cr) + `thai' (\\ct) + `vietnamese' (\\cv) + `hebrew' (\\cw) + `cyrillic' (\\cy) + `can-break' (\\c|) + +`(not (category CATEGORY))' + matches a character that doesn't have category CATEGORY. + +`(and SEXP1 SEXP2 ...)' +`(: SEXP1 SEXP2 ...)' +`(seq SEXP1 SEXP2 ...)' +`(sequence SEXP1 SEXP2 ...)' + matches what SEXP1 matches, followed by what SEXP2 matches, etc. + +`(submatch SEXP1 SEXP2 ...)' +`(group SEXP1 SEXP2 ...)' + like `and', but makes the match accessible with `match-end', + `match-beginning', and `match-string'. + +`(submatch-n N SEXP1 SEXP2 ...)' +`(group-n N SEXP1 SEXP2 ...)' + like `group', but make it an explicitly-numbered group with + group number N. + +`(or SEXP1 SEXP2 ...)' +`(| SEXP1 SEXP2 ...)' + matches anything that matches SEXP1 or SEXP2, etc. If all + args are strings, use `regexp-opt' to optimize the resulting + regular expression. + +`(minimal-match SEXP)' + produce a non-greedy regexp for SEXP. Normally, regexps matching + zero or more occurrences of something are \"greedy\" in that they + match as much as they can, as long as the overall regexp can + still match. A non-greedy regexp matches as little as possible. + +`(maximal-match SEXP)' + produce a greedy regexp for SEXP. This is the default. + +Below, `SEXP ...' represents a sequence of regexp forms, treated as if +enclosed in `(and ...)'. + +`(zero-or-more SEXP ...)' +`(0+ SEXP ...)' + matches zero or more occurrences of what SEXP ... matches. + +`(* SEXP ...)' + like `zero-or-more', but always produces a greedy regexp, independent + of `rx-greedy-flag'. + +`(*? SEXP ...)' + like `zero-or-more', but always produces a non-greedy regexp, + independent of `rx-greedy-flag'. + +`(one-or-more SEXP ...)' +`(1+ SEXP ...)' + matches one or more occurrences of SEXP ... + +`(+ SEXP ...)' + like `one-or-more', but always produces a greedy regexp. + +`(+? SEXP ...)' + like `one-or-more', but always produces a non-greedy regexp. + +`(zero-or-one SEXP ...)' +`(optional SEXP ...)' +`(opt SEXP ...)' + matches zero or one occurrences of A. + +`(? SEXP ...)' + like `zero-or-one', but always produces a greedy regexp. + +`(?? SEXP ...)' + like `zero-or-one', but always produces a non-greedy regexp. + +`(repeat N SEXP)' +`(= N SEXP ...)' + matches N occurrences. + +`(>= N SEXP ...)' + matches N or more occurrences. + +`(repeat N M SEXP)' +`(** N M SEXP ...)' + matches N to M occurrences. + +`(backref N)' + matches what was matched previously by submatch N. + +`(eval FORM)' + evaluate FORM and insert result. If result is a string, + `regexp-quote' it. + +`(regexp REGEXP)' + include REGEXP in string notation in the result." + (cond ((null regexps) + (error "No regexp")) + ((cdr regexps) + (rx-to-string `(and ,＠regexps) t)) + (t + (rx-to-string (car regexps) t)))) + +;; ;; sregex.el replacement + +;; ;;;###autoload (provide 'sregex) +;; ;;;###autoload (autoload 'sregex "rx") +;; (defalias 'sregex 'rx-to-string) +;; ;;;###autoload (autoload 'sregexq "rx" nil nil 'macro) +;; (defalias 'sregexq 'rx) + +(provide 'rx) + +;;; rx.el ends here Repository URL: https://bitbucket.org/xemacs/xemacs-base/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

[PATCH] make define-obsolete-* functions compatible with FSF 11 years, 10 months

Jeff Sparkes

I ran into this while updating org-mode. The diff is also attached. diff --git a/lisp/ChangeLog b/lisp/ChangeLog --- a/lisp/ChangeLog +++ b/lisp/ChangeLog ＠＠ -1,3 +1,9 ＠＠ +2013-02-13 Jeff Sparkes <jsparkes(a)gmail.com> + + * obsolete.el (define-obsolete-function-alias): Add args to match + FSF function. + (define-obsolete-variable-alias): Add args to match FSF function. + 2013-01-04 Stephen J. Turnbull <stephen(a)xemacs.org> * XEmacs 21.5.33 "horseradish" is released. diff --git a/lisp/obsolete.el b/lisp/obsolete.el --- a/lisp/obsolete.el +++ b/lisp/obsolete.el ＠＠ -36,12 +36,13 ＠＠ ;;; Code: -(defsubst define-obsolete-function-alias (oldfun newfun) +(defsubst define-obsolete-function-alias (oldfun newfun + &optional when docstring) "Define OLDFUN as an obsolete alias for function NEWFUN. This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN as obsolete." (define-function oldfun newfun) - (make-obsolete oldfun newfun)) + (make-obsolete oldfun newfun when)) (defsubst define-compatible-function-alias (oldfun newfun) "Define OLDFUN as a compatible alias for function NEWFUN. ＠＠ -50,7 +51,8 ＠＠ (define-function oldfun newfun) (make-compatible oldfun newfun)) -(defsubst define-obsolete-variable-alias (oldvar newvar) +(defsubst define-obsolete-variable-alias (oldvar newvar &optional when + docstring) "Define OLDVAR as an obsolete alias for variable NEWVAR. This makes referencing or setting OLDVAR equivalent to referencing or setting NEWVAR and marks OLDVAR as obsolete. ＠＠ -59,7 +61,7 ＠＠ Note: Use this before any other references (defvar/defcustom) to NEWVAR." (let ((needs-setting (and (boundp oldvar) (not (boundp newvar)))) (value (and (boundp oldvar) (symbol-value oldvar)))) - (defvaralias oldvar newvar) + (defvaralias oldvar newvar docstring) (make-obsolete-variable oldvar newvar) (and needs-setting (set newvar value)))) -- Jeff Sparkes jsparkes(a)gmail.com _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

3 participants
8 comments

commit/XEmacs: 2 new changesets 11 years, 10 months

Bitbucket

2 new commits in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/1fd684db4d45/ changeset: 1fd684db4d45 user: stephen_at_xemacs date: 2013-02-15 20:55:38 summary: Improve GNU-compatibility of define-*-alias. affected #: 2 files diff -r 1003acd5a4b8bab74e3a465de40cdd0ccab9589b -r 1fd684db4d4503d673304aadc0d0046e70d4a31f lisp/ChangeLog --- a/lisp/ChangeLog +++ b/lisp/ChangeLog ＠＠ -1,3 +1,16 ＠＠ +2013-02-16 Stephen J. Turnbull <stephen(a)xemacs.org> + + Thanks to Jeff Sparkes for the original patches and to Mike Sperber + for discussion. + + * obsolete.el (define-obsolete-function-alias): + (define-compatible-function-alias): + (define-obsolete-variable-alias): + (define-compatible-variable-alias): + Add optional WHEN and DOCSTRING arguments for GNU compatibility. + Document WHEN as ignored. Support DOCSTRING as well as the + underlying functions allow. + 2013-01-22 Jerry James <james(a)xemacs.org> * glyphs.el (make-image-specifier): Document that :visible is a diff -r 1003acd5a4b8bab74e3a465de40cdd0ccab9589b -r 1fd684db4d4503d673304aadc0d0046e70d4a31f lisp/obsolete.el --- a/lisp/obsolete.el +++ b/lisp/obsolete.el ＠＠ -36,38 +36,56 ＠＠ ;;; Code: -(defsubst define-obsolete-function-alias (oldfun newfun) +(defsubst define-obsolete-function-alias (oldfun newfun + &optional when docstring) "Define OLDFUN as an obsolete alias for function NEWFUN. This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN -as obsolete." +as obsolete. +Optional WHEN is for GNU compatibility. XEmacs ignores it. \(In Emacs, WHEN +is a string indicating the version where OLDFUN was first marked obsolete.) +Optional DOCSTRING describes any changes in semantics users should be aware of." (define-function oldfun newfun) - (make-obsolete oldfun newfun)) + (make-obsolete oldfun (or docstring newfun) when)) -(defsubst define-compatible-function-alias (oldfun newfun) +(defsubst define-compatible-function-alias (oldfun newfun + &optional when docstring) "Define OLDFUN as a compatible alias for function NEWFUN. This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN -as provided for compatibility only." +as provided for compatibility only. +Optional WHEN is for consistency with `define-obsolete-function-alias'. XEmacs +ignores it. \(If present, it is a string indicating the version where OLDFUN +was first marked as a compatibility API.) +Optional DOCSTRING describes any changes in semantics users should be aware of." (define-function oldfun newfun) - (make-compatible oldfun newfun)) + (make-compatible oldfun (or docstring newfun))) -(defsubst define-obsolete-variable-alias (oldvar newvar) +(defsubst define-obsolete-variable-alias (oldvar newvar + &optional when docstring) "Define OLDVAR as an obsolete alias for variable NEWVAR. This makes referencing or setting OLDVAR equivalent to referencing or setting NEWVAR and marks OLDVAR as obsolete. -If OLDVAR was bound and NEWVAR was not, Set NEWVAR to OLDVAR. +If OLDVAR was bound and NEWVAR was not, set NEWVAR to OLDVAR. +Note: Use this before any other references (defvar/defcustom) to NEWVAR. -Note: Use this before any other references (defvar/defcustom) to NEWVAR." +Optional WHEN is for GNU compatibility. XEmacs ignores it. \(In Emacs, WHEN +is a string indicating the version where OLDVAR was first marked obsolete.) +Optional DOCSTRING describes any changes in semantics users should be aware of." (let ((needs-setting (and (boundp oldvar) (not (boundp newvar)))) (value (and (boundp oldvar) (symbol-value oldvar)))) - (defvaralias oldvar newvar) - (make-obsolete-variable oldvar newvar) + (defvaralias oldvar newvar docstring) + (make-obsolete-variable oldvar newvar when) (and needs-setting (set newvar value)))) -(defsubst define-compatible-variable-alias (oldvar newvar) +(defsubst define-compatible-variable-alias (oldvar newvar + &optional when docstring) "Define OLDVAR as a compatible alias for variable NEWVAR. This makes referencing or setting OLDVAR equivalent to referencing or -setting NEWVAR and marks OLDVAR as provided for compatibility only." - (defvaralias oldvar newvar) +setting NEWVAR and marks OLDVAR as provided for compatibility only. +Optional WHEN is for consistency with `define-obsolete-variable-alias'. XEmacs +ignores it. \(If present, it is a string indicating the version where OLDFUN +was first marked as a compatibility API.) +Optional DOCSTRING describes any changes in semantics users should be aware of." + (defvaralias oldvar newvar docstring) (make-compatible-variable oldvar newvar)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; buffers https://bitbucket.org/xemacs/xemacs/commits/74172066fd6a/ changeset: 74172066fd6a user: stephen_at_xemacs date: 2013-02-16 13:52:55 summary: Improve log for last patch. affected #: 1 file diff -r 1fd684db4d4503d673304aadc0d0046e70d4a31f -r 74172066fd6aba10d3e5b167de76921daa661c33 lisp/ChangeLog --- a/lisp/ChangeLog +++ b/lisp/ChangeLog ＠＠ -1,7 +1,7 ＠＠ 2013-02-16 Stephen J. Turnbull <stephen(a)xemacs.org> - Thanks to Jeff Sparkes for the original patches and to Mike Sperber - for discussion. + Thanks to Jeff Sparkes for suggestion and the original patches and + to Mike Sperber for discussion. * obsolete.el (define-obsolete-function-alias): (define-compatible-function-alias): Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit/xemacs-packages: 4 new changesets 11 years, 10 months

Bitbucket

4 new commits in xemacs-packages: https://bitbucket.org/xemacs/xemacs-packages/commits/76603c872bd9/ changeset: 76603c872bd9 user: Norbert Koch date: 2013-02-08 08:50:36 summary: XEmacs Package Release affected #: 1 file diff -r 58211a8b2e04d38f50345b39737b759533ee8984 -r 76603c872bd9dfa747112e68ce8470a1afe0c519 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-02-08 Norbert Koch <viteno(a)xemacs.org> + + * Packages released: cc-mode, tramp. + 2013-01-27 Norbert Koch <viteno(a)xemacs.org> * Packages released: cc-mode, ediff, pcl-cvs, tramp. https://bitbucket.org/xemacs/xemacs-packages/commits/6e536e109c1c/ changeset: 6e536e109c1c user: Norbert Koch date: 2013-02-08 12:27:09 summary: Merge changes from cc-mode, tramp affected #: 1 file diff -r 76603c872bd9dfa747112e68ce8470a1afe0c519 -r 6e536e109c1cf0ed9a7538882b1d72afb42264e2 .hgsubstate --- a/.hgsubstate +++ b/.hgsubstate ＠＠ -11,13 +11,13 ＠＠ 849b8b229f520245da0641755272578cdb5b61a0 xemacs-packages/Sun c60c88c7637f7e265c3a8331ce0a5216a1598190 xemacs-packages/ada 954d6059bf11518b6314eb21d2cb8e16c17588ce xemacs-packages/apel -cadf5cb6ddce2b3d50f6cf326a9aae5b7b03bb76 xemacs-packages/auctex +8a0b4b79f4366f3b1cc79f1104651e3f4ca1505f xemacs-packages/auctex f9bdc83b52865b2df13c9166ebe5ba63195dd754 xemacs-packages/bbdb 48d1fe7ef06580f7b02cc9c60efd1c3d03286324 xemacs-packages/build da4e7d4a51c502e5ac05a224cb756f382f0ba4d7 xemacs-packages/c-support 11074b3808d1e349f3fddb3c4d50f8be7c0f859e xemacs-packages/calc 7524e4fb9de45d77812090a724fac4ebd7549d6e xemacs-packages/calendar -954d53682930bce3e4c3ef249c34985586b3c927 xemacs-packages/cc-mode +5a4793c22b77cafc1439d060f524eeb998d041c6 xemacs-packages/cc-mode a7ae1cfb2376bcd32617c1c88afe08872b11d298 xemacs-packages/cedet-common 87dd21fac17ea98219267b1378b4696698d6c4ff xemacs-packages/clearcase e18acdbfcd36295d052cd56fa2e6d78c68b4b7d4 xemacs-packages/cogre ＠＠ -114,7 +114,7 ＠＠ 497e37ee09551c8615a6b7f06cb91025815d10c3 xemacs-packages/tm c654835e16b425c0c23c0ee742549346333b0942 xemacs-packages/tooltalk e534e0dbe77a33527a3c5cb25f629a0cf10c5ccd xemacs-packages/tpu -ae237be31522a1c37a9ecaf8bde6179fb5e96ebe xemacs-packages/tramp +cabaca12e2a48246b3e33d2430de8c8c91f05429 xemacs-packages/tramp d144e4a87a6d666a221b9c6bc6fd8b4cb9dc5bc5 xemacs-packages/vc b2da4055175dbe90cda50d34d666fd4931dfa200 xemacs-packages/vc-cc c4dafa4f318d98b34f6e54e9424dc3f53767ece5 xemacs-packages/vhdl https://bitbucket.org/xemacs/xemacs-packages/commits/489d631abaa9/ changeset: 489d631abaa9 user: Norbert Koch date: 2013-02-08 12:28:14 summary: XEmacs Package Release affected #: 1 file diff -r 6e536e109c1cf0ed9a7538882b1d72afb42264e2 -r 489d631abaa954f0384751fbc1ca7e8b5291fc20 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-02-08 Norbert Koch <viteno(a)xemacs.org> + + * Packages released: cc-mode, tramp. + 2013-02-08 Norbert Koch <viteno(a)xemacs.org> * Packages released: cc-mode, tramp. https://bitbucket.org/xemacs/xemacs-packages/commits/413b4f427ac5/ changeset: 413b4f427ac5 user: Norbert Koch date: 2013-02-08 13:40:20 summary: Pre-release cc-mode tramp affected #: 1 file diff -r 489d631abaa954f0384751fbc1ca7e8b5291fc20 -r 413b4f427ac52ae573e6eb94de5837836d459c9e .hgsubstate --- a/.hgsubstate +++ b/.hgsubstate ＠＠ -17,7 +17,7 ＠＠ da4e7d4a51c502e5ac05a224cb756f382f0ba4d7 xemacs-packages/c-support 11074b3808d1e349f3fddb3c4d50f8be7c0f859e xemacs-packages/calc 7524e4fb9de45d77812090a724fac4ebd7549d6e xemacs-packages/calendar -5a4793c22b77cafc1439d060f524eeb998d041c6 xemacs-packages/cc-mode +b4501405b143d497cb09de252ad6916ae20e8cfe xemacs-packages/cc-mode a7ae1cfb2376bcd32617c1c88afe08872b11d298 xemacs-packages/cedet-common 87dd21fac17ea98219267b1378b4696698d6c4ff xemacs-packages/clearcase e18acdbfcd36295d052cd56fa2e6d78c68b4b7d4 xemacs-packages/cogre ＠＠ -114,7 +114,7 ＠＠ 497e37ee09551c8615a6b7f06cb91025815d10c3 xemacs-packages/tm c654835e16b425c0c23c0ee742549346333b0942 xemacs-packages/tooltalk e534e0dbe77a33527a3c5cb25f629a0cf10c5ccd xemacs-packages/tpu -cabaca12e2a48246b3e33d2430de8c8c91f05429 xemacs-packages/tramp +bf836625da53d6f8c34176e1dda9a506a829260f xemacs-packages/tramp d144e4a87a6d666a221b9c6bc6fd8b4cb9dc5bc5 xemacs-packages/vc b2da4055175dbe90cda50d34d666fd4931dfa200 xemacs-packages/vc-cc c4dafa4f318d98b34f6e54e9424dc3f53767ece5 xemacs-packages/vhdl Repository URL: https://bitbucket.org/xemacs/xemacs-packages/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit/tramp: 7 new changesets 11 years, 10 months

Bitbucket

7 new commits in tramp: https://bitbucket.org/xemacs/tramp/commits/203ff581a6ed/ changeset: 203ff581a6ed user: Norbert Koch date: 2013-02-08 08:50:35 summary: XEmacs Package Release 1.43 affected #: 2 files diff -r ae237be31522a1c37a9ecaf8bde6179fb5e96ebe -r 203ff581a6edd7e79849b1947fe46fc89425b126 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-02-08 Norbert Koch <viteno(a)xemacs.org> + + * Makefile (VERSION): XEmacs package 1.43 released. + 2013-01-27 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.41 released. diff -r ae237be31522a1c37a9ecaf8bde6179fb5e96ebe -r 203ff581a6edd7e79849b1947fe46fc89425b126 Makefile --- a/Makefile +++ b/Makefile ＠＠ -17,7 +17,7 ＠＠ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. -VERSION = 1.41 +VERSION = 1.43 AUTHOR_VERSION = 2.2.7-pre MAINTAINER = Michael Albinus <michael.albinus(a)gmx.de> PACKAGE = tramp https://bitbucket.org/xemacs/tramp/commits/d41b477e98dd/ changeset: d41b477e98dd user: Norbert Koch date: 2013-02-08 08:50:35 summary: Added tag tramp-1_43 for changeset 203ff581a6ed affected #: 1 file diff -r 203ff581a6edd7e79849b1947fe46fc89425b126 -r d41b477e98dd1ebd2efe2645c7a921e5e78f2b6d .hgtags --- a/.hgtags +++ b/.hgtags ＠＠ -74,3 +74,4 ＠＠ 3649d19b9dd5377933671478e774c6b9d9b2bb91 tramp-1_19 8c1f99d0ac238bf8c0ef83d4bae80649cfa8bbfc sumo-2007-04-27 d799683afe56649f2c6ed51a91cfe7243d1380b7 tramp-1_41 +203ff581a6edd7e79849b1947fe46fc89425b126 tramp-1_43 https://bitbucket.org/xemacs/tramp/commits/cbc9324f2085/ changeset: cbc9324f2085 user: Norbert Koch date: 2013-02-08 08:51:51 summary: XEmacs Package Release 1.43 affected #: 1 file diff -r d41b477e98dd1ebd2efe2645c7a921e5e78f2b6d -r cbc9324f20859c6c04d3d03327aa1463f037cffd ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-02-08 Norbert Koch <viteno(a)xemacs.org> + + * Makefile (VERSION): XEmacs package 1.43 released. + 2013-02-08 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.43 released. https://bitbucket.org/xemacs/tramp/commits/f4b246669827/ changeset: f4b246669827 user: Norbert Koch date: 2013-02-08 12:22:36 summary: XEmacs Package Release 1.43 affected #: 1 file diff -r cbc9324f20859c6c04d3d03327aa1463f037cffd -r f4b2466698271bdc6bc86fca6e80a8570a1b3d12 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-02-08 Norbert Koch <viteno(a)xemacs.org> + + * Makefile (VERSION): XEmacs package 1.43 released. + 2013-02-08 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.43 released. https://bitbucket.org/xemacs/tramp/commits/cabaca12e2a4/ changeset: cabaca12e2a4 user: Norbert Koch date: 2013-02-08 12:27:09 summary: Merge changes from cc-mode, tramp affected #: 8 files Diff not available. https://bitbucket.org/xemacs/tramp/commits/78503cdb7c6a/ changeset: 78503cdb7c6a user: Norbert Koch date: 2013-02-08 12:28:14 summary: XEmacs Package Release 1.44 affected #: 2 files Diff not available. https://bitbucket.org/xemacs/tramp/commits/bf836625da53/ changeset: bf836625da53 user: Norbert Koch date: 2013-02-08 12:28:14 summary: Added tag tramp-1_44 for changeset 78503cdb7c6a affected #: 1 file Diff not available. Repository URL: https://bitbucket.org/xemacs/tramp/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit/cc-mode: 8 new changesets 11 years, 10 months

Bitbucket

8 new commits in cc-mode: https://bitbucket.org/xemacs/cc-mode/commits/193c0f9dbfba/ changeset: 193c0f9dbfba user: Norbert Koch date: 2013-02-08 08:50:35 summary: XEmacs Package Release 1.62 affected #: 2 files diff -r 954d53682930bce3e4c3ef249c34985586b3c927 -r 193c0f9dbfbac71e083f2974efc724a82d1106c5 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-02-08 Norbert Koch <viteno(a)xemacs.org> + + * Makefile (VERSION): XEmacs package 1.62 released. + 2013-01-27 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.60 released. diff -r 954d53682930bce3e4c3ef249c34985586b3c927 -r 193c0f9dbfbac71e083f2974efc724a82d1106c5 Makefile --- a/Makefile +++ b/Makefile ＠＠ -17,7 +17,7 ＠＠ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. -VERSION = 1.60 +VERSION = 1.62 AUTHOR_VERSION = 5.32.2 MAINTAINER = Alan Mackenzie <bug-cc-mode(a)gnu.org> PACKAGE = cc-mode https://bitbucket.org/xemacs/cc-mode/commits/7dfd489f5f8c/ changeset: 7dfd489f5f8c user: Norbert Koch date: 2013-02-08 08:50:35 summary: Added tag cc-mode-1_62 for changeset 193c0f9dbfba affected #: 1 file diff -r 193c0f9dbfbac71e083f2974efc724a82d1106c5 -r 7dfd489f5f8c23b49d4d35cbb58081b02ba20d38 .hgtags --- a/.hgtags +++ b/.hgtags ＠＠ -93,3 +93,4 ＠＠ 46f8e9f7f8174bdf529daf1577892b212c566d5b cc-mode-1_58 c325532f7d0bbf9c4cae63da83d12abf2033c6b5 cc-mode-1_59 84035315a6ee61c74a5ebd43dab790318c1cc9a3 cc-mode-1_60 +193c0f9dbfbac71e083f2974efc724a82d1106c5 cc-mode-1_62 https://bitbucket.org/xemacs/cc-mode/commits/9626bd82499a/ changeset: 9626bd82499a user: Norbert Koch date: 2013-02-08 08:51:51 summary: XEmacs Package Release 1.62 affected #: 1 file diff -r 7dfd489f5f8c23b49d4d35cbb58081b02ba20d38 -r 9626bd82499a0dcaf8d125ef8446dafc0ad2df91 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-02-08 Norbert Koch <viteno(a)xemacs.org> + + * Makefile (VERSION): XEmacs package 1.62 released. + 2013-02-08 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.62 released. https://bitbucket.org/xemacs/cc-mode/commits/6ca6fb427b9b/ changeset: 6ca6fb427b9b user: Norbert Koch date: 2013-02-08 12:22:32 summary: XEmacs Package Release 1.62 affected #: 1 file diff -r 9626bd82499a0dcaf8d125ef8446dafc0ad2df91 -r 6ca6fb427b9b80610f50256f339f6035d60c8bc4 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-02-08 Norbert Koch <viteno(a)xemacs.org> + + * Makefile (VERSION): XEmacs package 1.62 released. + 2013-02-08 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 1.62 released. https://bitbucket.org/xemacs/cc-mode/commits/bee813d9c0dd/ changeset: bee813d9c0dd user: Norbert Koch date: 2013-02-08 12:23:19 summary: XEmacs Package Release 1.62 affected #: 1 file Diff not available. https://bitbucket.org/xemacs/cc-mode/commits/5a4793c22b77/ changeset: 5a4793c22b77 user: Norbert Koch date: 2013-02-08 12:27:09 summary: Merge changes from cc-mode, tramp affected #: 2 files Diff not available. https://bitbucket.org/xemacs/cc-mode/commits/b855e452c239/ changeset: b855e452c239 user: Norbert Koch date: 2013-02-08 12:28:09 summary: XEmacs Package Release 1.63 affected #: 2 files Diff not available. https://bitbucket.org/xemacs/cc-mode/commits/b4501405b143/ changeset: b4501405b143 user: Norbert Koch date: 2013-02-08 12:28:09 summary: Added tag cc-mode-1_63 for changeset b855e452c239 affected #: 1 file Diff not available. Repository URL: https://bitbucket.org/xemacs/cc-mode/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit/auctex: Norbert Koch: Merge changes from cc-mode, tramp 11 years, 10 months

Bitbucket

1 new commit in auctex: https://bitbucket.org/xemacs/auctex/commits/8a0b4b79f436/ changeset: 8a0b4b79f436 user: Norbert Koch date: 2013-02-08 12:27:09 summary: Merge changes from cc-mode, tramp affected #: 1 file diff -r cadf5cb6ddce2b3d50f6cf326a9aae5b7b03bb76 -r 8a0b4b79f4366f3b1cc79f1104651e3f4ca1505f README --- a/README +++ b/README ＠＠ -68,22 +68,23 ＠＠ join. If you are only interested in information on updates, you could refer to the newsgroups `comp.text.tex' and `gnu.emacs.sources'. -Bug reports on AUCTeX may be sent to <bug-auctex(a)gnu.org>. To join + Bug reports on AUCTeX may be sent to <bug-auctex(a)gnu.org>. To join the list send mail to <bug-auctex-subscribe(a)gnu.org>. -The AUCTeX maintainers can be reached at <auctex-devel(a)gnu.org>. -Subscription requests should be sent to <auctex-devel-subscribe(a)gnu.org>. + The AUCTeX maintainers can be reached at <auctex-devel(a)gnu.org>. +Subscription requests should be sent to +<auctex-devel-subscribe(a)gnu.org>. -XEmacs and AUCTeX ------------------ +1.2.1 XEmacs and AUCTeX +----------------------- Note that the XEmacs package version currently lags the upstream -version substantionally. If you are missing features or there seems -to be a bug in features related to editing documents, you are probably +version substantionally. If you are missing features or there seems to +be a bug in features related to editing documents, you are probably best advised to remove the XEmacs package and install the upstream version before contacting the AUCTeX maintainers. -If you are having trouble installing the XEmacs package, or wish to + If you are having trouble installing the XEmacs package, or wish to help in updating the package version to the current upstream version, then <xemacs-beta(a)xemacs.org> is the appropriate channel. Repository URL: https://bitbucket.org/xemacs/auctex/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit/XEmacs: Vin Shelton: Fix cygwin build on new win32api. 11 years, 10 months

Bitbucket

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/1003acd5a4b8/ changeset: 1003acd5a4b8 user: Vin Shelton date: 2013-02-05 02:03:04 summary: Fix cygwin build on new win32api. affected #: 2 files diff -r 68f8d295be49fb1f37b708c368bb1b2b06dd75c9 -r 1003acd5a4b8bab74e3a465de40cdd0ccab9589b src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,8 ＠＠ +2013-02-04 Vin Shelton <acs(a)xemacs.org> + + * syswindows.h: Fix the cygwin build by supporting win32api 3.14 + through appropriate guard macros. Thanks to Mats Lidell. + 2013-01-22 Jerry James <james(a)xemacs.org> * general-slots.h: Add Q_visible. diff -r 68f8d295be49fb1f37b708c368bb1b2b06dd75c9 -r 1003acd5a4b8bab74e3a465de40cdd0ccab9589b src/syswindows.h --- a/src/syswindows.h +++ b/src/syswindows.h ＠＠ -443,6 +443,7 ＠＠ #endif /* not NMCBEDRAGBEGIN */ +#if W32API_INSTALLED_VER < W32API_VER(3,14) typedef struct tagNMDATETIMEFORMATA { NMHDR nmhdr; ＠＠ -460,6 +461,7 ＠＠ LPCWSTR pszDisplay; WCHAR szDisplay[64]; } NMDATETIMEFORMATW, FAR * LPNMDATETIMEFORMATW; +#endif #if W32API_INSTALLED_VER < W32API_VER(2,2) ＠＠ -555,6 +557,7 ＠＠ #define OIC_WINLOGO 32517 #endif +#if W32API_INSTALLED_VER < W32API_VER(3,14) /* More Cygwin stupidity: Current w32api's winuser.h has IME message constants and they conflict with imm.h. (NOTE: Currently fixed, but I'm sure the problems were present post 1.0.) */ ＠＠ -570,6 +573,7 ＠＠ #undef WM_IME_CHAR #undef WM_IME_KEYDOWN #undef WM_IME_KEYUP +#endif #include <imm.h> ＠＠ -585,6 +589,10 ＠＠ typedef LPCDLGTEMPLATE LPCDLGTEMPLATEW; typedef LPCDLGTEMPLATE LPCDLGTEMPLATEA; +#if W32API_VER(3,14) <= W32API_INSTALLED_VER +typedef LPCVOID PCVOID; +#endif + #else /* !CYGWIN_HEADERS */ #define W32API_VER(major,minor) 0 Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit/tramp: albinus: * tramp.el (tramp-debug-message): Extend function exclude list. 11 years, 10 months

Bitbucket

1 new commit in tramp: https://bitbucket.org/xemacs/tramp/commits/f6a8f3f45e75/ changeset: f6a8f3f45e75 user: albinus date: 2013-02-03 17:53:09 summary: * tramp.el (tramp-debug-message): Extend function exclude list. (tramp-backtrace): New defun. (tramp-handle-insert-file-contents): Use `visit' when inserting the local copy. * tramp-sh.el (tramp-sh-handle-set-visited-file-modtime): Use `remote-file-name-inhibit-cache'. * tramp.el (tramp-check-for-regexp): Avoid "Args out of range" error when buffer in question is narrowed so position 1 is out of visible part. affected #: 3 files diff -r 8342bcc6852d808c2fb817fbad320ffbbb19d7c7 -r f6a8f3f45e759caed6680d549c6c0e89a57b11cf lisp/ChangeLog --- a/lisp/ChangeLog +++ b/lisp/ChangeLog ＠＠ -1,3 +1,19 ＠＠ +2013-02-03 Michael Albinus <michael.albinus(a)gmx.de> + + * tramp.el (tramp-debug-message): Extend function exclude list. + (tramp-backtrace): New defun. + (tramp-handle-insert-file-contents): Use `visit' when inserting + the local copy. + + * tramp-sh.el (tramp-sh-handle-set-visited-file-modtime): Use + `remote-file-name-inhibit-cache'. + +2013-02-01 Andrew W. Nosenko <andrew.w.nosenko(a)gmail.com> (tiny change) + + * tramp.el (tramp-check-for-regexp): Avoid "Args out of range" + error when buffer in question is narrowed so position 1 is out of + visible part. + 2013-01-30 Michael Albinus <michael.albinus(a)gmx.de> * tramp.el (tramp-tramp-file-p): Comment check for diff -r 8342bcc6852d808c2fb817fbad320ffbbb19d7c7 -r f6a8f3f45e759caed6680d549c6c0e89a57b11cf lisp/tramp-sh.el --- a/lisp/tramp-sh.el +++ b/lisp/tramp-sh.el ＠＠ -1331,7 +1331,8 ＠＠ (let ((f (buffer-file-name)) coding-system-used) (with-parsed-tramp-file-name f nil - (let* ((attr (file-attributes f)) + (let* ((remote-file-name-inhibit-cache t) + (attr (file-attributes f)) ;; '(-1 65535) means file doesn't exists yet. (modtime (or (nth 5 attr) '(-1 65535)))) (when (boundp 'last-coding-system-used) diff -r 8342bcc6852d808c2fb817fbad320ffbbb19d7c7 -r f6a8f3f45e759caed6680d549c6c0e89a57b11cf lisp/tramp.el --- a/lisp/tramp.el +++ b/lisp/tramp.el ＠＠ -1391,7 +1391,9 ＠＠ (concat "^" (regexp-opt - '("tramp-compat-funcall" + '("tramp-backtrace" + "tramp-compat-condition-case-unless-debug" + "tramp-compat-funcall" "tramp-compat-with-temp-message" "tramp-debug-message" "tramp-error" ＠＠ -1505,6 +1507,11 ＠＠ "`M-x tramp-cleanup-this-connection'")) (sit-for 30)))))) +(defsubst tramp-backtrace (vec-or-proc) + "Dump a backtrace into the debug buffer. +This function is meant for debugging purposes." + (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))) + (defmacro with-parsed-tramp-file-name (filename var &rest body) "Parse a Tramp filename and make components available in the body. ＠＠ -3023,13 +3030,15 ＠＠ (setq tramp-temp-buffer-file-name local-copy)) ;; We must ensure that `file-coding-system-alist' - ;; matches `local-copy'. + ;; matches `local-copy'. We must also use `visit', + ;; otherwise there might be an error in the + ;; `revert-buffer' function under XEmacs. (let ((file-coding-system-alist (tramp-find-file-name-coding-system-alist filename local-copy))) (setq result (insert-file-contents - local-copy nil nil nil replace))))) + local-copy visit nil nil replace))))) ;; Save exit. (progn ＠＠ -3413,7 +3422,9 ＠＠ 0 (min tramp-echo-mark-marker-length (1- (point-max)))) (tramp-compat-funcall 'buffer-substring-no-properties - 1 (min (1+ tramp-echo-mark-marker-length) (point-max)))))) + (point-min) + (min (+ (point-min) tramp-echo-mark-marker-length) + (point-max)))))) ;; No echo to be handled, now we can look for the regexp. ;; Sometimes, lines are much to long, and we run into a "Stack ;; overflow in regexp matcher". For example, //DIRED// lines of Repository URL: https://bitbucket.org/xemacs/tramp/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches February 2013