;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gtk.lisp,v 1.42 2005-04-23 16:48:51 espen Exp $
+;; $Id: gtk.lisp,v 1.51 2006-02-08 22:21:07 espen Exp $
(in-package "GTK")
(format nil "Gtk+ v~A.~A" major minor)
(format nil "Gtk+ v~A.~A.~A" major minor micro))))
-(defbinding get-default-language () (copy-of pango:language))
+(defun clg-version ()
+ "clg 0.91 version")
;;;; Initalization
(defbinding grab-remove () nil
(widget widget))
+(defbinding get-default-language () (copy-of pango:language))
+
;;; About dialog
(gclosure gclosure))
(defun accel-group-connect (group accelerator function &optional flags)
- (multiple-value-bind (key modifiers) (accelerator-parse accelerator)
+ (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
(let ((gclosure (make-callback-closure function)))
(%accel-group-connect group key modifiers flags gclosure)
gclosure)))
(etypecase accelerator
(gclosure (%accel-group-disconnect group accelerator))
(string
- (multiple-value-bind (key modifiers) (accelerator-parse accelerator)
+ (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
(%accel-group-disconnect-key group key modifiers)))))
+(defbinding %accel-group-query () (copy-of (vector (inlined accel-group-entry) n))
+ (accel-group accel-group)
+ (key unsigned-int)
+ (modifiers gdk:modifier-type)
+ (n int :out))
+
+(defun accel-group-query (accel-group accelerator)
+ (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
+ (%accel-group-query accel-group key modifiers)))
+
+(defbinding %accel-group-activate () boolean
+ (accel-group accel-group)
+ (acceleratable gobject)
+ (key unsigned-int)
+ (modifiers gdk:modifier-type))
+
+(defun accel-group-activate (accel-group acceleratable accelerator)
+ (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
+ (%accel-group-activate accel-group acceleratable key modifiers)))
+
(defbinding accel-group-lock () nil
(accel-group accel-group))
(defbinding accel-group-unlock () nil
(accel-group accel-group))
+(defbinding accel-group-from-accel-closure () accel-group
+ (closure gclosure))
+
(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)
+ (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
(%accel-groups-activate object key modifiers)))
(defbinding accel-groups-from-object () (gslist accel-groups)
(key unsigned-int :out)
(modifiers gdk:modifier-type :out))
-(defun accelerator-parse (accelerator)
+(defgeneric parse-accelerator (accelerator))
+
+(defmethod parse-accelerator ((accelerator string))
(multiple-value-bind (key modifiers) (%accelerator-parse accelerator)
(if (zerop key)
(error "Invalid accelerator: ~A" accelerator)
(values key modifiers))))
+(defmethod parse-accelerator ((accelerator cons))
+ (destructuring-bind (key modifiers) accelerator
+ (values
+ (etypecase key
+ (integer key)
+ (string
+ (or
+ (gdk:keyval-from-name key)
+ (error "Invalid key name: ~A" key)))
+ (character (parse-accelerator key)))
+ modifiers)))
+
+(defmethod parse-accelerator ((key integer))
+ key)
+
+(defmethod parse-accelerator ((key character))
+ (or
+ (gdk:keyval-from-name (string key))
+ (error "Invalid key name: ~A" key)))
+
+
(defbinding accelerator-name () string
(key unsigned-int)
(modifiers gdk:modifier-type))
;;; Acccel label
+(defbinding accel-label-get-accel-width () unsigned-int
+ (accel-label accel-label))
+
(defbinding accel-label-refetch () boolean
(accel-label accel-label))
;;; Accel map
-;(defbinding (accel-map-init "_gtk_accel_map_init") () nil)
+(defbinding (accel-map-init "_gtk_accel_map_init") () nil)
(defbinding %accel-map-add-entry () nil
(path string)
(modifiers gdk:modifier-type))
(defun accel-map-add-entry (path accelerator)
- (multiple-value-bind (key modifiers) (accelerator-parse accelerator)
+ (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
(%accel-map-add-entry path key modifiers)))
-(defbinding accel-map-lookup-entry () boolean
+(defbinding %accel-map-lookup-entry () boolean
(path string)
- (key pointer)) ;accel-key))
+ ((make-instance 'accel-key) accel-key :return))
+
+(defun accel-map-lookup-entry (path)
+ (multiple-value-bind (found-p accel-key) (%accel-map-lookup-entry path)
+ (when found-p
+ (values
+ (slot-value accel-key 'key)
+ (slot-value accel-key 'modifiers)
+ (slot-value accel-key 'flags)))))
(defbinding %accel-map-change-entry () boolean
(path string)
(replace boolean))
(defun accel-map-change-entry (path accelerator &optional replace)
- (multiple-value-bind (key modifiers) (accelerator-parse accelerator)
+ (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
(%accel-map-change-entry path key modifiers replace)))
(defbinding accel-map-load () nil
(defbinding accel-map-save () nil
(filename pathname))
+(defcallback %accel-map-foreach-func
+ (nil
+ (callback-id unsigned-int) (accel-path (copy-of string))
+ (key unsigned-int) (modifiers gdk:modifier-type) (changed boolean))
+ (invoke-callback callback-id nil accel-path key modifiers changed))
+
+(defbinding %accel-map-foreach (callback-id) nil
+ (callback-id unsigned-int)
+ (%accel-map-foreach-func callback))
+
+(defbinding %accel-map-foreach-unfiltered (callback-id) nil
+ (callback-id unsigned-int)
+ (%accel-map-foreach-func callback))
+
+(defun accel-map-foreach (function &optional (filter-p t))
+ (with-callback-function (id function)
+ (if filter-p
+ (%accel-map-foreach id)
+ (%accel-map-foreach-unfiltered id))))
+
+(defbinding accel-map-add-filter () nil
+ (filter string))
+
(defbinding accel-map-get () accel-map)
(defbinding accel-map-lock-path () nil
-;;; Accessible
+;;; Accessibility
(defbinding accessible-connect-widget-destroyed () nil
(accessible accessible))
new-order) (vector int)))
+#+gtk2.8
+(progn
+ (defbinding %dialog-get-response-for-widget () int
+ (dialog dialog)
+ (widget widget))
+
+ (defun dialog-get-response-for-widget (dialog widget)
+ (dialog-find-response dialog (dialog-get-response-for-widget dialog widget))))
+
+
(defmethod container-add ((dialog dialog) (child widget) &rest args)
(apply #'container-add (dialog-vbox dialog) child args))
((or list vector) (make-instance 'image :pixmap source))
(gdk:pixmap (make-instance 'image :pixmap source :mask mask))))
+#+gtk2.8
+(defbinding image-clear () nil
+ (image image))
+
+
;;; Image menu item
flags text #+gtk 2.6 secondary-text
transient-parent)
(setf
- (slot-value dialog 'location)
+ (foreign-location dialog)
(%message-dialog-new transient-parent flags message-type buttons))
(when text
(message-dialog-set-markup dialog text))
(window window)
(event gdk:key-event))
+#-gtk2.8
(defbinding window-present () nil
(window window))
+#+gtk2.8
+(progn
+ (defbinding %window-present () nil
+ (window window))
+
+ (defbinding %window-present-with-time () nil
+ (window window)
+ (timespamp unsigned-int))
+
+ (defun window-present (window &optional timestamp)
+ (if timestamp
+ (%window-present-with-time window timestamp)
+ (%window-present window))))
+
(defbinding window-iconify () nil
(window window))
(window window)
(left int :out) (top int :out) (rigth int :out) (bottom int :out))
-(defbinding %window-get-icon-list () (glist gdk:pixbuf)
+(defbinding %window-get-icon-list () (glist (copy-of gdk:pixbuf))
(window window))
(defbinding window-get-position () nil
(defbinding notebook-reorder-child (notebook child position) nil
(notebook notebook)
(child widget)
- ((%notebook-position notebook position) int))
+ ((%ensure-notebook-position notebook position) int))
(defbinding notebook-popup-enable () nil
(notebook notebook))
(defbinding notebook-query-tab-label-packing (notebook page) nil
(notebook notebook)
- ((%notebook-child notebook page) widget)
+ ((%ensure-notebook-child notebook page) widget)
(expand boolean :out)
(fill boolean :out)
(pack-type pack-type :out))
(defbinding notebook-set-tab-label-packing
(notebook page expand fill pack-type) nil
(notebook notebook)
- ((%notebook-child notebook page) widget)
+ ((%ensure-notebook-child notebook page) widget)
(expand boolean)
(fill boolean)
(pack-type pack-type))
(defun stock-lookup (stock-id)
(let ((location
- (allocate-memory (proxy-instance-size (find-class 'stock-item)))))
+ (allocate-memory (foreign-size (find-class 'stock-item)))))
(unwind-protect
(when (%stock-lookup stock-id location)
(ensure-proxy-instance 'stock-item (%stock-item-copy location)))
(current-widget widget :out))
-;;; Rc
+;;; Resource Files
(defbinding rc-add-default-file (filename) nil
((namestring (truename filename)) string))
~mdw / clg / blobdiff