February 2009 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS mcclim
by crhodes 28 Feb '09

28 Feb '09

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv7193 Modified Files: frames.lisp Log Message: Read arguments for partial commands from partial menu entries even when the input stream isn't an interactor pane. Use *partial-command-parser* to do that rather than hardwiring command-line-read-remaining-arguments-for-partial-command. --- /project/mcclim/cvsroot/mcclim/frames.lisp 2009/01/28 19:27:22 1.135 +++ /project/mcclim/cvsroot/mcclim/frames.lisp 2009/02/28 16:49:40 1.136 @@ -533,10 +533,8 @@ (table (frame-command-table frame))) (unless (listp command) (setq command (partial-command-from-name command table))) - (if (and (typep stream 'interactor-pane) - (partial-command-p command)) - (command-line-read-remaining-arguments-for-partial-command - table stream command 0) + (if (partial-command-p command) + (funcall *partial-command-parser* table stream command 0) command))))) (defmethod read-frame-command ((frame application-frame)

1 0

[mcclim-cvs] CVS mcclim
by crhodes 28 Feb '09

28 Feb '09

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv7072 Modified Files: commands.lisp Log Message: Unsupplied and Numeric argument markers should not be uninterned structures, otherwise use of the literals in compiled files will fail to compare EQLly with the specials. --- /project/mcclim/cvsroot/mcclim/commands.lisp 2009/02/17 14:06:35 1.82 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2009/02/28 16:48:16 1.83 @@ -671,15 +671,13 @@ (defparameter *command-parser-table* (make-hash-table) "Mapping from command names to argument parsing functions.") - -(defvar *unsupplied-argument-marker* (gensym "UNSUPPLIED-ARGUMENT-MARKER")) +(defvar *unsupplied-argument-marker* '%unsupplied-argument-marker%) +(defvar *numeric-argument-marker* '%numeric-argument-marker%) (defvar *command-name-delimiters* '(command-delimiter)) (defvar *command-argument-delimiters* '(command-delimiter)) -(defvar *numeric-argument-marker* (cons nil nil)) - ;;; A type indicating empty input. For example, if one types <space> ;;; to get the default value of a keyword argument, and then types ;;; <return>, we don't want to see "None" in the output history. So,

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by rstrandh 24 Feb '09

24 Feb '09

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory cl-net:/tmp/cvs-serv31777 Modified Files: util.lisp Log Message: Patch to the listener from Stas Boukarev. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2008/10/23 20:54:54 1.28 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2009/02/24 05:43:50 1.29 @@ -135,7 +135,8 @@ :output-stream output :wait wait) #+clisp (ext:run-program program :arguments args :wait wait) - #-(or CMU scl SBCL lispworks clisp) + #+openmcl (ccl:run-program program args :input input :output output :wait wait) + #-(or CMU scl SBCL lispworks clisp openmcl) (format t "~&Sorry, don't know how to run programs in your CL.~%")) ;;;; CLIM/UI utilities

1 0

[mcclim-cvs] CVS mcclim/Backends/CLX
by crhodes 18 Feb '09

18 Feb '09

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory cl-net:/tmp/cvs-serv23740/Backends/CLX Modified Files: port.lisp Log Message: Fix for keyboard focus when the pointer is not in the application window. I don't really understand why, but the what is simple: make sure that the top-level-sheet-pane has a mirror which does not mask away :key-press and :key-release events. Include a comment above a restoration of the :wm_take_focus protocol implementation (which is currently not used) to explain some of this. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2008/10/23 20:49:12 1.136 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2009/02/18 17:34:44 1.137 @@ -452,7 +452,7 @@ :map nil :width (round-coordinate (space-requirement-width q)) :height (round-coordinate (space-requirement-height q)) - :event-mask nil))) + :event-mask '(:key-press :key-release)))) (setf (xlib:wm-hints window) (xlib:make-wm-hints :input :on)) (setf (xlib:wm-name window) (frame-pretty-name frame)) (setf (xlib:wm-icon-name window) (frame-pretty-name frame)) @@ -868,6 +868,21 @@ (warn "Unprocessed client message: ~:_type = ~S;~:_ data = ~S;~_ sheet = ~S." type data sheet)) +;;; this client message is only necessary if we advertise that we +;;; participate in the :WM_TAKE_FOCUS protocol; otherwise, the window +;;; manager is responsible for all setting of input focus for us. If +;;; we want to do something more complicated with server input focus, +;;; then this method should be adjusted appropriately and the +;;; top-level-sheet REALIZE-MIRROR method should be adjusted to add +;;; :WM_TAKE_FOCUS to XLIB:WM-PROTOCOLS. CSR, 2009-02-18 +(defmethod port-wm-protocols-message (sheet time (message (eql :wm_take_focus)) data) + (let ((timestamp (elt data 1)) + (mirror (sheet-mirror sheet))) + (when mirror + (xlib:set-input-focus (clx-port-display *clx-port*) + mirror :parent timestamp)) + nil)) + (defmethod port-wm-protocols-message (sheet time (message (eql :wm_delete_window)) data) (declare (ignore data)) (make-instance 'window-manager-delete-event :sheet sheet :timestamp time))

1 0

[mcclim-cvs] CVS mcclim/ESA
by crhodes 17 Feb '09

17 Feb '09

Update of /project/mcclim/cvsroot/mcclim/ESA In directory cl-net:/tmp/cvs-serv23835 Modified Files: esa.lisp Log Message: When processing gestures for a command-processor, bind *standard-input* to the ESA *minibuffer* if it is available before reading commands. Otherwise when using a Drei gadget pane, the prompt goes to the gadget itself (and nothing at all seems to be able to read keyboard input...) --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/05/18 09:24:06 1.25 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2009/02/17 14:17:18 1.26 @@ -697,17 +697,18 @@ (eq (command-menu-item-type item) :command)) (let ((command (if (commandp item) item (command-menu-item-value item))) - (*current-gesture* (first (last gestures)))) + (*current-gesture* (first (last gestures))) + (*standard-input* (or *minibuffer* *standard-input*))) (unless (consp command) (setf command (list command))) ;; Call `*partial-command-parser*' to handle numeric ;; argument. - (unwind-protect (setq command - (funcall - *partial-command-parser* - (command-table command-processor) - *standard-input* command 0 (when prefix-p - prefix-arg))) + (unwind-protect + (setq command + (funcall *partial-command-parser* + (command-table command-processor) + *standard-input* + command 0 (when prefix-p prefix-arg))) ;; If we are macrorecording, store whatever the user ;; did to invoke this command. (when (recordingp command-processor)

1 0

[mcclim-cvs] CVS mcclim
by crhodes 17 Feb '09

17 Feb '09

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv22774 Modified Files: commands.lisp Log Message: I feel ashamed of myself, but: commit a dubious fix to the infinite recursion observed when accepting a command from a drei-gadget dispatching command-table. The problem is that the accept presentation method sets the frame-command-table to the command-table from which the command is being accepted, while the dispatching table arranges to inherit from the frame-command-table dynamically, leading to an infinite explosion. This "fix" is dubious for a number of reasons, two of which are: the previous code is arguably "correct" in that it uses the established command-enabled protocol for detecting whether a command is disabled (though it is definitely weird that that necessitates mutating the frame-command-table); and that the fix doesn't actually address every instance of this problem, there being another in ESA:ESA-TOP-LEVEL. --- /project/mcclim/cvsroot/mcclim/commands.lisp 2008/12/06 14:56:41 1.81 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2009/02/17 14:06:35 1.82 @@ -1202,17 +1202,31 @@ (let ((possibilities nil)) (map-over-command-table-names (lambda (cline-name command-name) - (when (command-enabled command-name *application-frame*) + (unless (member command-name (disabled-commands *application-frame*)) (pushnew (cons cline-name command-name) possibilities :key #'car :test #'string=))) command-table) (loop for (cline-name . command-name) in possibilities do (funcall suggester cline-name command-name))))) - ;; Bind the frame's command table so that the command-enabled - ;; test passes with this command table. - (letf (((frame-command-table *application-frame*) - (find-command-table command-table))) - (multiple-value-bind (object success string) + ;; KLUDGE: here, we used to bind the frame's command table so that + ;; a test with COMMAND-ENABLED passed with the command-table being + ;; accepted from. Unfortunately, that interfered awfully with + ;; drei gadgets and their command-table inheritance; the dynamic + ;; inheritance from (frame-command-table *application-frame*) [ + ;; which is needed to get things like frame menu items and other + ;; commands to work ] works really badly if (frame-command-table + ;; *application-frame*) is set/bound to the dispatching + ;; command-table itself. + ;; + ;; Instead we now use the knowledge of how disabled commands are + ;; implemented to satisfy the constraint that only enabeled + ;; commands are acceptable (with the "accessible" constraint being + ;; automatically satisfied by the generator mapping over the + ;; command-table). + ;; + ;; This means that someone implementing their own version of the + ;; "enabled-command" protocol will lose. Sorry. CSR, 2009-02-17 + (multiple-value-bind (object success string) (complete-input stream #'(lambda (so-far mode) (complete-from-generator so-far @@ -1222,7 +1236,7 @@ :partial-completers '(#\space)) (if success (values object type) - (simple-parse-error "No command named ~S" string)))))) + (simple-parse-error "No command named ~S" string))))) (defun command-line-command-parser (command-table stream) (let ((command-name nil)

1 0