X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/112ac1d33aa8f9b7f3d2f9542d15431f152b1d35..88d2b3c2cc2f95bd7a03494f83cb56deaa07e944:/gtk/gtk.lisp diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index 16b0e4d..ed3c1ac 100644 --- a/gtk/gtk.lisp +++ b/gtk/gtk.lisp @@ -20,7 +20,7 @@ ;; 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.47 2005-11-15 10:08:13 espen Exp $ (in-package "GTK") @@ -44,7 +44,8 @@ (defun gtk-version () (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 @@ -78,6 +79,8 @@ (defbinding grab-get-current () widget) (defbinding grab-remove () nil (widget widget)) +(defbinding get-default-language () (copy-of pango:language)) + ;;; About dialog @@ -107,7 +110,7 @@ (defbinding %accel-group-connect () nil (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))) @@ -130,22 +133,45 @@ (defun accel-group-disconnect (group accelerator) (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) @@ -160,12 +186,35 @@ (defbinding %accelerator-parse () nil (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)) @@ -186,6 +235,9 @@ (defbinding (accelerator-default-modifier-mask "gtk_accelerator_get_default_mod_ ;;; Acccel label +(defbinding accel-label-get-accel-width () unsigned-int + (accel-label accel-label)) + (defbinding accel-label-refetch () boolean (accel-label accel-label)) @@ -193,7 +245,7 @@ (defbinding accel-label-refetch () boolean ;;; 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) @@ -201,12 +253,20 @@ (defbinding %accel-map-add-entry () nil (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) @@ -215,7 +275,7 @@ (defbinding %accel-map-change-entry () boolean (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 @@ -224,6 +284,29 @@ (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 @@ -234,7 +317,7 @@ (defbinding accel-map-unlock-path () nil -;;; Accessible +;;; Accessibility (defbinding accessible-connect-widget-destroyed () nil (accessible accessible)) @@ -618,6 +701,16 @@ (defbinding (dialog-set-alternative-button-order 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)) @@ -842,6 +935,11 @@ (defun create-image-widget (source &optional mask) ((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 @@ -1187,9 +1285,24 @@ (defbinding window-propagate-key-event () boolean (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)) @@ -1473,7 +1586,7 @@ (defbinding notebook-prev-page () 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)) @@ -1540,7 +1653,7 @@ (defun (setf notebook-menu-label) (menu-label notebook page) (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)) @@ -1548,7 +1661,7 @@ (defbinding notebook-query-tab-label-packing (notebook page) nil (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)) @@ -2156,7 +2269,7 @@ (defbinding tooltips-get-info-from-tip-window () boolean (current-widget widget :out)) -;;; Rc +;;; Resource Files (defbinding rc-add-default-file (filename) nil ((namestring (truename filename)) string))