X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/ff9c4b4c6361264a5b78b30377312bc48df0d002..1a1949c751306b0f02c8e76df425ffbae58c6e5d:/gtk/gtk.lisp diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index d71b327..e195ab8 100644 --- a/gtk/gtk.lisp +++ b/gtk/gtk.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gtk.lisp,v 1.14 2004-11-03 10:41:23 espen Exp $ +;; $Id: gtk.lisp,v 1.17 2004-11-07 17:55:29 espen Exp $ (in-package "GTK") @@ -42,6 +42,27 @@ (defun gtk-version () (defbinding get-default-language () string) +;;;; Initalization + +(defbinding (gtk-init "gtk_parse_args") () nil + "Initializes the library without opening the display." + (nil null) + (nil null)) + +(defun clg-init (&optional display) + "Initializes the system and starts the event handling" + (unless (gdk:display-get-default) + (gdk:gdk-init) + (gtk-init) + (prog1 + (gdk:display-open display) + (system:add-fd-handler + (gdk:display-connection-number) :input #'main-iterate-all) + (setq lisp::*periodic-polling-function* #'main-iterate-all) + (setq lisp::*max-event-to-sec* 0) + (setq lisp::*max-event-to-usec* 1000)))) + + ;;; Acccel group @@ -111,8 +132,8 @@ (defbinding box-pack-end () nil (fill boolean) (padding unsigned-int)) -(defun box-pack (box child &key from-end expand fill (padding 0)) - (if from-end +(defun box-pack (box child &key end expand fill (padding 0)) + (if end (box-pack-end box child expand fill padding) (box-pack-start box child expand fill padding))) @@ -244,26 +265,64 @@ (defbinding (color-selection-is-adjusting-p -;;; Combo +;;;; Combo Box -(defmethod shared-initialize ((combo combo) names &rest initargs - &key popdown-strings) - (call-next-method) - (when popdown-strings - (combo-set-popdown-strings combo popdown-strings))) - -(defbinding combo-set-popdown-strings () nil - (combo combo) - (strings (glist string))) +(defmethod shared-initialize ((combo-box combo-box) names &key model content) + (unless model + (setf + (combo-box-model combo-box) + (make-instance 'list-store :columns '(string))) + (unless (typep combo-box 'combo-box-entry) + (let ((cell (make-instance 'cell-renderer-text))) + (cell-layout-pack combo-box cell :expand t) + (cell-layout-add-attribute combo-box cell :text 0))) + (when content + (map 'nil #'(lambda (text) + (combo-box-append-text combo-box text)) + content))) + (call-next-method)) + +;; (defmethod shared-initialize :after ((combo-box combo-box) names &key active) +;; (when active +;; (signal-emit combo-box 'changed))) + +(defbinding combo-box-append-text () nil + (combo-box combo-box) + (text string)) + +(defbinding combo-box-insert-text () nil + (combo-box combo-box) + (position int) + (text string)) + +(defbinding combo-box-prepend-text () nil + (combo-box combo-box) + (text string)) -(defbinding combo-disable-activate () nil - (combo combo)) +#+gtk2.6 +(defbinding combo-box-get-active-text () string + (combo-box combo-box)) +(defbinding combo-box-popup () nil + (combo-box combo-box)) + +(defbinding combo-box-popdown () nil + (combo-box combo-box)) + + + +;;;; Combo Box Entry + +(defmethod shared-initialize ((combo-box-entry combo-box-entry) names &key model) + (call-next-method) + (unless model + (setf (combo-box-entry-text-column combo-box-entry) 0))) ;;;; Dialog (defmethod shared-initialize ((dialog dialog) names &rest initargs &key button) + (declare (ignore button)) (call-next-method) (dolist (button-definition (get-all initargs :button)) (apply #'dialog-add-button dialog (mklist button-definition)))) @@ -497,23 +556,6 @@ (defmethod initialize-instance ((button radio-button) (radio-button-add-to-group button group-with))) -;;; Option menu - -(defbinding %option-menu-set-menu () nil - (option-menu option-menu) - (menu widget)) - -(defbinding %option-menu-remove-menu () nil - (option-menu option-menu)) - -(defun (setf option-menu-menu) (menu option-menu) - (if (not menu) - (%option-menu-remove-menu option-menu) - (%option-menu-set-menu option-menu menu)) - menu) - - - ;;; Item (defbinding item-select () nil @@ -677,14 +719,14 @@ (defbinding window-begin-resize-drag () nil (edge gdk:window-edge) (button int) (root-x int) (root-y int) - (timestamp (unsigned-int 32))) + (timestamp unsigned-int)) (defbinding window-begin-move-drag () nil (window window) (edge gdk:window-edge) (button int) (root-x int) (root-y int) - (timestamp (unsigned-int 32))) + (timestamp unsigned-int)) (defbinding window-set-frame-dimensions () nil (window window) @@ -1073,10 +1115,7 @@ (defbinding menu-reorder-child (menu menu-item position) nil (menu-item menu-item) ((%menu-position menu position) int)) -(def-callback menu-position-callback-marshal - (c-call:void (x c-call:int) (y c-call:int) (push-in c-call:int) - (callback-id c-call:unsigned-int)) - (invoke-callback callback-id nil x y (not (zerop push-in)))) +(def-callback-marshal %menu-popup-callback (nil (x int) (y int) (push-in boolean))) (defbinding %menu-popup () nil (menu menu) @@ -1090,13 +1129,10 @@ (defbinding %menu-popup () nil (defun menu-popup (menu button activate-time &key callback parent-menu-shell parent-menu-item) (if callback - (let ((callback-id (register-callback-function callback))) - (unwind-protect - (%menu-popup - menu parent-menu-shell parent-menu-item - (callback menu-position-callback-marshal) - callback-id button activate-time) - (destroy-user-data callback-id))) + (with-callback-function (id callback) + (%menu-popup + menu parent-menu-shell parent-menu-item + (callback %menu-popup-callback) id button activate-time)) (%menu-popup menu parent-menu-shell parent-menu-item nil 0 button activate-time)))