[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Mon Aug 20 14:58:28 UTC 2007
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 , at 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))
More information about the Mcclim-cvs
mailing list