From ahefner at common-lisp.net Tue Apr 14 07:36:42 2009 From: ahefner at common-lisp.net (ahefner) Date: Tue, 14 Apr 2009 03:36:42 -0400 Subject: [mcclim-cvs] CVS mcclim/Apps/Listener Message-ID: Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory cl-net:/tmp/cvs-serv13853 Modified Files: dev-commands.lisp Log Message: Disable background evaluation by default, since it causes problems with input, output, and special variables. If you need this feature, you can enable it as follows: (setf clim-listener::*use-background-eval* t) --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/11/30 22:19:52 1.65 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2009/04/14 07:36:42 1.66 @@ -244,8 +244,8 @@ ;; FIXME: Disabled input, as it usually seems to hang. (define-command (com-run :name "Run" :command-table application-commands :menu t :provide-output-destination-keyword t) - ((program 'string :prompt "command") - (args '(sequence string) :default nil :prompt "args")) + ((program 'string :prompt "Command") + (args '(sequence string) :default nil :prompt "Arguments")) (run-program program args :wait t :input nil)) ;; I could replace this command with a keyword to COM-RUN.. @@ -253,8 +253,8 @@ :menu t :command-table application-commands :provide-output-destination-keyword t) - ((program 'string :prompt "command") - (args '(sequence string) :default nil :prompt "args")) + ((program 'string :prompt "Command") + (args '(sequence string) :default nil :prompt "Args")) (run-program program args :wait nil :output nil :input nil)) (define-command (com-reload-mime-database :name "Reload Mime Database" @@ -338,10 +338,10 @@ :command-table lisp-commands :menu t :provide-output-destination-keyword t) - ((string 'clim:string :prompt "string") + ((string 'clim:string :prompt "String") &key - (package '(or package-name package) :prompt "in package" :default nil) - (domain '(member symbols classes functions variables command-tables) :prompt "domain" :default 'symbols)) + (package '(or package-name package) :prompt "Package" :default nil) + (domain '(member symbols classes functions variables command-tables) :prompt "Domain" :default 'symbols)) (let ((real-package (when package (if (typep package 'package) package @@ -1505,11 +1505,13 @@ ** * * (first values))) -;;; The background evaluation feature is neat, but some people (namely -;;; myself) sometimes need a backdoor to disable it when evaluating -;;; code which does a lot of graphics in the listener, due to thread -;;; safety issues with concurrent access to a CLIM stream. -(defparameter *use-background-eval* t +;;; The background evaluation feature is neat, but there are thread +;;; safety issues doing output to streams, special variables have +;;; unexpected values, and input doesn't work right due to racing to +;;; read from the event queue. Sadly, I am forced to disable it by +;;; default. + +(defparameter *use-background-eval* nil "Perform evaluation in a background thread, which can be interrupted.") (define-command (com-eval :menu t :command-table lisp-commands) From crhodes at common-lisp.net Mon Apr 20 09:45:23 2009 From: crhodes at common-lisp.net (crhodes) Date: Mon, 20 Apr 2009 05:45:23 -0400 Subject: [mcclim-cvs] CVS mcclim Message-ID: Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv7386 Modified Files: stream-input.lisp Log Message: Don't try to get the sheet of NIL. Patch from Juliusz Chroboczek. (I don't know how to trigger this bug, but it's clearly a bug.) --- /project/mcclim/cvsroot/mcclim/stream-input.lisp 2008/05/01 21:45:23 1.54 +++ /project/mcclim/cvsroot/mcclim/stream-input.lisp 2009/04/20 09:45:23 1.55 @@ -215,7 +215,7 @@ ;;; Do streams care about any other events? (defun handle-non-stream-event (buffer) (let* ((event (event-queue-peek buffer)) - (sheet (event-sheet event))) + (sheet (and event (event-sheet event)))) (if (and event (or (and (gadgetp sheet) (gadget-active-p sheet)) From crhodes at common-lisp.net Mon Apr 20 09:56:45 2009 From: crhodes at common-lisp.net (crhodes) Date: Mon, 20 Apr 2009 05:56:45 -0400 Subject: [mcclim-cvs] CVS mcclim/Backends/CLX Message-ID: Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory cl-net:/tmp/cvs-serv10178/Backends/CLX Modified Files: port.lisp Log Message: Minimize redraws in the CLX backend. Patch from Juliusz Chroboczek. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2009/02/18 17:34:44 1.137 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2009/04/20 09:56:45 1.138 @@ -363,6 +363,7 @@ (override-redirect :off) (map t) (backing-store :not-useful) + (save-under :off) (event-mask `(:exposure :key-press :key-release :button-press :button-release @@ -412,6 +413,7 @@ :border border :override-redirect override-redirect :backing-store backing-store + :save-under save-under :gravity :north-west ;; Evil Hack -- but helps enormously (Has anybody ;; a good idea how to sneak the concept of @@ -461,6 +463,7 @@ (defmethod realize-mirror ((port clx-port) (sheet unmanaged-top-level-sheet-pane)) (realize-mirror-aux port sheet :override-redirect :on + :save-under :on :map nil :event-mask '(:structure-notify))) From crhodes at common-lisp.net Mon Apr 20 10:14:27 2009 From: crhodes at common-lisp.net (crhodes) Date: Mon, 20 Apr 2009 06:14:27 -0400 Subject: [mcclim-cvs] CVS mcclim/Backends/CLX Message-ID: Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory cl-net:/tmp/cvs-serv13113/Backends/CLX Modified Files: port.lisp Log Message: Cooperate better with X11 window managers. Patch from Juliusz Chroboczek. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2009/04/20 09:56:45 1.138 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2009/04/20 10:14:27 1.139 @@ -458,7 +458,14 @@ (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)) - (setf (xlib:wm-protocols window) `(:wm_delete_window))))) + (xlib:set-wm-class + window + (string-downcase (frame-name frame)) + (string-capitalize (string-downcase (frame-name frame)))) + (setf (xlib:wm-protocols window) `(:wm_delete_window)) + (xlib:change-property window + :WM_CLIENT_LEADER (list (xlib:window-id window)) + :WINDOW 32)))) (defmethod realize-mirror ((port clx-port) (sheet unmanaged-top-level-sheet-pane)) (realize-mirror-aux port sheet From crhodes at common-lisp.net Mon Apr 20 10:21:00 2009 From: crhodes at common-lisp.net (crhodes) Date: Mon, 20 Apr 2009 06:21:00 -0400 Subject: [mcclim-cvs] CVS mcclim/Backends/CLX Message-ID: Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory cl-net:/tmp/cvs-serv14292/Backends/CLX Modified Files: medium.lisp port.lisp Log Message: Try to use iso-10646 fonts where appropriate; don't leave the choice of encoding to the server. Patch from Juliusz Chroboczek. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/11/09 19:55:38 1.89 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2009/04/20 10:21:00 1.90 @@ -945,8 +945,8 @@ ;;; is by no means a proper solution to the problem of ;;; internationalization, because fonts tend not to have a complete ;;; coverage of the entirety of the Unicode space, even assuming that -;;; the underlying lisp supports it (as of 2006-02-06, only the case -;;; for SBCL and CLISP); instead, the translation function is meant to +;;; the underlying lisp supports it (this is the case at least for SBCL, +;;; CLISP and CCL); instead, the translation function is meant to ;;; handle font sets by requesting the X server change fonts in the ;;; middle of rendering strings. However, the below stands a chance ;;; of working when using ISO-8859-1-encoded fonts, and will tend to --- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2009/04/20 10:14:27 1.139 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2009/04/20 10:21:00 1.140 @@ -980,8 +980,6 @@ :italic-bold "bold-i")) )) (defun open-font (display font-name) - - (let ((fonts (xlib:list-font-names display font-name :max-fonts 1))) (if fonts (xlib:open-font display (first fonts)) @@ -1013,13 +1011,20 @@ (size-number (if (numberp size) (round size) (or (getf *clx-text-sizes* size) - (getf *clx-text-sizes* :normal)))) - (font-name (format nil "-~A-~A-*-*-~D-*-*-*-*-*-*-*" - family-name face-name size-number))) - (setf (gethash text-style table) - (cons font-name - (open-font (clx-port-display port) font-name))) - font-name)))))) + (getf *clx-text-sizes* :normal))))) + (flet ((try (encoding) + (let* ((fn (format nil "-~A-~A-*-*-~D-*-*-*-*-*-~A" + family-name face-name size-number + encoding)) + (font (open-font (clx-port-display port) fn))) + (and font (cons fn font))))) + (let ((fn-font + (or + (and (> char-code-limit #x100) (try "iso10646-1")) + (try "iso8859-1") + (try "*-*")))) + (setf (gethash text-style table) fn-font) + (car fn-font))))))))) (defmethod (setf text-style-mapping) (font-name (port clx-port) (text-style text-style)