rework the argument system

now region specifiers are always 'parsed' once

boon-arguments.el

@@ -43,7 +43,7 @@
 
 (defun boon-select-thing-at-point (thing)
   "Return a region list with a single item pointing to the THING at point."
-  (cons 'bounds (bounds-of-thing-at-point thing)))
+  (lambda ()(cons 'bounds (bounds-of-thing-at-point thing))))
 
 (defun boon-select-from-region (select-fun)
   "Return a region list with a single item: the region selected after calling SELECT-FUN (interactively)."
@@ -51,14 +51,14 @@
   (save-excursion
     ;; FIXME: deactivate mark
     (call-interactively select-fun)
-    (cons 'bounds (cons (region-beginning) (region-end)))))
+    (lambda ()(cons 'bounds (cons (region-beginning) (region-end))))))
 
 (defun boon-select-wim () ;; what i mean
   "Return a region list with a single item: either the symbol at point, or, if this fails, the sexp at point."
   (interactive)
-  (let ((bounds (or (bounds-of-thing-at-point 'symbol)
+  (lambda ()(let ((bounds (or (bounds-of-thing-at-point 'symbol)
                               (bounds-of-thing-at-point 'sexp))))
-    (cons 'bounds bounds)))
+              (cons 'bounds bounds))))
 
 (defun boon-jump-over-blanks-forward ()
   "Jump over blanks, forward."
@@ -73,11 +73,11 @@
 (defun boon-select-org-table-cell ()
   "Return the region between pipes (|)."
   (interactive)
-  (cons 'bounds
+  (lambda ()(cons 'bounds
         (cons (save-excursion
                 (skip-chars-backward "^|") (point))
               (save-excursion
-                (skip-chars-forward "^|") (point)))))
+                (skip-chars-forward "^|") (point))))))
 
 (defun boon-select-justline ()
   "Return the region of the current line, without any newline."
@@ -91,13 +91,12 @@
 
 (defun boon-select-n (count goto-beginning forward-n)
   "Return a region of COUNT objects defined by GOTO-BEGINNING and FORWARD-N."
-  (save-excursion
+  (lambda()(save-excursion
     (funcall goto-beginning)
-    (cons 'bounds (cons (point) (progn (funcall forward-n count) (point))))))
+    (cons 'bounds (cons (point) (progn (funcall forward-n count) (point)))))))
 
 (defun boon-select-paragraph (count) (interactive "p") (boon-select-n count 'start-of-paragraph-text 'forward-paragraph))
-(defun boon-select-document () (interactive)
+(defun boon-select-document () (interactive) (cons 'bounds (cons (point-min) (point-max))))
-  (cons 'bounds (cons (point-min) (point-max))))
 (defun boon-select-word () (interactive) (boon-select-thing-at-point 'word))
 (defun boon-select-sentence () (interactive) (boon-select-thing-at-point 'sentence))
 (defun boon-select-symbol () (interactive) (boon-select-thing-at-point 'symbol))
@@ -140,27 +139,28 @@ Display PROMPT in the echo area."
         (goto-char (boon-reg-begin reg))
         (while (search-forward what (boon-reg-end reg) t)
           (setq result (cons (boon-mk-reg (match-beginning 0)
-                                          (match-end 0))
+                                          (match-end 0)
+                                          (boon-reg-cursor reg))
                               result))))
       (cons 'region result))))
 
 (defun boon-select-borders (how-much regs)
   "Return the bordering (of size HOW-MUCH) of a region list REGS.
 This function is meant to be called interactively."
-  (interactive (list (prefix-numeric-value current-prefix-arg) (boon-spec-region "select contents")))
+  (interactive (list (prefix-numeric-value current-prefix-arg) (boon-spec-region-lazy "select contents")))
-  (cons 'region (apply 'append (mapcar (lambda (reg) (boon-borders reg how-much)) (mapcar 'boon-normalize-reg regs)))))
+  (lambda ()(cons 'region (apply 'append (mapcar (lambda (reg) (boon-borders reg how-much)) (mapcar 'boon-normalize-reg (funcall regs)))))))
 
 (defun boon-select-with-spaces (regs)
   "Return the regions REGS, including some surrounding spaces.
 This function is meant to be called interactively."
-  (interactive (list (boon-spec-region "select with spaces")))
+  (interactive (list (boon-spec-region-lazy "select with spaces")))
-  (cons 'region (mapcar (lambda (reg) (boon-include-surround-spaces reg)) (mapcar 'boon-normalize-reg regs))))
+  ((lambda ())(cons 'region (mapcar (lambda (reg) (boon-include-surround-spaces reg)) (mapcar 'boon-normalize-reg (funcall regs))))))
 
 (defun boon-select-content (regs)
   "Return the contents (of size HOW-MUCH) of a region list REGS.
 This function is meant to be called interactively."
-  (interactive (list (boon-spec-region "select borders")))
+  (interactive (list (boon-spec-region-lazy "select borders")))
-  (cons 'region (mapcar 'boon-content (mapcar 'boon-normalize-reg regs))))
+  (lambda ()(cons 'region (mapcar 'boon-content (mapcar 'boon-normalize-reg (funcall regs))))))
 
 (defun boon-bypass-mc ()
   "Should we bypass multiple cursors when gathering regions?"
@@ -173,8 +173,7 @@ This function is meant to be called interactively."
         (if (boon-bypass-mc)
             ;; TODO: is marker-position really necessary here?
             (mapcar (lambda (o) (boon-mk-reg (marker-position (overlay-get o 'mark)) (marker-position (overlay-get o 'point)) o))
-                    (mc/all-fake-cursors))
+                    (mc/all-fake-cursors)))))
-          nil)))
 
 (defun boon-read-char (&optional prompt inherit-input-method seconds)
   "Read a character, bypassing multiple cursors defadvice if applicable."
@@ -186,46 +185,66 @@ This function is meant to be called interactively."
 
 (defun boon-spec-region (msg)
   "Specify a region concisely using the keyboard.
-The prompt (as MSG) is displayed.  This function actually returns
+The prompt (as MSG) is displayed.  This function returns a list
-a list of regions, in the form ((beginning . end) ...).  If
+of regions (See boon-regs.el).  If multiple-cursors are enabled
-multiple-cursors are enabled BUT the command is executed just
+BUT the command is executed just once (not once per cursor), you
-once (not once per cursor), you get a region for each cursor."
+get a region for each cursor.
+"
   (let ((orig-regs (boon-multiple-cursor-regs)))
-    (if (use-region-p)
+    (if (use-region-p) orig-regs
-        orig-regs
+      (let ((selector (boon-spec-region-lazy msg)))
-    (let (current-prefix-arg
+        (apply 'append
-          ;; this code fiddles with the prefix arg; but if we do not
+               (mapcar (lambda (in-reg)
-          ;; hide our fiddling, the next command will use the prefix
-          ;; arg that we have set. So we dynamically bind another
-          ;; current-prefix-arg here.
-          (km boon-select-map))
-      ;; We read an entry in the appropriate keymap. This is done "by hand."
-      (setq current-prefix-arg 0)
-      (while (and km (keymapp km))
-        (let ((last-char (boon-read-char (format "%s %s" msg current-prefix-arg))))
-          (if (and (>= last-char ?0) (<= last-char ?9))
-              (setq current-prefix-arg (+ (- last-char ?0) (* 10 current-prefix-arg )))
-            (setq km (lookup-key km (vector last-char))))))
-      (when (eq current-prefix-arg 0)
-        (setq current-prefix-arg nil))
-      ;; The command is ready; we now execute it (once per cursor if applicable).
-      (if km (apply 'append (mapcar (lambda (in-reg)
-                                     (let (regs final (orig (boon-reg-point in-reg)))
                          (save-excursion
-                                         (goto-char orig)
+                           (goto-char (boon-reg-point in-reg))
-                                         (setq regs (call-interactively km))
+                           (mapcar (lambda (r) (boon-mk-reg (boon-reg-mark r)
-                                         (setq final (point)))
+                                                            (boon-reg-point r)
-                                       ;; (message "in-reg=%s regs=%s orig=%s final=%s" in-reg regs orig final)
+                                                            (boon-reg-cursor in-reg)))
-                                       (if (and regs
+                                   (funcall selector))))
-                                                (listp regs)
+                       orig-regs))))))
-                                                )
+
+(defun boon-spec-region-lazy (msg)
+  "Specify a region selector concisely using the keyboard.
+The prompt (as MSG) is displayed.  This function returns a
+non-interactive function which, when run, will return bounds.
+The bounds have either of the following forms: ('bounds . begin
+. end) OR a list of regions (see boon-regs.el) OR something else,
+in which case the region is defined by the movement of the point.
+"
+  (let ((my-prefix-arg 0)
+        (kmv boon-moves-map)
+        (kms boon-select-map)
+        last-char)
+    ;; We read a move or selection, in both keymaps in parallel. First command found wins.
+    (while (and (or kmv kms)  (not (commandp kms)) (not (commandp kmv)))
+      (let ((last-char (boon-read-char (format "%s %s" msg my-prefix-arg))))
+        (if (and (>= last-char ?0) (<= last-char ?9))
+            (setq my-prefix-arg (+ (- last-char ?0) (* 10 my-prefix-arg )))
+          (if kms (setq kms (lookup-key kms (vector last-char))))
+          (if kmv (setq kmv (lookup-key kmv (vector last-char)))))))
+    (when (eq my-prefix-arg 0) (setq my-prefix-arg nil))
+      ;; The command is ready; we now execute it (once per cursor if applicable).
+    (if (or kms kmv)
+        (if (commandp kms)
+          ;; we have a 'selection'. These commands may take prefix
+          ;; args, which they parse right away, and return a
+          ;; continuation constructing the region.
+            (let ((action (let ((current-prefix-arg my-prefix-arg))
+                            (call-interactively kms)))) ;; must be called first so that the interactive arguments are read
+              (lambda () ;; FIXME: massage the return value into common format.
+                (let ((regs (funcall action)))
                   (if (eq (car regs) 'bounds)
-                                               (progn 
+                      (mapcar 'boon-reg-from-bounds (list (cdr regs)))
-                                                (mapcar (lambda (bnds) (boon-mk-reg (car bnds) (cdr bnds) (boon-reg-cursor in-reg))) (list (cdr regs))))
                     (cdr regs))
-                                         (list (boon-mk-reg orig final (boon-reg-cursor in-reg))))))
+                  )))
-                                   orig-regs))
+          ;; we have a 'move'. These commands do not take non-universal arguments. So just run it.
-        (error "Unknown region specifier"))))))
+            (lambda ()
+              (save-excursion
+                (let ((orig (point)))
+                  (let ((current-prefix-arg my-prefix-arg)) ;; dynamic bindig so env remains clean
+                    (call-interactively kmv))
+                  (list (boon-mk-reg orig (point) nil))))))
+      (error "Unknown region specifier"))))
 
 (provide 'boon-arguments)
 ;;; boon-arguments.el ends here

boon-core.el

@@ -10,6 +10,7 @@
 (require 'cl-macs)
 
 ;; Maps
+
 (defvar boon-x-map (make-sparse-keymap) "Keymap bound to x.")
 (set-keymap-parent boon-x-map ctl-x-map)
 
@@ -19,11 +20,11 @@
 (set-keymap-parent boon-command-map boon-moves-map)
 (defvar boon-select-map (make-sparse-keymap)
   "Keymap for selection of text regions.  Any move is also a valid text region.")
-(set-keymap-parent boon-select-map boon-moves-map)
 (defvar boon-off-map (make-sparse-keymap))
 (defvar boon-insert-map (make-sparse-keymap))
 (defvar boon-special-map (make-sparse-keymap))
 
+
 (defvar boon-mode-map-alist (list (cons 'boon-command-state boon-command-map)
                                   (cons 'boon-off-state     boon-off-map)
                                   (cons 'boon-special-state boon-special-map)

boon-regs.el

@@ -8,6 +8,12 @@
 (defun boon-mk-reg (mrk pnt &optional cursor)
   (list mrk pnt cursor))
 
+(defun boon-reg-from-bounds (bnds)
+  (list 'region (boon-mk-reg (car bnds) (cdr bnds) nil)))
+
+(defun boon-regs-from-bounds (bnds)
+  (list (boon-mk-reg (car bnds) (cdr bnds) nil)))
+
 (defun boon-reg-mark (reg)
   (car reg))