Paredit stuff

setup-paredit.el

;;; -*- lexical-binding: t -*-

(defun usr:match-pattern-backwards (pattern)
  ;;; XXX: Check if we hit (point-min)?
  (cond ((integerp pattern)
         (when (char-equal (char-before) pattern)
           (backward-char)
           t))
        ((and (consp pattern)
              (keywordp (car pattern)))
         (cl-ecase (car pattern)
           (:or
            (catch 'some
              (dolist (pattern (cdr pattern))
                (when (usr:match-pattern-backwards pattern)
                  (throw 'some t)))
              nil))
           (:range
            (cl-destructuring-bind (start end)
                (cdr pattern)
              (when (<= start (char-before) end)
                (backward-char)
                t)))
           (:repeat
            (cl-destructuring-bind (min max pattern)
                (cdr pattern)
              (unless (or (null max)
                          (< min max))
                (error "Invalid range: [%s, %s]" min max))
              (dotimes (_ min)
                (unless (usr:match-pattern-backwards pattern)
                  (throw 'done nil)))
              (while (and (or (null max)
                              (< min max))
                          (usr:match-pattern-backwards pattern))
                (cl-incf min))
              t))))
        (t
         (error "Invalid pattern: %s" pattern))))

;;; XXX: Not sure this is faster than the slowness mentioned in
;;; `looking-back`.  But at least we're doing the right thing.
(defun usr:%looking-back-at-p (patterns)
  (unless (vectorp patterns)
    (error "Expected PATTERNS to be a vector, got %s" patterns))
  (let ((i (length patterns)))
    (catch 'done
      (while (< 0 i)
        (cl-decf i)
        (unless (usr:match-pattern-backwards (aref patterns i))
          (throw 'done nil)))
      t)))

;;; TODO: Generate a matcher at compile time.
(defmacro usr:looking-back-at-p (pattern)
  `(save-excursion
     (usr:%looking-back-at-p ,pattern)))

(defun paredit-space-for-delimiter-predicate-common-lisp (endp delimiter)
  (defvar case-fold-search)
  (or endp
      (let ((case-fold-search t))
        (cond ((eq (char-syntax delimiter) ?\()
               ;; XXX: Need to implement backtracking for this to
               ;; work...
               ;;
               ;; (not (usr:looking-back-at-p
               ;;       '(:or [?# (:or ?+ ?- ?. ?C)]
               ;;             [?# (:repeat 0 nil (:range ?0 ?9)) ?A]
               ;;             [?, ?@])))
               (and (not (usr:looking-back-at-p [?# (:or ?+ ?- ?. ?C)]))
                    (not (usr:looking-back-at-p [?# (:repeat 0 nil (:range ?0 ?9)) ?A]))
                    (not (usr:looking-back-at-p [?, ?@]))))
              ((eq (char-syntax delimiter) ?\")
               (not (usr:looking-back-at-p [?# ?P])))
              (t)))))

(defun common-lisp-mode-hook-paredit ()
  (make-local-variable 'paredit-space-for-delimiter-predicates)
  (add-to-list 'paredit-space-for-delimiter-predicates
               'paredit-space-for-delimiter-predicate-common-lisp))

(provide 'setup-paredit)