<commit_before>(in-package :lem)

(export '(command-completion
          define-command
          exist-command-p
          execute-command
          apropos-command))

(defvar *command-table* (make-hash-table :test 'equal))

(eval-when (:compile-toplevel :load-toplevel)
  (defun collect-variables (parameters)
    (let ((acc))
      (dolist (parm parameters)
        (cond ((consp parm)
               (when (symbolp (car parm))
                 (push (car parm) acc)))
              ((not (char= #\& (schar (symbol-name parm) 0)))
               (push parm acc))))
      (nreverse acc)))
  (let ((garg (gensym "ARG")))
    (defun define-command-gen-args (name arg-descripters)
      (declare (ignorable name))
      (cond
       ((string= "p" (car arg-descripters))
        `(list (or ,garg 1)))
       ((string= "P" (car arg-descripters))
        `(list ,garg))
       ((string= "r" (car arg-descripters))
        `(progn
           (check-marked)
           (list (region-beginning) (region-end))))
       (t
        (cons 'list
              (mapcar #'(lambda (arg-descripter)
                          (cond
                           ((char= #\s (aref arg-descripter 0))
                            `(minibuf-read-string ,(subseq arg-descripter 1)))
                           ((char= #\n (aref arg-descripter 0))
                            `(minibuf-read-number ,(subseq arg-descripter 1)))
                           ((char= #\b (aref arg-descripter 0))
                            `(minibuf-read-buffer ,(subseq arg-descripter 1)
                                                  (buffer-name (current-buffer))
                                                  t))
                           ((char= #\B (aref arg-descripter 0))
                            `(minibuf-read-buffer ,(subseq arg-descripter 1)
                                                  (buffer-name (other-buffer))
                                                  nil))
                           ((char= #\f (aref arg-descripter 0))
                            `(minibuf-read-file
                              ,(subseq arg-descripter 1)
                              (buffer-directory)
                              nil
                              t))
                           ((char= #\F (aref arg-descripter 0))
                            `(minibuf-read-file
                              ,(subseq arg-descripter 1)
                              (buffer-directory)
                              nil
                              nil))
                           (t
                            (error "Illegal arg-descripter: ~a" arg-descripter))))
                      arg-descripters)))))
    (defun define-command-gen-cmd (cmd-name fn-name parms arg-descripters)
      `(defun ,cmd-name (,garg)
         (declare (ignorable ,garg))
         ,(if (null arg-descripters)
              (progn
                (assert (null parms))
                `(,fn-name))
              `(destructuring-bind ,parms
                   ,(if (stringp (car arg-descripters))
                        (define-command-gen-args cmd-name arg-descripters)
                        (car arg-descripters))
                 (,fn-name ,@(collect-variables parms))))))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun function-to-command-name (f)
    (check-type f symbol)
    (string-downcase f)))

(defun find-command (name)
  (gethash name *command-table*))

(defun function-to-command (f)
  (find-command (function-to-command-name f)))

(defun command-name (command)
  (get command 'name))

(defmacro define-command (name parms (&rest arg-descripters) &body body)
  (let ((gcmd (gensym (symbol-name name))))
    `(progn
       (setf (get ',gcmd 'name) (string-downcase ',name))
       (setf (gethash ,(function-to-command-name name)
                      *command-table*)
             ',gcmd)
       (defun ,name ,parms ,@body)
       ,(define-command-gen-cmd gcmd name parms arg-descripters))))

(defun cmd-call (cmd arg)
  (run-hooks 'pre-command-hook)         ;!!!
  (prog1 (funcall cmd arg)
    (buffer-undo-boundary)              ;!!!
    (run-hooks 'post-command-hook)      ;!!!
    ))

(defun command-completion (str)
  (let ((names))
    (maphash #'(lambda (name cmd)
                 (declare (ignore cmd))
                 (push name names))
             *command-table*)
    (completion str (nreverse names))))

(defun exist-command-p (str)
  (if (find-command str) t nil))

(define-key *global-keymap* (kbd "M-x") 'execute-command)
(define-command execute-command (name)
  ((list (minibuf-read-line
          "M-x "
          ""
          'command-completion
          'exist-command-p)))
  (let ((cmd (gethash name *command-table*)))
    (if cmd
        (funcall cmd *universal-argument*)
        (message "invalid command"))))

(define-command apropos-command (str) ("sApropos: ")<commit_msg>execute-commandの修正<commit_after>(in-package :lem)

(export '(command-completion
          define-command
          exist-command-p
          execute-command
          apropos-command))

(defvar *command-table* (make-hash-table :test 'equal))

(eval-when (:compile-toplevel :load-toplevel)
  (defun collect-variables (parameters)
    (let ((acc))
      (dolist (parm parameters)
        (cond ((consp parm)
               (when (symbolp (car parm))
                 (push (car parm) acc)))
              ((not (char= #\& (schar (symbol-name parm) 0)))
               (push parm acc))))
      (nreverse acc)))
  (let ((garg (gensym "ARG")))
    (defun define-command-gen-args (name arg-descripters)
      (declare (ignorable name))
      (cond
       ((string= "p" (car arg-descripters))
        `(list (or ,garg 1)))
       ((string= "P" (car arg-descripters))
        `(list ,garg))
       ((string= "r" (car arg-descripters))
        `(progn
           (check-marked)
           (list (region-beginning) (region-end))))
       (t
        (cons 'list
              (mapcar #'(lambda (arg-descripter)
                          (cond
                           ((char= #\s (aref arg-descripter 0))
                            `(minibuf-read-string ,(subseq arg-descripter 1)))
                           ((char= #\n (aref arg-descripter 0))
                            `(minibuf-read-number ,(subseq arg-descripter 1)))
                           ((char= #\b (aref arg-descripter 0))
                            `(minibuf-read-buffer ,(subseq arg-descripter 1)
                                                  (buffer-name (current-buffer))
                                                  t))
                           ((char= #\B (aref arg-descripter 0))
                            `(minibuf-read-buffer ,(subseq arg-descripter 1)
                                                  (buffer-name (other-buffer))
                                                  nil))
                           ((char= #\f (aref arg-descripter 0))
                            `(minibuf-read-file
                              ,(subseq arg-descripter 1)
                              (buffer-directory)
                              nil
                              t))
                           ((char= #\F (aref arg-descripter 0))
                            `(minibuf-read-file
                              ,(subseq arg-descripter 1)
                              (buffer-directory)
                              nil
                              nil))
                           (t
                            (error "Illegal arg-descripter: ~a" arg-descripter))))
                      arg-descripters)))))
    (defun define-command-gen-cmd (cmd-name fn-name parms arg-descripters)
      `(defun ,cmd-name (,garg)
         (declare (ignorable ,garg))
         ,(if (null arg-descripters)
              (progn
                (assert (null parms))
                `(,fn-name))
              `(destructuring-bind ,parms
                   ,(if (stringp (car arg-descripters))
                        (define-command-gen-args cmd-name arg-descripters)
                        (car arg-descripters))
                 (,fn-name ,@(collect-variables parms))))))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun function-to-command-name (f)
    (check-type f symbol)
    (string-downcase f)))

(defun find-command (name)
  (gethash name *command-table*))

(defun function-to-command (f)
  (find-command (function-to-command-name f)))

(defun command-name (command)
  (get command 'name))

(defmacro define-command (name parms (&rest arg-descripters) &body body)
  (let ((gcmd (gensym (symbol-name name))))
    `(progn
       (setf (get ',gcmd 'name) (string-downcase ',name))
       (setf (gethash ,(function-to-command-name name)
                      *command-table*)
             ',gcmd)
       (defun ,name ,parms ,@body)
       ,(define-command-gen-cmd gcmd name parms arg-descripters))))

(defun cmd-call (cmd arg)
  (run-hooks 'pre-command-hook)         ;!!!
  (prog1 (funcall cmd arg)
    (buffer-undo-boundary)              ;!!!
    (run-hooks 'post-command-hook)      ;!!!
    ))

(defun command-completion (str)
  (let ((names))
    (maphash #'(lambda (name cmd)
                 (declare (ignore cmd))
                 (push name names))
             *command-table*)
    (completion str (nreverse names))))

(defun exist-command-p (str)
  (if (find-command str) t nil))

(define-key *global-keymap* (kbd "M-x") 'execute-command)
(define-command execute-command (arg) ("P")
  (let* ((name (minibuf-read-line
                (if arg
                    (format nil "~D M-x " arg)
                    "M-x ")
                ""
                'command-completion
                'exist-command-p))
         (cmd (find-command name)))
    (if cmd
        (funcall cmd arg)
        (message "invalid command"))))

(define-command apropos-command (str) ("sApropos: ")
{'fraction_non_alphanumeric': 0.13546099290780142, 'fraction_numerical': 0.00303951367781155, 'mean_word_length': 1.3825730147236301, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 16, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3166780', 'n_tokens_mistral': 3013, 'n_tokens_neox': 2880, 'n_words': 669}