-(defun prolog-set-atom-regexps ()
- "Set the `prolog-atom-char-regexp' and `prolog-atom-regexp' variables.
-Must be called after `prolog-build-case-strings'."
- (setq prolog-atom-char-regexp
- (format "[%s%s0-9_$]"
- ;; FIXME: why not a-zA-Z?
- prolog-lower-case-string
- prolog-upper-case-string))
- (setq prolog-atom-regexp
- (format "[%s$]%s*"
- prolog-lower-case-string
- prolog-atom-char-regexp))
- )
-
-(defun prolog-build-case-strings ()
- "Set `prolog-upper-case-string' and `prolog-lower-case-string'.
-Uses the current case-table for extracting the relevant information."
- (let ((up_string "")
- (low_string ""))
- ;; Use `map-char-table' if it is defined. Otherwise enumerate all
- ;; numbers between 0 and 255. `map-char-table' is probably safer.
- ;;
- ;; `map-char-table' causes problems under Emacs 23.0.0.1, the
- ;; while loop seems to do its job well (Ryszard Szopa)
- ;;
- ;;(if (and (not (featurep 'xemacs))
- ;; (fboundp 'map-char-table))
- ;; (map-char-table
- ;; (lambda (key value)
- ;; (cond
- ;; ((and
- ;; (eq (prolog-int-to-char key) (downcase key))
- ;; (eq (prolog-int-to-char key) (upcase key)))
- ;; ;; Do nothing if upper and lower case are the same
- ;; )
- ;; ((eq (prolog-int-to-char key) (downcase key))
- ;; ;; The char is lower case
- ;; (setq low_string (format "%s%c" low_string key)))
- ;; ((eq (prolog-int-to-char key) (upcase key))
- ;; ;; The char is upper case
- ;; (setq up_string (format "%s%c" up_string key)))
- ;; ))
- ;; (current-case-table))
- ;; `map-char-table' was undefined.
- (let ((key 0))
- (while (< key 256)
- (cond
- ((and
- (eq (prolog-int-to-char key) (downcase key))
- (eq (prolog-int-to-char key) (upcase key)))
- ;; Do nothing if upper and lower case are the same
- )
- ((eq (prolog-int-to-char key) (downcase key))
- ;; The char is lower case
- (setq low_string (format "%s%c" low_string key)))
- ((eq (prolog-int-to-char key) (upcase key))
- ;; The char is upper case
- (setq up_string (format "%s%c" up_string key)))
- )
- (setq key (1+ key))))
- ;; )
- ;; The strings are single-byte strings
- (setq prolog-upper-case-string (prolog-dash-letters up_string))
- (setq prolog-lower-case-string (prolog-dash-letters low_string))
- ))
-
-;(defun prolog-regexp-dash-continuous-chars (chars)
-; (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
-; (beg 0)
-; (end 0))
-; (if (null ints)
-; chars
-; (while (and (< (+ beg 1) (length chars))
-; (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
-; (= (nth beg ints) (nth (+ beg 1) ints)))))
-; (setq beg (+ beg 1)))
-; (setq beg (+ beg 1)
-; end beg)
-; (while (and (< (+ end 1) (length chars))
-; (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
-; (= (nth end ints) (nth (+ end 1) ints))))
-; (setq end (+ end 1)))
-; (if (equal (substring chars end) "")
-; (substring chars 0 beg)
-; (concat (substring chars 0 beg) "-"
-; (prolog-regexp-dash-continuous-chars (substring chars end))))
-; )))
-
-(defun prolog-ints-intervals (ints)
- "Return a list of intervals (from . to) covering INTS."
- (when ints
- (setq ints (sort ints '<))
- (let ((prev (car ints))
- (interval-start (car ints))
- intervals)
- (while ints
- (let ((next (car ints)))
- (when (> next (1+ prev)) ; start of new interval
- (setq intervals (cons (cons interval-start prev) intervals))
- (setq interval-start next))
- (setq prev next)
- (setq ints (cdr ints))))
- (setq intervals (cons (cons interval-start prev) intervals))
- (reverse intervals))))
-
-(defun prolog-dash-letters (string)
- "Return a condensed regexp covering all letters in STRING."
- (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
- (string-to-list string))))
- codes)
- (while intervals
- (let* ((i (car intervals))
- (from (car i))
- (to (cdr i))
- (c (cond ((= from to) `(,from))
- ((= (1+ from) to) `(,from ,to))
- (t `(,from ?- ,to)))))
- (setq codes (cons c codes)))
- (setq intervals (cdr intervals)))
- (apply 'concat (reverse codes))))
-
-;(defun prolog-condense-character-sets (regexp)
-; "Condense adjacent characters in character sets of REGEXP."
-; (let ((next -1))
-; (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
-; (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
-; t t regexp 1))))
-; regexp)
-
-;; GNU Emacs compatibility: GNU Emacs does not differentiate between
-;; ints and chars, or at least these two are interchangeable.
-(defalias 'prolog-int-to-char
- (if (fboundp 'int-to-char) #'int-to-char #'identity))
-
-(defalias 'prolog-char-to-int
- (if (fboundp 'char-to-int) #'char-to-int #'identity))
-\f