X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/2e852f7b0dc57966cfad557ebf0f9a962bb28882..43e8a182b5a4b41d3b5bb063cecb15d12ae3964b:/gtk/gtk.lisp

diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp
index 0f7426d..b76bff5 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.22 2004-12-20 00:51:38 espen Exp $
+;; $Id: gtk.lisp,v 1.27 2004-12-26 11:51:21 espen Exp $
 
 
 (in-package "GTK")
@@ -329,12 +329,10 @@ (defmethod shared-initialize ((dialog dialog) names &rest initargs
     (initial-apply-add dialog #'dialog-add-button initargs :button :buttons)))
   
 
-(defvar %*response-id-key* (gensym))
-
 (defun %dialog-find-response-id-num (dialog id &optional create-p error-p)
   (or
    (cadr (assoc id (rest (type-expand-1 'response-type))))
-   (let ((response-ids (object-data dialog %*response-id-key*)))
+   (let ((response-ids (object-data dialog 'response-id-key)))
     (cond
       ((and response-ids (position id response-ids :test #'equal)))
       (create-p
@@ -344,7 +342,7 @@ (defun %dialog-find-response-id-num (dialog id &optional create-p error-p)
 	  (1- (length response-ids)))
 	 (t
 	  (setf 
-	   (object-data dialog %*response-id-key*)
+	   (object-data dialog 'response-id-key)
 	   (make-array 1 :adjustable t :fill-pointer t :initial-element id))
 	  0)))
       (error-p
@@ -356,7 +354,7 @@ (defun %dialog-find-response-id (dialog response-id-num)
        (rassoc
 	(list response-id-num)
 	(rest (type-expand-1 'response-type)) :test #'equal))
-    (aref (object-data dialog %*response-id-key*) response-id-num )))
+    (aref (object-data dialog 'response-id-key) response-id-num )))
 
 
 (defmethod signal-connect ((dialog dialog) signal function &key object after)
@@ -390,8 +388,7 @@ (defbinding %dialog-add-button () button
 
 (defun dialog-add-button (dialog label &optional (response label)
 			  &key default object after)
-  "Adds a button to the dialog. If no response is given, then label
-   will be used."
+  "Adds a button to the dialog."
   (let* ((id (if (functionp response)
 		 label
 	       response))
@@ -436,8 +433,20 @@ (defbinding dialog-set-response-sensitive (dialog response-id sensitive) nil
   ((%dialog-find-response-id-num dialog response-id nil t) int)
   (sensitive boolean))
 
+#+gtk2.6
+(defbinding alternative-dialog-button-order-p(&optional screen)
+  (screen (or null screen)))
+
+#+gtk2.6
+(defbinding (dialog-set-alternative-button-order 
+	     "gtk_dialog_set_alternative_button_order_from_array") 
+    (dialog new-order)
+  (dialog dialog)
+  ((length new-order) int)
+  ((map 'vector #'(lambda (id)
+		    (%dialog-find-response-id-num dialog id nil t))
+	new-order) (vector int)))
 
-;; Addition dialog functions
 
 (defmethod container-add ((dialog dialog) (child widget) &rest args)
   (apply #'container-add (dialog-vbox dialog) child args))
@@ -472,6 +481,39 @@ (defbinding entry-get-layout-offsets () nil
   (y int :out))
 
 
+;;; Entry Completion
+
+(def-callback-marshal %entry-completion-match-func
+    (boolean entry-completion string (copy-of tree-iter)))
+
+(defbinding entry-completion-set-match-func (completion function) nil
+  (completion entry-completion)
+  ((callback %entry-completion-match-func) pointer)
+  ((register-callback-function function) unsigned-int)
+  ((callback %destroy-user-data) pointer))
+
+(defbinding entry-completion-complete () nil
+  (completion entry-completion))
+
+#+gtk2.6
+(defbinding entry-completion-insert-prefix () nil
+  (completion entry-completion))
+
+(defbinding entry-completion-insert-action-text () nil
+  (completion entry-completion)
+  (index int)
+  (text string))
+
+(defbinding entry-completion-insert-action-markup () nil
+  (completion entry-completion)
+  (index int)
+  (markup string))
+
+(defbinding entry-completion-delete-action () nil
+  (completion entry-completion)
+  (index int))
+
+
 ;;; Image
 
 (defbinding image-set-from-file () nil
@@ -623,6 +665,48 @@ (defbinding menu-item-toggle-size-allocate () nil
   (allocation int))
 
 
+;;; Message dialog
+
+(defmethod initialize-instance ((dialog message-dialog) &rest initargs 
+				&key (type :info) (buttons :close) ; or :ok? 
+				flags message parent)
+  (remf initargs :parent)
+  (setf 
+   (slot-value dialog 'location)
+   (%message-dialog-new parent flags type buttons nil))
+  (message-dialog-set-markup dialog message)
+  (apply #'call-next-method dialog initargs))
+
+
+(defbinding %message-dialog-new () pointer
+  (parent (or null window))
+  (flags dialog-flags)
+  (type message-type)
+  (buttons buttons-type)
+  (message (or null string)))
+
+(defbinding %message-dialog-new-with-markup () pointer
+  (parent (or null window))
+  (flags dialog-flags)
+  (type message-type)
+  (buttons buttons-type)
+  (message string))
+
+(defbinding message-dialog-set-markup () nil
+  (message-dialog message-dialog)
+  (markup string))
+
+#+gtk2.6
+(defbinding message-dialog-format-secondary-text () nil
+  (message-dialog message-dialog)
+  (text string))
+
+#+gtk2.6
+(defbinding message-dialog-format-secondary-markup () nil
+  (message-dialog message-dialog)
+  (markup string))
+
+
 
 ;;; Radio menu item
 
@@ -689,7 +773,41 @@ (defbinding window-set-default-size (window width height) int
   ((or width -1) int)
   ((or height -1) int))
 
-;(defbinding window-set-geometry-hints)
+(defbinding %window-set-geometry-hints () nil
+  (window window)
+  (geometry gdk:geometry)
+  (geometry-mask gdk:window-hints))
+
+(defun window-set-geometry-hints (window &key min-width min-height
+                                  max-width max-height base-width base-height
+				  width-inc height-inc min-aspect max-aspect
+				  (gravity nil gravity-p) min-size max-size)
+  (let ((geometry (make-instance 'gdk:geometry 
+		   :min-width (or min-width -1)
+		   :min-height (or min-height -1)
+		   :max-width (or max-width -1)
+		   :max-height (or max-height -1)
+		   :base-width (or base-width 0)
+		   :base-height (or base-height 0)
+		   :width-inc (or width-inc 0)
+		   :height-inc (or height-inc 0)
+		   :min-aspect (or min-aspect 0)
+		   :max-aspect (or max-aspect 0)
+		   :gravity gravity))
+	(mask ()))
+    (when (or min-size min-width min-height)
+      (push :min-size mask))
+    (when (or max-size max-width max-height)
+      (push :max-size mask))
+    (when (or base-width base-height)
+      (push :base-size mask))
+    (when (or width-inc height-inc)
+      (push :resize-inc mask))
+    (when (or min-aspect max-aspect)
+      (push :aspect mask))
+    (when gravity-p
+      (push :win-gravity mask))
+    (%window-set-geometry-hints window geometry mask)))
 
 (defbinding window-list-toplevels () (glist (copy-of window))
   "Returns a list of all existing toplevel windows.")
@@ -709,6 +827,14 @@ (defbinding window-mnemonic-activate (window key modifier) nil
   ((gdk:keyval-from-name key) unsigned-int)
   (modifier gdk:modifier-type))
 
+(defbinding window-activate-key () boolean
+  (window window)
+  (event gdk:key-event))
+
+(defbinding window-propagate-key-event () boolean
+  (window window)
+  (event gdk:key-event))
+
 (defbinding window-present () nil
   (window window))
 
@@ -730,6 +856,20 @@ (defbinding window-maximize () nil
 (defbinding window-unmaximize () nil
   (window window))
 
+(defbinding window-fullscreen () nil
+  (window window))
+
+(defbinding window-unfullscreen () nil
+  (window window))
+
+(defbinding window-set-keep-above () nil
+  (window window)
+  (setting boolean))
+
+(defbinding window-set-keep-below () nil
+  (window window)
+  (setting boolean))
+
 (defbinding window-begin-resize-drag () nil
   (window window)
   (edge gdk:window-edge)
@@ -748,9 +888,6 @@ (defbinding window-set-frame-dimensions () nil
   (window window)
   (left int) (top int) (rigth int) (bottom int))
 
-(defbinding (window-default-icons "gtk_window_get_default_icon_list")
-    () (glist gdk:pixbuf))
-
 (defbinding %window-get-default-size () nil
   (window window)
   (width int :out)
@@ -767,12 +904,6 @@ (defbinding window-get-frame-dimensions () nil
 (defbinding %window-get-icon-list () (glist gdk:pixbuf)
   (window window))
 
-(defmethod window-icon ((window window))
-  (let ((icon-list (%window-get-icon-list window)))
-    (if (endp (rest icon-list))
-	(first icon-list)
-      icon-list)))
-
 (defbinding window-get-position () nil
   (window window)
   (root-x int :out)
@@ -800,19 +931,86 @@ (defbinding window-resize () nil
   (width int)
   (heigth int))
 
-(defbinding %window-set-icon-list () nil
+(defbinding (window-default-icon-list "gtk_window_get_default_icon_list")
+    () (glist gdk:pixbuf))
+
+(defun window-default-icon ()
+  (first (window-default-icon-list)))
+
+(defbinding %window-set-default-icon-list () nil
+  (icons (glist gdk:pixbuf)))
+
+(defun (setf window-default-icon-list) (icons)
+  (%window-set-default-icon-list icons)
+  icons)
+
+(defbinding %window-set-default-icon () nil
+  (icons (glist gdk:pixbuf)))
+
+(defmethod (setf window-default-icon) ((icon gdk:pixbuf))
+  (%window-set-default-icon icon)
+  icon)
+
+(defmethod (setf window-group) ((group window-group) (window window))
+  (window-group-add-window group window)
+  group)
+
+(defbinding %window-set-default-icon-from-file () boolean
+  (filename pathname)
+  (nil null))
+
+(defmethod (setf window-default-icon) ((icon-file pathname))
+  (%window-set-default-icon-from-file icon-file)
+  icon-file)
+
+(defbinding %window-set-icon-from-file () boolean
+  (window window)
+  (filename pathname)
+  (nil null))
+
+(defmethod (setf window-icon) ((icon-file pathname) (window window))
+  (%window-set-icon-from-file window icon-file)
+  icon-file)
+
+(defbinding window-set-auto-startup-notification () nil
+  (setting boolean))
+
+(defbinding decorated-window-init () nil
+  (window window))
+
+(defbinding decorated-window-calculate-frame-size () nil
+  (window window))
+
+(defbinding decorated-window-set-title () nil
   (window window)
-  (icon-list (glist gdk:pixbuf)))
+  (title string))
 
-(defmethod (setf window-icon) (icon (window window))
-  (%window-set-icon-list window (mklist icon)))
+(defbinding decorated-window-move-resize-window () nil
+  (window window)
+  (x int)
+  (y int)
+  (width int)
+  (heigth int))
 
 
+;;; Window group
 
+(defmethod initialize-instance ((window-group window-group) &rest initargs 
+				&key window windows)
+  (declare (ignore window windows))
+  (prog1
+      (call-next-method)
+    (initial-add window-group #'window-group-add-window 
+     initargs :window :windows)))
 
-;;; File chooser
 
+(defbinding window-group-add-window () nil
+  (window-group window-group)
+  (window window))
 
+(defbinding window-group-remove-window () nil
+  (window-group window-group)
+  (window window))
 
 
 ;;; Scrolled window
@@ -1043,27 +1241,6 @@ (defbinding paned-pack2 () nil
   (resize boolean)
   (shrink boolean))
 
-(defun (setf paned-child1) (child paned)
-  (paned-pack1 paned child nil t)
-  child)
-
-(defun (setf paned-child2) (child paned)
-  (paned-pack2 paned child t t)
-  child)
-
-;; Defined in gtkglue.c
-(defbinding paned-child1 () widget
-  (paned paned)
-  (resize boolean :out)
-  (shrink boolean :out))
-
-;; Defined in gtkglue.c
-(defbinding paned-child2 () widget
-  (paned paned)
-  (resize boolean :out)
-  (shrink boolean :out))
-
-
 
 ;;; Layout