Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv5440/Drei
Modified Files: basic-commands.lisp editing.lisp Log Message: Print a message and beep not only for unsuccessful motion but also for editing.
--- /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2007/01/17 12:02:04 1.5 +++ /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2007/08/20 14:58:28 1.6 @@ -33,6 +33,20 @@
(in-package :drei-commands)
+(defmacro handling-motion-limit-errors ((unit-plural &key (beep t) + (display-message t)) + &body body) + "Evaluate body, if a `motion-limit-error' is signalled, beep if +`beep' is true (the default), and display a message stating that +there are no more `unit-plural's if `display-message' is +true (the default)." + `(handler-case (progn ,@body) + (motion-limit-error () + ,(when beep + `(beep)) + ,(when display-message + `(display-message ,(concatenate 'string "No more " unit-plural)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Motion commands. @@ -75,12 +89,10 @@ ,(concat "Move point forward by one " noun ". With a numeric argument N, move point forward by N " plural ". With a negative argument -N, move point backward by N " plural ".") - (handler-case (,forward *current-point* - (SYNTAX *current-buffer*) - COUNT) - (motion-limit-error () - (beep) - (display-message ,(concat "No more " plural))))) + (handling-motion-limit-errors (,plural) + (,forward *current-point* + (SYNTAX *current-buffer*) + COUNT))) (DEFINE-COMMAND (,com-backward :NAME T :COMMAND-TABLE ,command-table) @@ -88,12 +100,10 @@ ,(concat "Move point backward by one " noun ". With a numeric argument N, move point backward by N " plural ". With a negative argument -N, move point forward by N " plural ".") - (handler-case (,backward *current-point* - (SYNTAX *current-buffer*) - COUNT) - (motion-limit-error () - (beep) - (display-message ,(concat "No more " plural))))))))) + (handling-motion-limit-errors (,plural) + (,backward *current-point* + (SYNTAX *current-buffer*) + COUNT)))))))
;;; Manually define some commands
@@ -113,24 +123,18 @@ "Move point forward by one object. With a numeric argument N, move point forward by N objects. With a negative argument -N, move point backward by M objects." - (handler-case - (forward-object *current-point* - count) - (motion-limit-error nil - (beep) - (display-message "No more objects")))) + (handling-motion-limit-errors ("objects") + (forward-object *current-point* + count)))
(define-command (com-backward-object :name t :command-table movement-table) ((count 'integer :prompt "number of objects")) "Move point backward by one object. With a numeric argument N, move point backward by N objects. With a negative argument -N, move point forward by N objects." - (handler-case - (backward-object *current-point* - count) - (motion-limit-error nil - (beep) - (display-message "No more objects")))) + (handling-motion-limit-errors ("objects") + (backward-object *current-point* + count)))
;;; Autogenerate commands (define-motion-commands word movement-table) @@ -280,13 +284,11 @@ that many " plural ".
Successive kills append to the kill ring.") - (handler-case (,forward-kill *current-point* - (syntax *current-buffer*) - count - (eq (command-name *previous-command*) ',com-kill)) - (motion-limit-error () - (beep) - (display-message ,(concat "No more " plural " to kill"))))) + (handling-motion-limit-errors (,plural) + (,forward-kill *current-point* + (syntax *current-buffer*) + count + (eq (command-name *previous-command*) ',com-kill))))
;; Backward Kill Unit (define-command (,com-backward-kill @@ -298,13 +300,11 @@ that many " plural ".
Successive kills append to the kill ring.") - (handler-case (,backward-kill *current-point* - (syntax *current-buffer*) - count - (eq (command-name *previous-command*) ',com-backward-kill)) - (motion-limit-error () - (beep) - (display-message ,(concat "No more " plural "to kill"))))) + (handling-motion-limit-errors (,plural) + (,backward-kill *current-point* + (syntax *current-buffer*) + count + (eq (command-name *previous-command*) ',com-backward-kill))))
;; Delete Unit (define-command (,com-delete :name t :command-table ,command-table) @@ -349,11 +349,9 @@ transpose that " noun " with the next one. With point before the first " noun " of the buffer, transpose the first two " plural " of the buffer.") - (handler-case (,transpose *current-point* - (syntax *current-buffer*)) - (motion-limit-error () - (beep) - (display-message ,(concat "No more " plural " to transpose"))))))))) + (handling-motion-limit-errors (,plural) + (,transpose *current-point* + (syntax *current-buffer*))))))))
;;; Some manually defined commands
@@ -371,9 +369,10 @@ "Delete the object after point. With a numeric argument, kill that many objects after (or before, if negative) point." - (if killp - (forward-kill-object *current-point* count) - (forward-delete-object *current-point* count))) + (handling-motion-limit-errors ("objects") + (if killp + (forward-kill-object *current-point* count) + (forward-delete-object *current-point* count))))
(define-command (com-backward-delete-object :name t :command-table deletion-table) ((count 'integer :prompt "Number of Objects") @@ -381,9 +380,10 @@ "Delete the object before point. With a numeric argument, kills that many objects before (or after, if negative) point." - (if killp - (backward-kill-object *current-point* count) - (backward-delete-object *current-point* count))) + (handling-motion-limit-errors ("objects") + (if killp + (backward-kill-object *current-point* count #'error-limit-action) + (backward-delete-object *current-point* count #'error-limit-action))))
;; We require somewhat special behavior from Kill Line, so define a ;; new function and use that to implement the Kill Line command. --- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2007/04/27 21:37:14 1.5 +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2007/08/20 14:58:28 1.6 @@ -82,12 +82,14 @@ (:documentation ,(concat "Delete COUNT " plural " beginning from MARK."))) (defmethod ,forward-delete - (mark syntax &optional (count 1) limit-action) + (mark syntax &optional (count 1) + (limit-action #'error-limit-action)) (let ((mark2 (clone-mark mark))) (,forward mark2 syntax count limit-action) (delete-region mark mark2))) (defmethod ,forward-delete :around - (mark syntax &optional (count 1) limit-action) + (mark syntax &optional (count 1) + (limit-action #'error-limit-action)) (cond ((minusp count) (,backward-delete mark syntax (- count) limit-action)) ((plusp count) @@ -98,12 +100,14 @@ (:documentation ,(concat "Delete COUNT " plural " backwards beginning from MARK."))) (defmethod ,backward-delete - (mark syntax &optional (count 1) limit-action) + (mark syntax &optional (count 1) + (limit-action #'error-limit-action)) (let ((mark2 (clone-mark mark))) (,backward mark2 syntax count limit-action) (delete-region mark mark2))) (defmethod ,backward-delete :around - (mark syntax &optional (count 1) limit-action) + (mark syntax &optional (count 1) + (limit-action #'error-limit-action)) (cond ((minusp count) (,forward-delete mark syntax (- count) limit-action)) ((plusp count) @@ -114,7 +118,8 @@ (:documentation ,(concat "Kill COUNT " plural " beginning from MARK."))) (defmethod ,forward-kill - (mark syntax &optional (count 1) concatenate-p limit-action) + (mark syntax &optional (count 1) concatenate-p + (limit-action #'error-limit-action)) (let ((start (offset mark))) (,forward mark syntax count limit-action) (unless (mark= mark start) @@ -128,7 +133,8 @@ (region-to-sequence start mark))) (delete-region start mark)))) (defmethod ,forward-kill :around - (mark syntax &optional (count 1) concatenate-p limit-action) + (mark syntax &optional (count 1) concatenate-p + (limit-action #'error-limit-action)) (declare (ignore concatenate-p)) (cond ((minusp count) (,backward-kill mark syntax (- count) limit-action)) @@ -140,7 +146,8 @@ (:documentation ,(concat "Kill COUNT " plural " backwards beginning from MARK."))) (defmethod ,backward-kill - (mark syntax &optional (count 1) concatenate-p limit-action) + (mark syntax &optional (count 1) concatenate-p + (limit-action #'error-limit-action)) (let ((start (offset mark))) (,backward mark syntax count limit-action) (unless (mark= mark start) @@ -154,7 +161,8 @@ (region-to-sequence start mark))) (delete-region start mark)))) (defmethod ,backward-kill :around - (mark syntax &optional (count 1) concatenate-p limit-action) + (mark syntax &optional (count 1) concatenate-p + (limit-action #'error-limit-action)) (declare (ignore concatenate-p)) (cond ((minusp count) (,forward-kill mark syntax (- count) limit-action))