Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv28328
Modified Files: gui.lisp Log Message: Many commands now capture their own error situations and give reasonable error messages in the minibuffer.
Date: Thu Feb 24 09:30:30 2005 Author: rstrandh
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.123 climacs/gui.lisp:1.124 --- climacs/gui.lisp:1.123 Wed Feb 23 19:15:32 2005 +++ climacs/gui.lisp Thu Feb 24 09:30:28 2005 @@ -603,7 +603,10 @@ (setf (offset point) (offset point-backup)))))
(define-command com-extended-command () - (let ((item (accept 'command :prompt "Extended Command"))) + (let ((item (handler-case (accept 'command :prompt "Extended Command") + (error () (progn (beep) + (display-message "No such command") + (return-from com-extended-command nil)))))) (execute-frame-command *application-frame* item)))
(eval-when (:compile-toplevel :load-toplevel) @@ -729,12 +732,18 @@ (define-named-command (com-quit) () (loop for buffer in (buffers *application-frame*) when (and (needs-saving buffer) - (accept 'boolean - :prompt (format nil "Save buffer: ~a ?" (name buffer)))) + (handler-case (accept 'boolean + :prompt (format nil "Save buffer: ~a ?" (name buffer))) + (error () (progn (beep) + (display-message "Invalid answer") + (return-from com-quit nil))))) do (save-buffer buffer)) (when (or (notany #'needs-saving (buffers *application-frame*)) - (accept 'boolean :prompt "Modified buffers exist. Quit anyway?")) + (handler-case (accept 'boolean :prompt "Modified buffers exist. Quit anyway?") + (error () (progn (beep) + (display-message "Invalid answer") + (return-from com-quit nil))))) (frame-exit *application-frame*)))
(define-named-command com-write-buffer () @@ -776,7 +785,10 @@ (with-slots (buffers) *application-frame* (let ((buffer (buffer (current-window)))) (when (and (needs-saving buffer) - (accept 'boolean :prompt "Save buffer first?")) + (handler-case (accept 'boolean :prompt "Save buffer first?") + (error () (progn (beep) + (display-message "Invalid answer") + (return-from com-kill-buffer nil))))) (com-save-buffer)) (setf buffers (remove buffer buffers)) ;; Always need one buffer. @@ -816,14 +828,20 @@
(define-named-command com-goto-position () (setf (offset (point (current-window))) - (accept 'integer :prompt "Goto Position"))) + (handler-case (accept 'integer :prompt "Goto Position") + (error () (progn (beep) + (display-message "Not a valid position") + (return-from com-goto-position nil))))))
(define-named-command com-goto-line () (loop with mark = (make-instance 'standard-right-sticky-mark ;PB :buffer (buffer (current-window))) do (end-of-line mark) until (end-of-buffer-p mark) - repeat (accept 'integer :prompt "Goto Line") + repeat (handler-case (accept 'integer :prompt "Goto Line") + (error () (progn (beep) + (display-message "Not a valid line number") + (return-from com-goto-line nil)))) do (incf (offset mark)) (end-of-line mark) finally (beginning-of-line mark) @@ -846,7 +864,10 @@ (let* ((pane (current-window)) (buffer (buffer pane))) (setf (syntax buffer) - (make-instance (accept 'syntax :prompt "Set Syntax") + (make-instance (or (accept 'syntax :prompt "Set Syntax") + (progn (beep) + (display-message "No such syntax") + (return-from com-set-syntax nil))) :buffer buffer)) (setf (offset (low-mark buffer)) 0 (offset (high-mark buffer)) (size buffer)))) @@ -1021,7 +1042,10 @@ (insert-sequence point (kill-ring-yank *kill-ring*))))
(define-named-command com-resize-kill-ring () - (let ((size (accept 'integer :prompt "New kill ring size"))) + (let ((size (handler-case (accept 'integer :prompt "New kill ring size") + (error () (progn (beep) + (display-message "Not a valid kill ring size") + (return-from com-resize-kill-ring nil)))))) (setf (kill-ring-max-size *kill-ring*) size)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1141,10 +1165,16 @@ (/= (offset mark) offset-before))))
(define-named-command com-query-replace () - (let* ((string1 (accept 'string :prompt "Query replace")) - (string2 (accept 'string - :prompt (format nil "Query replace ~A with" - string1))) + (let* ((string1 (handler-case (accept 'string :prompt "Query replace") + (error () (progn (beep) + (display-message "Empty string") + (return-from com-query-replace nil))))) + (string2 (handler-case (accept 'string + :prompt (format nil "Query replace ~A with" + string1)) + (error () (progn (beep) + (display-message "Empty string") + (return-from com-query-replace nil))))) (pane (current-window)) (point (point pane))) (when (query-replace-find-next-match point string1) @@ -1264,8 +1294,15 @@
(define-named-command com-eval-expression ((insertp 'boolean :prompt "Insert?")) (let* ((*package* (find-package :climacs-gui)) - (string (accept 'string :prompt "Eval")) - (result (format nil "~a" (eval (read-from-string string))))) + (string (handler-case (accept 'string :prompt "Eval") + (error () (progn (beep) + (display-message "Empty string") + (return-from com-eval-expression nil))))) + (result (format nil "~a" + (handler-case (eval (read-from-string string)) + (error (condition) (progn (beep) + (display-message "~a" condition) + (return-from com-eval-expression nil))))))) (if insertp (insert-sequence (point (current-window)) result) (display-message result))))