X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/2e852f7b0dc57966cfad557ebf0f9a962bb28882..3a63ef2a6c503a66bf1559fc60f5e3e07d0838be:/gtk/gtk.lisp diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index 0f7426d..9d4a734 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.26 2004-12-21 00:15:19 espen Exp $ (in-package "GTK") @@ -329,12 +329,10 @@ (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 @@ (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 @@ (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 @@ (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 @@ ((%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 @@ (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 @@ (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 @@ -1043,27 +1127,6 @@ (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