良きに計らってリージョン選択してくれるコマンド(書き途中)

id:k1LoWさんと居酒屋で、 連打すると良きに計らってリージョン選択してくれるコマンドがあると便利ですよね。
という話をしたので考えてみました。

書きかけ版です。
関数名とか適当です。

(defun auto-region-paren (&optional forward-char)
  (ignore-errors
    (save-excursion
      (when forward-char
        (backward-char))
      (when (re-search-backward (rx (syntax open-parenthesis)) nil t)
        (let ((point-min (point)))
          (forward-sexp)
        `(,point-min . (,point-min ,(point))))))))

(defun auto-region-string ()
  (save-excursion
    (when (nth 3 (parse-partial-sexp (point-min) (point)))
      (let ((point-min (save-excursion
                         (when (re-search-backward (rx (syntax string-quote)) nil t)
                           (point))))
            (point-max (when (re-search-forward (rx (syntax string-quote)) nil t)
                         (point))))
        (and point-min
             point-max
             `(,point-min . (,point-min ,point-max)))))))

(defun auto-region-comment ()
  (save-excursion
    (when (nth 4 (parse-partial-sexp (point-min) (point)))
      (let ((point-min (save-excursion
                         (when (re-search-backward (rx (syntax comment-start)) nil t)
                           (point))))
            (point-max (when (re-search-forward (rx (syntax comment-end)) nil t)
                         (point))))
        (and point-min
             point-max
             `(,point-min . (,point-min ,point-max)))))))

(defun auto-region-comment1 ()
  (save-excursion
    (let ((parse-data (parse-partial-sexp (point-min) (point))))
      (when (nth 4 parse-data)
        (let ((point-min (progn (goto-char (nth 8 parse-data))
                                (nth 8 parse-data)))
              (point-max (progn (forward-comment (buffer-size))
                                (point))))
          (and point-min
               point-max
             `(,point-min . (,point-min ,point-max))))))))


(defun auto-region-alist ()
  (list
   (auto-region-paren)
   (auto-region-string)
   (auto-region-comment)
   (auto-region-comment1)
   ))

(defun auto-region-min-positions ()
  (let* ((alist (auto-region-alist))
         (points (loop for ls in alist
                       when ls
                       collect (car ls)))
         (max (apply 'max points)))
    (assoc-default max alist)))


(defvar auto-region-last-positions nil) ; (point-min point-max)
(defun auto-region ()
  (interactive)
  (unless (eq real-last-command this-command)
    (setq auto-region-last-position nil))

  (let* ((positions (auto-region-min-positions))
         (point-min (car positions))
         (point-max (cadr positions)))
    (set-mark point-max)
    (goto-char point-min)

    (setq auto-region-last-position positions)))