Function: rx--generate-alt

rx--generate-alt is a byte-compiled function defined in rx.el.gz.

Signature

(rx--generate-alt NEGATED INTERVALS CLASSES)

Documentation

Generate a character alternative. Return (REGEXP . PRECEDENCE).

If NEGATED is non-nil, negate the result; INTERVALS is a sorted list of disjoint intervals and CLASSES a list of named character classes.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/rx.el.gz
(defun rx--generate-alt (negated intervals classes)
  "Generate a character alternative.  Return (REGEXP . PRECEDENCE).
If NEGATED is non-nil, negate the result; INTERVALS is a sorted
list of disjoint intervals and CLASSES a list of named character
classes."
  (let ((items (append intervals classes)))
    ;; Move lone ] and range ]-x to the start.
    (let ((rbrac-l (assq ?\] items)))
      (when rbrac-l
        (setq items (cons rbrac-l (delq rbrac-l items)))))

    ;; Split x-] and move the lone ] to the start.
    (let ((rbrac-r (rassq ?\] items)))
      (when (and rbrac-r (not (eq (car rbrac-r) ?\])))
        (setcdr rbrac-r ?\\)
        (setq items (cons '(?\] . ?\]) items))))

    ;; Split ,-- (which would end up as ,- otherwise).
    (let ((dash-r (rassq ?- items)))
      (when (eq (car dash-r) ?,)
        (setcdr dash-r ?,)
        (setq items (nconc items '((?- . ?-))))))

    ;; Remove - (lone or at start of interval)
    (let ((dash-l (assq ?- items)))
      (when dash-l
        (if (eq (cdr dash-l) ?-)
            (setq items (delq dash-l items))   ; Remove lone -
          (setcar dash-l ?.))                  ; Reduce --x to .-x
        (setq items (nconc items '((?- . ?-))))))

    ;; Deal with leading ^ and range ^-x.
    (when (and (consp (car items))
               (eq (caar items) ?^)
               (cdr items))
      ;; Move ^ and ^-x to second place.
      (setq items (cons (cadr items)
                        (cons (car items) (cddr items)))))

    (cond
     ;; Empty set: if negated, any char, otherwise match-nothing.
     ((null items)
      (if negated
          (rx--translate-symbol 'anything)
        (rx--empty)))
     ;; Single non-negated character.
     ((and (null (cdr items))
           (consp (car items))
           (eq (caar items) (cdar items))
           (not negated))
      (cons (list (regexp-quote (char-to-string (caar items))))
            t))
     ;; Negated newline.
     ((and (equal items '((?\n . ?\n)))
           negated)
      (rx--translate-symbol 'nonl))
     ;; At least one character or class, possibly negated.
     (t
      (cons
       (list
        (concat
         "["
         (and negated "^")
         (mapconcat (lambda (item)
                      (cond ((symbolp item)
                             (format "[:%s:]" item))
                            ((eq (car item) (cdr item))
                             (char-to-string (car item)))
                            ((eq (1+ (car item)) (cdr item))
                             (string (car item) (cdr item)))
                            (t
                             (string (car item) ?- (cdr item)))))
                    items nil)
         "]"))
       t)))))