X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/68f519e0e99a023834e3bc0db73ca3ae9e40d64a..34fe0eadb3d4711714ed683c3870c9e1ba5648aa:/gtk/gtk.lisp diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index af78c09..e7ee2ac 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.30 2005-01-12 13:38:18 espen Exp $ +;; $Id: gtk.lisp,v 1.34 2005-02-10 00:15:51 espen Exp $ (in-package "GTK") @@ -56,15 +56,115 @@ (defun clg-init (&optional display) (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)))) + (add-fd-handler (gdk:display-connection-number) :input #'main-iterate-all) + (setq *periodic-polling-function* #'main-iterate-all) + (setq *max-event-to-sec* 0) + (setq *max-event-to-usec* 1000)))) + + +;;; About dialog + +#+gtk2.6 +(progn + (def-callback-marshal %about-dialog-activate-link-func + (nil (dialog about-dialog) (link (copy-of string)))) + + (defbinding about-dialog-set-email-hook (function) nil + ((callback %about-dialog-activate-link-func) pointer) + ((register-callback-function function) unsigned-int) + ((callback user-data-destroy-func) pointer)) + + (defbinding about-dialog-set-url-hook (function) nil + ((callback %about-dialog-activate-link-func) pointer) + ((register-callback-function function) unsigned-int) + ((callback user-data-destroy-func) pointer))) ;;; Acccel group +(defbinding %accel-group-connect () nil + (accel-group accel-group) + (key unsigned-int) + (modifiers gdk:modifier-type) + (flags accel-flags) + (gclosure gclosure)) + +(defun accel-group-connect (group accelerator function &optional flags) + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (let ((gclosure (make-callback-closure function))) + (%accel-group-connect group key modifiers flags gclosure) + gclosure))) + +(defbinding accel-group-connect-by-path (group path function) nil + (group accel-group) + (path string) + ((make-callback-closure function) gclosure :return)) + +(defbinding %accel-group-disconnect (group gclosure) boolean + (group accel-group) + (gclosure gclosure)) + +(defbinding %accel-group-disconnect-key () boolean + (group accel-group) + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defun accel-group-disconnect (group accelerator) + (etypecase accelerator + (gclosure (%accel-group-disconnect group accelerator)) + (string + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (%accel-group-disconnect-key group key modifiers))))) + +(defbinding accel-group-lock () nil + (accel-group accel-group)) + +(defbinding accel-group-unlock () nil + (accel-group accel-group)) + +(defbinding %accel-groups-activate () boolean + (object gobject) + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defun accel-groups-activate (object accelerator) + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (%accel-groups-activate object key modifiers))) + +(defbinding accel-groups-from-object () (gslist accel-groups) + (object gobject)) + +(defbinding accelerator-valid-p (key &optional modifiers) boolean + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defbinding %accelerator-parse () nil + (accelerator string) + (key unsigned-int :out) + (modifiers gdk:modifier-type :out)) + +(defun accelerator-parse (accelerator) + (multiple-value-bind (key modifiers) (%accelerator-parse accelerator) + (if (zerop key) + (error "Invalid accelerator: ~A" accelerator) + (values key modifiers)))) + +(defbinding accelerator-name () string + (key unsigned-int) + (modifiers gdk:modifier-type)) + +#+gtk2.6 +(defbinding accelerator-get-label () string + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defbinding %accelerator-set-default-mod-mask () nil + (default-modifiers gdk:modifier-type)) + +(defun (setf accelerator-default-modifier-mask) (default-modifiers) + (%accelerator-set-default-mod-mask default-modifiers)) + +(defbinding (accelerator-default-modifier-mask "gtk_accelerator_get_default_mod_mask") () gdk:modifier-type) ;;; Acccel label @@ -73,6 +173,48 @@ (defbinding accel-label-refetch () boolean (accel-label accel-label)) + +;;; Accel map + +(defbinding %accel-map-add-entry () nil + (path string) + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defun accel-map-add-entry (path accelerator) + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (%accel-map-add-entry path key modifiers))) + +(defbinding accel-map-lookup-entry () boolean + (path string) + (key pointer)) ;accel-key)) + +(defbinding %accel-map-change-entry () boolean + (path string) + (key unsigned-int) + (modifiers gdk:modifier-type) + (replace boolean)) + +(defun accel-map-change-entry (path accelerator &optional replace) + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (%accel-map-change-entry path key modifiers replace))) + +(defbinding accel-map-load () nil + (filename pathname)) + +(defbinding accel-map-save () nil + (filename pathname)) + +(defbinding accel-map-get () accel-map) + +(defbinding accel-map-lock-path () nil + (path string)) + +(defbinding accel-map-unlock-path () nil + (path string)) + + + ;;; Accessible (defbinding accessible-connect-widget-destroyed () nil @@ -254,10 +396,6 @@ (defbinding check-menu-item-toggled () nil (check-menu-item check-menu-item)) - -;;; Clipboard - - ;;; Color selection (defbinding (color-selection-is-adjusting-p @@ -445,8 +583,8 @@ (defbinding dialog-set-response-sensitive (dialog response-id sensitive) nil (sensitive boolean)) #+gtk2.6 -(defbinding alternative-dialog-button-order-p(&optional screen) - (screen (or null screen))) +(defbinding alternative-dialog-button-order-p (&optional screen) boolean + (screen (or null gdk:screen))) #+gtk2.6 (defbinding (dialog-set-alternative-button-order @@ -497,7 +635,7 @@ (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)) + ((callback user-data-destroy-func) pointer)) (defbinding entry-completion-complete () nil (completion entry-completion)) @@ -632,17 +770,16 @@ (defbinding file-filter-add-pattern () nil #+gtk2.6 (defbinding file-filter-add-pixbuf-formats () nil - (filter file-filter) - (pattern string)) + (filter file-filter)) (def-callback-marshal %file-filter-func (boolean file-filter-info)) -(defbinding file-filter-add-custom () nil +(defbinding file-filter-add-custom (filter needed function) nil (filter file-filter) (needed file-filter-flags) ((callback %file-filter-func) pointer) ((register-callback-function function) unsigned-int) - ((callback %destroy-user-data) pointer)) + ((callback user-data-destroy-func) pointer)) (defbinding file-filter-get-needed () file-filter-flags (filter file-filter)) @@ -800,7 +937,7 @@ (defbinding menu-item-toggle-size-allocate () nil ;;; Menu tool button #+gtk2.6 -(defbinding menu-tool-button-set-arrow-tip () nil +(defbinding menu-tool-button-set-arrow-tooltip () nil (menu-tool-button menu-tool-button) (tooltips tooltips) (tip-text string) @@ -1746,7 +1883,7 @@ (defbinding editable-insert-text (editable text &optional (position 0)) nil (editable editable) (text string) ((length text) int) - (position position-type :in-out)) + (position position :in-out)) (defun editable-append-text (editable text) (editable-insert-text editable text nil)) @@ -1986,84 +2123,3 @@ (defbinding rc-reparse-all () nil) (defbinding rc-get-style () style (widget widget)) - - - -;;; Accelerator Groups -#| -(defbinding accel-group-activate (accel-group key modifiers) boolean - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type)) - -(defbinding accel-groups-activate (object key modifiers) boolean - (object object) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type)) - -(defbinding accel-group-attach () nil - (accel-group accel-group) - (object object)) - -(defbinding accel-group-detach () nil - (accel-group accel-group) - (object object)) - -(defbinding accel-group-lock () nil - (accel-group accel-group)) - -(defbinding accel-group-unlock () nil - (accel-group accel-group)) - - -;;; Accelerator Groups Entries - -(defbinding accel-group-get-entry (accel-group key modifiers) accel-entry - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type)) - -(defbinding accel-group-lock-entry (accel-group key modifiers) nil - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type)) - -(defbinding accel-group-unlock-entry (accel-group key modifiers) nil - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type)) - -(defbinding accel-group-add - (accel-group key modifiers flags object signal) nil - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type) - (flags accel-flags) - (object object) - ((name-to-string signal) string)) - -(defbinding accel-group-add (accel-group key modifiers object) nil - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type) - (object object)) - - -;;; Accelerator Signals - -(defbinding accel-group-handle-add - (object signal-id accel-group key modifiers flags) nil - (object object) - (signal-id unsigned-int) - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type) - (flags accel-flags)) - -(defbinding accel-group-handle-remove - (object accel-group key modifiers) nil - (object object) - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type)) -|#