;; 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.29 2005-01-06 21:05:46 espen Exp $
+;; $Id: gtk.lisp,v 1.34 2005-02-10 00:15:51 espen Exp $
(in-package "GTK")
(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
(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
(upper single-float))
+;;; Alignment
+
+(defbinding alignment-set () nil
+ (alognment alignment)
+ (x-align single-float)
+ (y-align single-float)
+ (x-scale single-float)
+ (y-scale single-float))
+
+(defbinding alignment-get-padding () nil
+ (alognment alignment)
+ (top unsigned-int :out)
+ (bottom unsigned-int :out)
+ (left unsigned-int :out)
+ (right unsigned-int :out))
+
+(defbinding alignment-set-padding () nil
+ (alognment alignment)
+ (top unsigned-int)
+ (bottom unsigned-int)
+ (left unsigned-int)
+ (right unsigned-int))
+
+
;;; Aspect frame
(check-menu-item check-menu-item))
-
-;;; Clipboard
-
-
;;; Color selection
(defbinding (color-selection-is-adjusting-p
(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
(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))
(index int))
+;;; File Chooser
+
+(defmethod initialize-instance ((file-chooser file-chooser) &rest initargs
+ &key filter filters shortcut-folder
+ shortcut-folders shortcut-folder-uti
+ shortcut-folder-uris)
+ (declare (ignore filter filters shortcut-folder shortcut-folders
+ shortcut-folder-uti shortcut-folder-uris))
+ (prog1
+ (call-next-method)
+ (initial-add file-chooser #'file-chooser-add-filter
+ initargs :filer :filters)
+ (initial-add file-chooser #'file-chooser-add-shortcut-folder
+ initargs :shortcut-folder :shortcut-folders)
+ (initial-add file-chooser #'file-chooser-add-shortcut-folder-uri
+ initargs :shortcut-folder-uri :shortcut-folders-uris)))
+
+
+(defbinding file-chooser-select-filename () boolean
+ (file-chooser file-chooser)
+ (filename string))
+
+(defbinding file-chooser-unselect-filename () nil
+ (file-chooser file-chooser)
+ (filename string))
+
+(defbinding file-chooser-select-all () boolean
+ (file-chooser file-chooser))
+
+(defbinding file-chooser-unselect-all () boolean
+ (file-chooser file-chooser))
+
+(defbinding file-chooser-get-filenames () (gslist string)
+ (file-chooser file-chooser))
+
+(defbinding file-chooser-select-uri () boolean
+ (file-chooser file-chooser)
+ (uri string))
+
+(defbinding file-chooser-unselect-uri () nil
+ (file-chooser file-chooser)
+ (uri string))
+
+(defbinding file-chooser-get-uris () (gslist string)
+ (file-chooser file-chooser))
+
+(defbinding file-chooser-add-filter () nil
+ (file-chooser file-chooser)
+ (filter file-filter))
+
+(defbinding file-chooser-remove-filter () nil
+ (file-chooser file-chooser)
+ (filter file-filter))
+
+(defbinding file-chooser-list-filters () (gslist file-filter)
+ (file-chooser file-chooser))
+
+(defbinding file-chooser-add-shortcut-folder () boolean
+ (file-chooser file-chooser)
+ (folder string)
+ (nil null))
+
+(defbinding file-chooser-remove-shortcut-folder () nil
+ (file-chooser file-chooser)
+ (folder string)
+ (nil null))
+
+(defbinding file-chooser-list-shortcut-folders () (gslist string)
+ (file-chooser file-chooser))
+
+(defbinding file-chooser-add-shortcut-folder-uri () boolean
+ (file-chooser file-chooser)
+ (uri string)
+ (nil null))
+
+(defbinding file-chooser-remove-shortcut-folder-uri () nil
+ (file-chooser file-chooser)
+ (uri string)
+ (nil null))
+
+(defbinding file-chooser-list-shortcut-folder-uris () (gslist string)
+ (file-chooser file-chooser))
+
+
+;;; File Filter
+
+(defmethod initialize-instance ((file-filter file-filter) &rest initargs
+ &key mime-type mime-types pattern patterns
+ pixbuf-formats)
+ (declare (ignore mime-type mime-types pattern patterns))
+ (prog1
+ (call-next-method)
+ (when pixbuf-formats
+ #-gtk2.6(warn "Initarg :PIXBUF-FORMATS not supportet in this version of Gtk")
+ #+gtk2.6(file-filter-add-pixbuf-formats file-filter))
+ (initial-add file-filter #'file-filter-add-mime-type
+ initargs :mime-type :mime-types)
+ (initial-add file-filter #'file-filter-add-pattern
+ initargs :pattern :patterns)))
+
+
+(defbinding file-filter-add-mime-type () nil
+ (filter file-filter)
+ (mime-type string))
+
+(defbinding file-filter-add-pattern () nil
+ (filter file-filter)
+ (pattern string))
+
+#+gtk2.6
+(defbinding file-filter-add-pixbuf-formats () nil
+ (filter file-filter))
+
+(def-callback-marshal %file-filter-func (boolean file-filter-info))
+
+(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 user-data-destroy-func) pointer))
+
+(defbinding file-filter-get-needed () file-filter-flags
+ (filter file-filter))
+
+(defbinding file-filter-filter () boolean
+ (filter file-filter)
+ (filter-info file-filter-info))
+
+
+
;;; Image
(defbinding image-set-from-file () 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)
;;; Notebook
-(defun %notebook-position (notebook page)
+(defun %ensure-notebook-position (notebook page)
(etypecase page
- (int page)
- (keyword (case page
- (:first 0)
- (:last -1)
- (t (error "Invalid position keyword: ~A" page))))
+ (position page)
(widget (notebook-page-num notebook page t))))
-(defun %notebook-child (notebook position)
+(defun %ensure-notebook-child (notebook position)
(typecase position
(widget position)
- (t (notebook-nth-page-child notebook position))))
-
+ (t (notebook-get-nth-page notebook position))))
(defbinding (notebook-insert "gtk_notebook_insert_page_menu")
(notebook position child tab-label &optional menu-label) nil
((if (stringp menu-label)
(make-instance 'label :label menu-label)
menu-label) (or null widget))
- ((%notebook-position notebook position) int))
+ ((%ensure-notebook-position notebook position) position))
(defun notebook-append (notebook child tab-label &optional menu-label)
(notebook-insert notebook :last child tab-label menu-label))
(defbinding notebook-remove-page (notebook page) nil
(notebook notebook)
- ((%notebook-position notebook page) int))
+ ((%ensure-notebook-position notebook page) position))
(defbinding %notebook-page-num () int
(notebook notebook)
(let ((page-num (%notebook-page-num notebook child)))
(if (= page-num -1)
(when error-p
- (error "~A is not a child of ~A" child notebook))
+ (error "~A is not a page in ~A" child notebook))
page-num)))
(defbinding notebook-next-page () nil
(defbinding notebook-popup-disable () nil
(notebook notebook))
-(defbinding (notebook-nth-page-child "gtk_notebook_get_nth_page")
- (notebook page) widget
+(defbinding notebook-get-nth-page () widget
(notebook notebook)
- ((case page
- (:first 0)
- (:last -1)
- (t page)) int))
-
-
-(defbinding %notebook-get-current-page () int
- (notebook notebook))
+ (page position))
-(defun notebook-current-page-num (notebook)
- (let ((num (%notebook-get-current-page notebook)))
- (when (>= num 0)
- num)))
-
-(defun notebook-current-page (notebook)
- (let ((page-num (notebook-current-page-num notebook)))
- (when page-num
- (notebook-nth-page-child notebook page-num))))
-
-(defbinding %notebook-set-current-page () nil
- (notebook notebook)
- (page-num int))
+(defun %notebook-current-page (notebook)
+ (when (slot-boundp notebook 'current-page-num)
+ (notebook-get-nth-page notebook (notebook-current-page-num notebook))))
(defun (setf notebook-current-page) (page notebook)
- (%notebook-set-current-page notebook (%notebook-position notebook page))
- page)
-
+ (setf (notebook-current-page notebook) (notebook-page-num notebook page)))
(defbinding (notebook-tab-label "gtk_notebook_get_tab_label")
(notebook page) widget
(notebook notebook)
- ((%notebook-child notebook page) widget))
+ ((%ensure-notebook-child notebook page) widget))
(defbinding (notebook-tab-label-text "gtk_notebook_get_tab_label_text")
(notebook page) (copy-of string)
(notebook notebook)
- ((%notebook-child notebook page) widget))
+ ((%ensure-notebook-child notebook page) widget))
(defbinding %notebook-set-tab-label () nil
(notebook notebook)
(let ((widget (if (stringp tab-label)
(make-instance 'label :label tab-label)
tab-label)))
- (%notebook-set-tab-label notebook (%notebook-child notebook page) widget)
+ (%notebook-set-tab-label notebook (%ensure-notebook-child notebook page) widget)
widget))
(defbinding (notebook-menu-label "gtk_notebook_get_menu_label")
(notebook page) widget
(notebook notebook)
- ((%notebook-child notebook page) widget))
+ ((%ensure-notebook-child notebook page) widget))
(defbinding (notebook-menu-label-text "gtk_notebook_get_menu_label_text")
(notebook page) (copy-of string)
(notebook notebook)
- ((%notebook-child notebook page) widget))
+ ((%ensure-notebook-child notebook page) widget))
(defbinding %notebook-set-menu-label () nil
(notebook notebook)
(let ((widget (if (stringp menu-label)
(make-instance 'label :label menu-label)
menu-label)))
- (%notebook-set-menu-label notebook (%notebook-child notebook page) widget)
+ (%notebook-set-menu-label notebook (%ensure-notebook-child notebook page) widget)
widget))
(defbinding layout-put () nil
(layout layout)
- (widget widget)
+ (child widget)
(x int)
(y int))
(defbinding layout-move () nil
(layout layout)
- (widget widget)
+ (child widget)
(x int)
(y int))
+(defbinding layout-set-size () nil
+ (layout layout)
+ (width unsigned-int)
+ (height unsigned-int))
+
+(defbinding layout-get-size () nil
+ (layout layout)
+ (width unsigned-int :out)
+ (height unsigned-int :out))
;;; Menu shell
(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))
(position single-float)
(max-size single-float))
-(defbinding ruler-draw-ticks () nil
- (ruler ruler))
-
-(defbinding ruler-draw-pos () nil
- (ruler ruler))
+(defbinding ruler-get-range () nil
+ (ruler ruler)
+ (lower single-float :out)
+ (upper single-float :out)
+ (position single-float :out)
+ (max-size single-float :out))
;;; Scale
-; (defbinding scale-draw-value () nil
-; (scale scale))
-
+(defbinding scale-get-layout-offsets () nil
+ (scale scale)
+ (x int :out)
+ (y int :out))
;;; Progress bar
(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))
-|#
~mdw / clg / blobdiff