March 2007 - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

[mcclim-cvs] CVS mcclim
by ahefner 04 Mar '07

04 Mar '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv21897 Modified Files: frames.lisp Log Message: Change frame-geometry* so that when subclassing application frames, the geometry specified in a superclass is inherited as you'd expect. --- /project/mcclim/cvsroot/mcclim/frames.lisp 2007/03/04 14:59:37 1.126 +++ /project/mcclim/cvsroot/mcclim/frames.lisp 2007/03/04 22:30:19 1.127 @@ -72,26 +72,6 @@ (defgeneric note-input-focus-changed (pane state) (:documentation "Called when a pane receives or loses the keyboard input focus. This is a McCLIM extension.")) - -(defmethod frame-geometry* ((frame application-frame)) - "-> width height &optional top left" - (let ((pane (frame-top-level-sheet frame))) - (destructuring-bind (&key left top right bottom width height) (frame-geometry frame) - ;; Find width and height from looking at the respective options - ;; first, then at left/right and top/bottom and finally at what - ;; compose-space says. - (setf width (or width - (and left right (- right left)) - (space-requirement-width (compose-space pane)))) - (setf height (or height - (and top bottom (- bottom top)) - (space-requirement-height (compose-space pane)))) - ;; See if a position is wanted and return left, top. - (setf left (or left - (and right (- right width)))) - (setf top (or top - (and bottom (- bottom height)))) - (values width height left top)))) (defclass standard-application-frame (application-frame presentation-history-mixin) @@ -139,11 +119,7 @@ :reader frame-top-level-lambda) (hilited-presentation :initform nil :initarg :hilited-presentation - :accessor frame-hilited-presentation) - (user-supplied-geometry :initform nil - :initarg :user-supplied-geometry - :reader frame-geometry - :documentation "plist of defaulted :left, :top, :bottom, :right, :width and :height options.") + :accessor frame-hilited-presentation) (process :accessor frame-process :initform nil) (client-settings :accessor client-settings :initform nil) (event-queue :initarg :frame-event-queue @@ -170,7 +146,49 @@ (documentation-record :accessor documentation-record :initform nil :documentation "updating output record for pointer -documentation produced by presentations."))) +documentation produced by presentations.") + (geometry-left :accessor geometry-left + :initarg :left + :initform nil) + (geometry-right :accessor geometry-right + :initarg :right + :initform nil) + (geometry-top :accessor geometry-top + :initarg :top + :initform nil) + (geometry-bottom :accessor geometry-bottom + :initarg :bottom + :initform nil) + (geometry-width :accessor geometry-width + :initarg :width + :initform nil) + (geometry-height :accessor geometry-height + :initarg :height + :initform nil))) + +(defmethod frame-geometry* ((frame standard-application-frame)) + "-> width height &optional top left" + (let ((pane (frame-top-level-sheet frame))) + ;(destructuring-bind (&key left top right bottom width height) (frame-geometry frame) + (with-slots (geometry-left geometry-top geometry-right + geometry-bottom geometry-width + geometry-height) frame + ;; Find width and height from looking at the respective options + ;; first, then at left/right and top/bottom and finally at what + ;; compose-space says. + (let* ((width (or geometry-width + (and geometry-left geometry-right + (- geometry-right geometry-left)) + (space-requirement-width (compose-space pane)))) + (height (or geometry-height + (and geometry-top geometry-bottom (- geometry-bottom geometry-top)) + (space-requirement-height (compose-space pane)))) + ;; See if a position is wanted and return left, top. + (left (or geometry-left + (and geometry-right (- geometry-right geometry-width)))) + (top (or geometry-top + (and geometry-bottom (- geometry-bottom geometry-height))))) + (values width height left top))))) ;;; Support the :input-buffer initarg for compatibility with "real CLIM" @@ -811,7 +829,7 @@ (:pointer-documentation (setq pointer-documentation (car values))) (:geometry (setq geometry values)) (:default-initargs (setq user-default-initargs values)) - (t (push (cons prop values) others)))) + (t (push (cons prop values) others)))) (when (eq command-definer t) (setf command-definer (intern (concatenate 'string @@ -840,12 +858,9 @@ :top-level-lambda (lambda (,frame-arg) (,(car top-level) ,frame-arg ,@(cdr top-level))) + ,@geometry ,@user-default-initargs) ,@others) - ;; We alway set the frame class default geometry, so that the - ;; user can undo the effect of a specified :geometry option. - ;; --GB 2004-06-01 - (setf (get ',name 'application-frame-geometry) ',geometry) ,(if pane (make-single-pane-generate-panes-form name menu-bar pane) (make-panes-generate-panes-form name menu-bar panes layouts @@ -859,9 +874,6 @@ (command-table ',(first command-table))) `(define-command (,name :command-table ,command-table ,@options) ,arguments ,@body)))))))) -(defun get-application-frame-class-geometry (name indicator) - (getf (get name 'application-frame-geometry) indicator nil)) - (defun make-application-frame (frame-name &rest options &key (pretty-name @@ -869,25 +881,14 @@ (frame-manager nil frame-manager-p) enable (state nil state-supplied-p) - (left (get-application-frame-class-geometry frame-name :left)) - (top (get-application-frame-class-geometry frame-name :top)) - (right (get-application-frame-class-geometry frame-name :right)) - (bottom (get-application-frame-class-geometry frame-name :bottom)) - (width (get-application-frame-class-geometry frame-name :width)) - (height (get-application-frame-class-geometry frame-name :height)) save-under (frame-class frame-name) &allow-other-keys) (declare (ignore save-under)) (with-keywords-removed (options (:pretty-name :frame-manager :enable :state - :left :top :right :bottom :width :height :save-under :frame-class)) (let ((frame (apply #'make-instance frame-class :name frame-name :pretty-name pretty-name - :user-supplied-geometry - (list :left left :top top - :right right :bottom bottom - :width width :height height) options))) (when frame-manager-p (adopt-frame frame-manager frame))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 04 Mar '07

