add tests, fix issues with context's keys

breeze.asd

@@ -23,10 +23,11 @@
   :author "Francis St-Amour"
   :licence "BSD 2-Clause License"
   :description "A system to help automate work."
-  :depends-on (breeze/config
+  :depends-on (#:breeze/config
                ;; Multi-threading
                #:bordeaux-threads
                #:chanl
+               #:trivial-timeout
                ;; To create projects
                #:quickproject
                ;; Utilities

src/cl.lisp

@@ -9,7 +9,8 @@
 
 (defpackage #:breeze.cl
   (:documentation "Some useful metadata on cl's symbols")
-  (:use :cl))
+  (:use :cl)
+  (:export #:higher-order-function-p))
 
 (in-package #:breeze.cl)
 

src/command.lisp

@@ -51,13 +51,20 @@
    #:define-command
    ;; Utilities to add very useful information into the context
    #:augment-context-by-parsing-the-buffer
+   ;; Keys in the *context* hash-table
+   #:buffer-string
+   #:buffer-name
+   #:buffer-file-name
+   #:point
+   #:point-min
+   #:point-max
+   #:point
    #:nodes
    #:path
    #:outer-node
    #:inner-node
    #:inner-node-index
-   #:parent-node
-   ))
+   #:parent-node))
 
 (in-package #:breeze.command)
 
@@ -199,7 +206,7 @@
                                                    point-min
                                                    point-max))
                                       :test #'string=)
-                              (intern (symbol-name key) :keyword)
+                              (intern (symbol-name key) #.*package*)
                               key)
     :when value
       :do (setf (gethash normalized-key ht) value)
@@ -324,79 +331,79 @@
   "Get the \"buffer-string\" from the CONTEXT.
 The buffer-string is the content of the buffer.
 It can be null."
-  (context-get context :buffer-string))
+  (context-get context 'buffer-string))
 
 (defun context-buffer-string* ()
   "Get the \"buffer-string\" from the *current-command*'s context.
 The buffer-string is the content of the buffer.
 It can be null."
-  (context-get (command-context*) :buffer-string))
+  (context-get (command-context*) 'buffer-string))
 
 (defun context-buffer-name (context)
   "Get the \"buffer-name\" from the CONTEXT.
 The buffer-name is the name of the buffer.
 It can be null."
-  (context-get context :buffer-name))
+  (context-get context 'buffer-name))
 
 (defun context-buffer-name* ()
   "Get the \"buffer-name\" from the *current-command*'s context.
 The buffer-name is the name of the buffer.
 It can be null."
-  (context-get (command-context*) :buffer-name))
+  (context-get (command-context*) 'buffer-name))
 
 (defun context-buffer-file-name (context)
   "Get the \"buffer-file-name\" the CONTEXT.
 The buffer-file-name is the name of the file that the buffer is
 visiting.
 It can be null."
-  (context-get context :buffer-file-name))
+  (context-get context 'buffer-file-name))
 
 (defun context-buffer-file-name* ()
   "Get the \"buffer-file-name\" from the *current-command*'s context.
 The buffer-file-name is the name of the file that the buffer is
 visiting.
 It can be null."
-  (context-get (command-context*) :buffer-file-name))
+  (context-get (command-context*) 'buffer-file-name))
 
 (defun context-point (context)
   "Get the \"point\" from the CONTEXT.
 The point is the position of the cursor.
 It can be null."
-  (context-get context :point))
+  (context-get context 'point))
 
 (defun context-point* ()
   "Get the \"point\" from the *current-command*'s context.
 The point is the position of the cursor.
 It can be null."
-  (context-get (command-context*) :point))
+  (context-get (command-context*) 'point))
 
 (defun context-point-min (context)
   "Get the \"point-min\" from the CONTEXT.
 The point-min is the position of the beginning of buffer-string.
 See \"narrowing\" in Emacs.
 It can be null."
-  (context-get context :point-min))
+  (context-get context 'point-min))
 
 (defun context-point-min* ()
   "Get the \"point-min\" from the *current-command*'s context.
 The point-min is the position of the beginning of buffer-string.
 See \"narrowing\" in Emacs.
 It can be null."
-  (context-get (command-context*) :point-min))
+  (context-get (command-context*) 'point-min))
 
 (defun context-point-max (context)
   "Get the \"point-max\" from the CONTEXT.
 The point-max is the position of the end of buffer-string.
 See \"narrowing\" in Emacs.
 It can be null."
-  (context-get context :point-max))
+  (context-get context 'point-max))
 
 (defun context-point-max* ()
   "Get the \"point-max\" from the *current-command*'s context.
 The point-max is the position of the end of buffer-string.
 See \"narrowing\" in Emacs.
 It can be null."
-  (context-get (command-context*) :point-max))
+  (context-get (command-context*) 'point-max))
 
 
 
@@ -564,10 +571,10 @@ Example:
 (defun parse-buffer (context)
   (let* ((buffer-string (context-buffer-string context))
          (code (parse-string buffer-string)))
-    (breeze.reader::nodes code)
+    (breeze.reader:forms code)
     #++
-    (unless (breeze.reader::nodes code)
-      (signal (breeze.reader::parser-condition code)))))
+    (unless (breeze.reader:forms code)
+      (signal (breeze.reader:parser-condition code)))))
 
 ;; TODO Add lots of error-handling...
 (defun augment-context-by-parsing-the-buffer (context)

src/reader.lisp

@@ -17,7 +17,9 @@ This package also re-exports symbols from breeze.syntax-tree.")
    #:parse
    #:parse-string
    #:unparse-to-stream
-   #:unparse-to-string))
+   #:unparse-to-string
+   #:forms
+   #:parser-conditon))
 
 (in-package #:breeze.reader)
 
@@ -28,10 +30,10 @@ This package also re-exports symbols from breeze.syntax-tree.")
 
 ;; TODO Find a better name... anything better
 (defclass code ()
-  ((nodes
+  ((forms
     :initform nil
-    :initarg :nodes
-    :accessor nodes
+    :initarg :forms
+    :accessor forms
     :documentation "List of forms (syntax nodes)")
    (parser-condition
     :initform nil
@@ -40,9 +42,9 @@ This package also re-exports symbols from breeze.syntax-tree.")
     :documentation "The condition that occured while parsing"))
   (:documentation "Represents a parsed piece of code."))
 
-(defun make-code (&optional nodes)
+(defun make-code (&optional forms)
   (make-instance 'code
-                 :nodes nodes))
+                 :forms forms))
 
 
 ;;; Parser "client", that how you customize eclector
@@ -257,7 +259,6 @@ This package also re-exports symbols from breeze.syntax-tree.")
  make-instance
  eclector.parse-result:make-expression-result
  eclector.parse-result:read-preserving-whitespace
- post-process-nodes!
  raw)
 
 ;; #+ (or) (sb-profile:report)

src/refactor.lisp

@@ -17,6 +17,7 @@
    #:before-last
    #:find-version-control-root)
   (:export
+   #:command-description
    ;; Simple transformation commands
    #:insert-loop-clause-for-on-list
    #:insert-loop-clause-for-in-list
@@ -33,6 +34,7 @@
    #:insert-defpackage
    #:insert-in-package-cl-user
    #:insert-asdf
+   #:insert-lambda
    ;; Other commands
    #:quickfix))
 
@@ -59,7 +61,7 @@
   "Insert handler case form."
   (insert
    "(handler-case~
-  ~%  (frobnicate)
+  ~%  (frobnicate)~
   ~%  (error (condition)~
   ~%    (describe condition *debug-io*)))"))
 
@@ -349,12 +351,11 @@ For debugging purposes ONLY.")
 
 #+ (or)
 (let* ((*standard-output* *debug-io*)
-       (pos (1- (getf *qf* :point)))
-       (nodes (getf *qf* :nodes))
-       (path (find-path-to-node pos nodes))
-       (outer-node (caar path))
-       (parent-node (car (before-last path)))
-       (inner-node (car (lastcar path))))
+       (nodes )
+       (path )
+       (outer-node )
+       (parent-node )
+       (inner-node ))
   (loop :for (node . index) :in path
         :for i :from 0
         :do (format t "~%=== Path part #~d, index ~d ===~%~s"
@@ -367,11 +368,7 @@ For debugging purposes ONLY.")
   (format t "~%nearest in-package: ~a" (find-nearest-in-package-form nodes outer-node))
   (format t "~%parent node: ~a" parent-node))
 
-#+(or) (in-package-form-p
-        (car (getf *qf* :nodes)))
-
-
-
+;; (cdr (assoc :context *qf*))
 
 
 (defun validate-nearest-in-package (nodes outer-node)
@@ -401,7 +398,7 @@ For debugging purposes ONLY.")
 (defun compute-suggestions (&aux commands)
   "Compute the list of applicable commands given the current context."
   (let+ctx (nodes
-            position
+            point
             path
             outer-node
             inner-node
@@ -433,8 +430,8 @@ For debugging purposes ONLY.")
           ;; in-between forms
           (null outer-node)
           ;; just at the start or end of a form
-          (= position (node-start outer-node))
-          (= position (node-end outer-node))
+          (= point (node-start outer-node))
+          (= point (node-end outer-node))
           ;; inside a comment (or a form disabled by a
           ;; feature-expression)
           (typep outer-node

src/syntax-tree.lisp

@@ -294,17 +294,19 @@
 
 (defun find-node (position nodes)
   "Given a list of NODES, return which node contains the POSITION."
+  (check-type nodes list)
   (loop :for node :in nodes
         :for (start . end) = (node-source node)
         :for i :from 0
         :when (and
                (<= start position end)
-               (<= position end))
+               (< position end))
           :do
              (return (cons node i))))
 
 (defun find-path-to-node (position nodes)
   "Given a list of NODES, return a path (list of cons (node . index))"
+  (check-type nodes list)
   (loop :for found = (find-node position nodes)
           :then (let ((node (car found)))
                   (and (listp (node-content node))
@@ -314,6 +316,8 @@
         :collect found))
 
 (defun find-nearest-sibling-form (nodes current-node predicate)
+  (check-type nodes list)
+  (check-type current-node node)
   "Find the nearest sibling form that match the predicate."
   (loop :with result
         :for node :in nodes

tests/command.lisp

@@ -30,8 +30,8 @@
 (define-test context-plist-to-hash-table
   (let ((plist (alexandria:hash-table-plist
                 (context-plist-to-hash-table '(buffer-string "asdf" ok 42)))))
-    (is equal "asdf" (getf plist :buffer-string))
-    (false (getf plist 'buffer-string))
+    (is equal "asdf" (getf plist 'buffer-string))
+    (false (getf plist :buffer-string))
     (is = 42 (getf plist 'ok))))
 
 (define-test command-handler-initialization
@@ -106,7 +106,7 @@
       "asdf"
       (context-buffer-string
        (alexandria:plist-hash-table
-        '(:buffer-string "asdf")))))
+        '(buffer-string "asdf")))))
 
 (define-test context-buffer-name)
 (define-test context-buffer-file-name)