From 73d58e01fa0bfd1eaa85bf893370e2f46d0debc4 Mon Sep 17 00:00:00 2001 Message-Id: <73d58e01fa0bfd1eaa85bf893370e2f46d0debc4.1714610818.git.mdw@distorted.org.uk> From: Mark Wooding Date: Sat, 4 Dec 2004 00:34:49 +0000 Subject: [PATCH] Added more functions for stock items and a few other changes Organization: Straylight/Edgeware From: espen --- gtk/gtk.lisp | 45 +++++++++++++++++++++++++++++++++++++++------ 1 file changed, 39 insertions(+), 6 deletions(-) diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index 85eced1..88135b7 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.19 2004-11-21 17:39:27 espen Exp $ +;; $Id: gtk.lisp,v 1.20 2004-12-04 00:34:49 espen Exp $ (in-package "GTK") @@ -650,6 +650,14 @@ (defbinding toggle-button-toggled () nil ;;; Window +(defmethod initialize-instance ((window window) &rest initargs &key accel-group) + (declare (ignore accel-group)) + (call-next-method) + (mapc #'(lambda (accel-group) + (window-add-accel-group window accel-group)) + (get-all initargs :accel-group))) + + (defbinding window-set-wmclass () nil (window window) (wmclass-name string) @@ -676,7 +684,8 @@ (defbinding window-set-default-size (window width height) int ;(defbinding window-set-geometry-hints) -(defbinding window-list-toplevels () (glist window)) +(defbinding window-list-toplevels () (glist (copy-of window)) + "Returns a list of all existing toplevel windows.") (defbinding window-add-mnemonic (window key target) nil (window window) @@ -1497,11 +1506,35 @@ (defbinding progress-bar-pulse () nil ;;; Stock items -(defbinding stock-lookup () boolean - (stock-id string) - ((make-instance 'stock-item) stock-item :return)) - +(defbinding %stock-item-copy () pointer + (location pointer)) + +(defbinding %stock-item-free () nil + (location pointer)) +(defmethod reference-foreign ((class (eql (find-class 'stock-item))) location) + (%stock-item-copy location)) + +(defmethod unreference-foreign ((class (eql (find-class 'stock-item))) location) + (%stock-item-free location)) + +(defbinding stock-add (stock-item) nil + (stock-item stock-item) + (1 unsigned-int)) + +(defbinding stock-list-ids () (gslist string)) + +(defbinding %stock-lookup () boolean + (stock-id string) + (location pointer)) + +(defun stock-lookup (stock-id) + (let ((location + (allocate-memory (proxy-instance-size (find-class 'stock-item))))) + (unwind-protect + (when (%stock-lookup stock-id location) + (ensure-proxy-instance 'stock-item (%stock-item-copy location))) + (deallocate-memory location)))) ;;; Tooltips -- [mdw]