04 Mar '07

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv21533 Modified Files: wholine.lisp Log Message: Less ugly. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/wholine.lisp 2007/02/05 03:27:14 1.1 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/wholine.lisp 2007/03/04 22:27:51 1.2 @@ -85,7 +85,7 @@ #+openmcl (+ (ccl::%usedbytes) (ccl::%freebytes)) #+clisp (values (sys::%room)) #-(or cmu scl sbcl lispworks openmcl clisp) 0)) - (with-text-family (t :serif) + (with-text-style (t (make-text-style :sans-serif :roman :small)) (formatting-table (t :x-spacing '(3 :character)) (formatting-row (t) (macrolet ((cell ((align-x) &body body)

1 0

[mcclim-cvs] CVS mcclim
by ahefner 04 Mar '07

04 Mar '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv21365 Modified Files: gadgets.lisp Log Message: Default value of toggle button to nil. --- /project/mcclim/cvsroot/mcclim/gadgets.lisp 2007/02/06 12:54:10 1.105 +++ /project/mcclim/cvsroot/mcclim/gadgets.lisp 2007/03/04 22:27:30 1.106 @@ -1115,7 +1115,8 @@ :reader toggle-button-indicator-type :initform :some-of) ) (:default-initargs - :text-style (make-text-style :sans-serif nil nil) + :value nil + :text-style (make-text-style :sans-serif nil nil) :align-x :left :align-y :center :x-spacing 2

1 0

[mcclim-cvs] CVS mcclim
by ahefner 04 Mar '07

