Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv9176

Modified Files: gui.lisp Log Message: Implemented flag *numeric-argument-p* to detect whether a numeric argument was given att all.

Implemented eval-expression, M-:, which uses numeric-argument-p to dentermine whether to show the result in the minibuffer or to insert it into the buffer itself.

Date: Sat Feb 19 06:23:17 2005 Author: rstrandh

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.108 climacs/gui.lisp:1.109 --- climacs/gui.lisp:1.108 Sun Feb 13 03:52:08 2005 +++ climacs/gui.lisp Sat Feb 19 06:23:16 2005 @@ -240,6 +240,11 @@ (find-if (lambda (pane) (typep pane 'scroller-pane)) (sheet-children vbox)))))))

+(defvar *numeric-argument-p* (list nil)) + +(defun substitute-numeric-argument-p (command numargp) + (substitute numargp *numeric-argument-p* command :test #'eq)) + (defun climacs-top-level (frame &key command-parser command-unparser partial-command-parser prompt) @@ -254,34 +259,36 @@ (redisplay-frame-panes frame :force-p t) (loop (catch 'outer-loop (loop for gestures = '() - for numarg = (read-numeric-argument :stream *standard-input*) - do (loop (setf *current-gesture* (climacs-read-gesture)) - (setf gestures (nconc gestures (list *current-gesture*))) - (let ((item (find-gestures gestures 'global-climacs-table))) - (cond ((not item) - (beep) (return)) - ((eq (command-menu-item-type item) :command) - (let ((command (command-menu-item-value item))) - (unless (consp command) - (setf command (list command))) - (setf command (substitute-numeric-argument-marker command numarg)) - (handler-case - (execute-frame-command frame command) - (error (condition) - (beep) - (format *error-output* "~a~%" condition))) - (setf (previous-command *standard-output*) - (if (consp command) - (car command) - command)) - (return))) - (t nil)))) - (let ((buffer (buffer (current-window)))) - (when (modified-p buffer) - (setf (needs-saving buffer) t))) - (when (null (remaining-keys *application-frame*)) - (setf (executingp *application-frame*) nil) - (redisplay-frame-panes frame)))) + do (multiple-value-bind (numarg numargp) + (read-numeric-argument :stream *standard-input*) + (loop (setf *current-gesture* (climacs-read-gesture)) + (setf gestures (nconc gestures (list *current-gesture*))) + (let ((item (find-gestures gestures 'global-climacs-table))) + (cond ((not item) + (beep) (return)) + ((eq (command-menu-item-type item) :command) + (let ((command (command-menu-item-value item))) + (unless (consp command) + (setf command (list command))) + (setf command (substitute-numeric-argument-marker command numarg)) + (setf command (substitute-numeric-argument-p command numargp)) + (handler-case + (execute-frame-command frame command) + (error (condition) + (beep) + (format *error-output* "~a~%" condition))) + (setf (previous-command *standard-output*) + (if (consp command) + (car command) + command)) + (return))) + (t nil)))) + (let ((buffer (buffer (current-window)))) + (when (modified-p buffer) + (setf (needs-saving buffer) t))) + (when (null (remaining-keys *application-frame*)) + (setf (executingp *application-frame*) nil) + (redisplay-frame-panes frame))))) (beep) (let ((buffer (buffer (current-window)))) (when (modified-p buffer) @@ -1288,6 +1295,14 @@ (syntax (syntax (buffer pane)))) (display-message "~a" (forward-to-error point syntax))))

+(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))))) + (if insertp + (insert-sequence (point (current-window)) result) + (display-message result)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Global and dead-escape command tables @@ -1317,6 +1332,7 @@

(global-set-key #\Newline 'com-self-insert) (global-set-key #\Tab 'com-indent-line) +(global-set-key '(#: :shift :meta) `(com-eval-expression ,*numeric-argument-p*)) (global-set-key '(#\j :control) 'com-newline-and-indent) (global-set-key '(#\f :control) `(com-forward-object ,*numeric-argument-marker*)) (global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*))