04 Mar '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv20997 Modified Files: graph-formatting.lisp Log Message: Don't replay the rendered graph on the stream if drawing is disabled, or if we are drawing into a record which does not have the stream output history as an ancestor. --- /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2006/09/17 20:27:09 1.19 +++ /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/03/04 22:26:22 1.20 @@ -3,7 +3,7 @@ ;;; Title: Graph Formatting ;;; Created: 2002-08-13 ;;; License: LGPL (See file COPYING for details). -;;; $Id: graph-formatting.lisp,v 1.19 2006/09/17 20:27:09 thenriksen Exp $ +;;; $Id: graph-formatting.lisp,v 1.20 2007/03/04 22:26:22 ahefner Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -175,8 +175,11 @@ )))) (setf (output-record-position graph-output-record) (values cursor-old-x cursor-old-y)) - (with-output-recording-options (stream :draw t :record nil) - (replay graph-output-record stream)) + (when (and (stream-drawing-p stream) + (output-record-ancestor-p (stream-output-history stream) + graph-output-record)) + (with-output-recording-options (stream :draw t :record nil) + (replay graph-output-record stream))) (when move-cursor (setf (stream-cursor-position stream) (values (bounding-rectangle-max-x graph-output-record)

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 04 Mar '07

04 Mar '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv22171 Modified Files: panes.lisp Log Message: Fixed issue reported by Samium Gromoff where the :scroll-bars parameter would be ignored in `open-window-stream'. --- /project/mcclim/cvsroot/mcclim/panes.lisp 2007/02/07 12:44:17 1.180 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2007/03/04 15:08:00 1.181 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.180 2007/02/07 12:44:17 crhodes Exp $ +;;; $Id: panes.lisp,v 1.181 2007/03/04 15:08:00 thenriksen Exp $ (in-package :clim-internals) @@ -2785,10 +2785,12 @@ standard-extended-input-stream fundamental-character-output-stream standard-application-frame) - ((stream)) + ((stream) + (scroll-bars :initform :vertical + :initarg :scroll-bars)) (:panes (io - (scrolling (:height 400 :width 700) + (scrolling (:height 400 :width 700 :scroll-bar (slot-value *application-frame* 'scroll-bars)) (setf (slot-value *application-frame* 'stream) (make-pane 'window-stream :width 700 @@ -2824,7 +2826,6 @@ initial-cursor-visibility text-margin save-under - scroll-bars borders label)) (setf port (or port (find-port))) @@ -2838,7 +2839,8 @@ :right right :bottom bottom :width width - :height height))) + :height height + :scroll-bars scroll-bars))) ;; Adopt and enable the pane (when (eq (frame-state frame) :disowned) (adopt-frame fm frame))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 04 Mar '07

04 Mar '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv19503 Modified Files: frames.lisp Log Message: Patch by Robert Goldman, make menu commands with unsupplied arguments work better. --- /project/mcclim/cvsroot/mcclim/frames.lisp 2007/02/07 12:44:16 1.125 +++ /project/mcclim/cvsroot/mcclim/frames.lisp 2007/03/04 14:59:37 1.126 @@ -505,9 +505,9 @@ (menu-item (let ((command (command-menu-item-value object))) (unless (listp command) - (setq command (list command))) + (setq command (partial-command-from-name command))) (if (and (typep stream 'interactor-pane) - (member *unsupplied-argument-marker* command :test #'eq)) + (partial-command-p command)) (command-line-read-remaining-arguments-for-partial-command (frame-command-table frame) stream command 0) command)))))

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 03 Mar '07

03 Mar '07

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv6536 Modified Files: ffi.lisp gadgets.lisp gtk-ffi.lisp Log Message: Use UTF-8 for all foreign strings. * Backends/gtkairo/gtk-ffi.lisp (utf8-string): New foreign type. * Backends/gtkairo/ffi.lisp: s/:string/utf8-string/ * Backends/gtkairo/gadgets.lisp (reset-list-pane-items, (realize-native-widget gtk-option-pane)): Specify :encoding. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp 2007/02/07 12:44:19 1.17 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp 2007/03/03 12:09:51 1.18 @@ -372,7 +372,7 @@ (defcfun "cairo_image_surface_create_for_data" :pointer - (arg0 :string) ;unsigned char * + (arg0 utf8-string) ;unsigned char * (arg1 cairo_format_t) (arg2 :int) ;int (arg3 :int) ;int @@ -559,7 +559,7 @@ (defcfun "cairo_select_font_face" :void (arg0 :pointer) ;cairo_t * - (arg1 :string) ;const char * + (arg1 utf8-string) ;const char * (arg2 cairo_font_slant_t) (arg3 cairo_font_weight_t)) @@ -664,7 +664,7 @@ (defcfun "cairo_show_text" :void (arg0 :pointer) ;cairo_t * - (arg1 :string) ;const char * + (arg1 utf8-string) ;const char * ) (defcfun "cairo_status" @@ -722,14 +722,14 @@ (defcfun "cairo_text_extents" :void (arg0 :pointer) ;cairo_t * - (arg1 :string) ;const char * + (arg1 utf8-string) ;const char * (arg2 :pointer) ;cairo_text_extents_t * ) (defcfun "cairo_text_path" :void (arg0 :pointer) ;cairo_t * - (arg1 :string) ;const char * + (arg1 utf8-string) ;const char * ) (defcfun "cairo_translate" @@ -758,7 +758,7 @@ (defcfun "g_signal_connect_data" :unsigned-long (instance :pointer) ;gpointer - (detailed_signal :string) ;const gchar * + (detailed_signal utf8-string) ;const gchar * (c_handler :pointer) ;GCallback (data :pointer) ;gpointer (destroy_data :pointer) ;GClosureNotify @@ -778,7 +778,7 @@ (defcfun "g_value_set_string" :void (value :pointer) ;GValue * - (v_string :string) ;const gchar * + (v_string utf8-string) ;const gchar * ) (defcfun "gdk_cairo_create" @@ -1122,20 +1122,20 @@ (defcfun "gtk_button_new_with_label" :pointer - (label :string) ;const gchar * + (label utf8-string) ;const gchar * ) (defcfun "gtk_cell_renderer_text_new" :pointer) (defcfun "gtk_check_button_new_with_label" :pointer - (label :string) ;const gchar * + (label utf8-string) ;const gchar * ) (defcfun "gtk_combo_box_append_text" :void (combo_box :pointer) ;GtkComboBox * - (text :string) ;const gchar * + (text utf8-string) ;const gchar * ) (defcfun "gtk_combo_box_get_active" @@ -1199,7 +1199,7 @@ (defcfun "gtk_frame_new" :pointer - (label :string) ;const gchar * + (label utf8-string) ;const gchar * ) (defcfun "gtk_get_current_event_time" :uint32) @@ -1224,13 +1224,13 @@ (defcfun "gtk_label_new" :pointer - (str :string) ;const gchar * + (str utf8-string) ;const gchar * ) (defcfun "gtk_label_set_text" :void (label :pointer) ;GtkLabel * - (str :string) ;const gchar * + (str utf8-string) ;const gchar * ) (defcfun "gtk_list_store_append" @@ -1267,7 +1267,7 @@ (defcfun "gtk_menu_item_new_with_label" :pointer - (label :string) ;const gchar * + (label utf8-string) ;const gchar * ) (defcfun "gtk_menu_item_set_submenu" @@ -1350,7 +1350,7 @@ (defcfun "gtk_radio_button_new_with_label" :pointer (group :pointer) ;GSList * - (label :string) ;const gchar * + (label utf8-string) ;const gchar * ) (defcfun "gtk_range_get_adjustment" @@ -1446,7 +1446,7 @@ :void (tree_column :pointer) ;GtkTreeViewColumn * (cell_renderer :pointer) ;GtkCellRenderer * - (attribute :string) ;const gchar * + (attribute utf8-string) ;const gchar * (column :int) ;gint ) @@ -1462,7 +1462,7 @@ (defcfun "gtk_tree_view_column_set_title" :void (tree_column :pointer) ;GtkTreeViewColumn * - (title :string) ;const gchar * + (title utf8-string) ;const gchar * ) (defcfun "gtk_tree_view_get_hadjustment" @@ -1664,7 +1664,7 @@ (defcfun "gtk_window_set_title" :void (window :pointer) ;GtkWindow * - (title :string) ;const gchar * + (title utf8-string) ;const gchar * ) (defcfun "pango_cairo_create_layout" @@ -1715,11 +1715,11 @@ (defcfun "pango_font_description_from_string" :pointer - (str :string) ;const char * + (str utf8-string) ;const char * ) (defcfun "pango_font_description_get_family" - :string + utf8-string (desc :pointer) ;const PangoFontDescription * ) @@ -1734,7 +1734,7 @@ (defcfun "pango_font_description_set_family" :void (desc :pointer) ;PangoFontDescription * - (family :string) ;const char * + (family utf8-string) ;const char * ) (defcfun "pango_font_description_set_size" @@ -1754,12 +1754,12 @@ (weight PangoWeight)) (defcfun "pango_font_description_to_string" - :string + utf8-string (desc :pointer) ;const PangoFontDescription * ) (defcfun "pango_font_face_get_face_name" - :string + utf8-string (face :pointer) ;PangoFontFace * ) @@ -1771,7 +1771,7 @@ ) (defcfun "pango_font_family_get_name" - :string + utf8-string (family :pointer) ;PangoFontFamily * ) @@ -1884,6 +1884,6 @@ (defcfun "pango_layout_set_text" :void (layout :pointer) ;PangoLayout * - (text :string) ;const char * + (text utf8-string) ;const char * (length :int) ;int ) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2007/02/04 12:55:44 1.21 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2007/03/03 12:09:51 1.22 @@ -207,7 +207,7 @@ (cffi:with-foreign-object (&iter 'gtktreeiter) (dolist (i (climi::list-pane-items sheet)) (gtk_list_store_append model &iter) - (cffi:with-foreign-string (n (funcall name-key i)) + (cffi:with-foreign-string (n (funcall name-key i) :encoding :utf-8) (cffi:with-foreign-object (&value 'gvalue) (setf (cffi:foreign-slot-value &value 'gvalue 'type) 0) (g_value_init &value +g-type-string+) @@ -218,7 +218,7 @@ (let* ((widget (gtk_combo_box_new_text)) (name-key (climi::list-pane-name-key sheet))) (dolist (i (climi::list-pane-items sheet)) - (cffi:with-foreign-string (n (funcall name-key i)) + (cffi:with-foreign-string (n (funcall name-key i) :encoding :utf-8) (gtk_combo_box_append_text widget n))) (option-pane-set-active sheet widget) widget)) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/12/26 12:11:04 1.25 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2007/03/03 12:09:51 1.26 @@ -19,6 +19,8 @@ (in-package :clim-gtkairo) +(cffi:defctype utf8-string (:string :encoding :utf-8)) + #-(or win32 mswindows windows darwin) (eval-when (:compile-toplevel :load-toplevel :execute) (cffi:load-foreign-library "libcairo.so") @@ -238,7 +240,7 @@ (state :uint) (keyval :uint) (length :int) - (string :string)) + (string utf8-string)) (cffi:defcstruct gdkeventcrossing (type :int)

1 0