anchor.diff:  ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
   ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
   
  -;; $Id: pixbuf.lisp,v 1.8 2008-04-30 18:04:09 espen Exp $
  +;; $Id: pixbuf.lisp,v 1.9 2008-12-10 03:01:34 espen Exp $
   
   
   (in-package "GDK")
   
  -(defbinding pixbuf-get-option () (copy-of string)
  -  (pixbuf pixbuf)
  -  (key string))
  -
  -(defbinding %pixbuf-new-from-file () (or null (referenced pixbuf))
  +(defbinding %pixbuf-new () pointer
  +  colorspace 
  +  (has-alpha boolean)
  +  (bits-per-sample int)
  +  (width int)
  +  (height int))
  +
  +(defbinding %pixbuf-new-from-data () pointer
  +  (data pointer)
  +  colorspace 	    
  +  (has-alpha boolean)
  +  (bits-per-sample int)
  +  (width int)
  +  (height int)
  +  (rowstride int)
  +  (nil null)
  +  (nil null))
  +
  +(defbinding %pixbuf-new-from-xpm-data () pointer
  +  (data (vector string)))
  +
  +(defbinding %pixbuf-new-from-file () pointer
     (filename pathname)
     (nil (or null gerror) :out))
   
  -(defbinding %pixbuf-new-from-file-at-size () (or null (referenced pixbuf))
  +(defbinding %pixbuf-new-from-file-at-size () pointer
     (filename pathname)
     (width int)
     (height int)
     (nil (or null gerror) :out))
   
   #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  -(defbinding %pixbuf-new-from-file-at-scale () (or null (referenced pixbuf))
  +(defbinding %pixbuf-new-from-file-at-scale () pointer
     (filename pathname)
     (width int)
     (height int)
     (preserve-aspect-ratio boolean)
     (nil (or null gerror) :out))
   
  -(defun pixbuf-load (filename &key width height size (preserve-aspect-ratio t))
  -  #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  -  (unless preserve-aspect-ratio 
  -    (warn ":preserve-aspect-ratio not supported with this version of Gtk"))
  -
  -  (multiple-value-bind (pixbuf gerror)
  +(defun %pixbuf-load (filename width height preserve-aspect-p)
  +  (multiple-value-bind (location gerror)
         (cond
  -       (size 
  -	#?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  -	(%pixbuf-new-from-file-at-size filename size size)
  -	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  -	(%pixbuf-new-from-file-at-scale filename size size preserve-aspect-ratio))
  -       ((and width height)
  -	#?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  -	(%pixbuf-new-from-file-at-size filename width height)
  -	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  -	(%pixbuf-new-from-file-at-scale filename width height preserve-aspect-ratio))
  -       ((or width height)
  -	(error "Both :width and :height must be specified"))
  -       (t (%pixbuf-new-from-file filename)))
  +	((and width height)
  +	 (%pixbuf-new-from-file-at-size filename width height))
  +	((or width height)
  +	 #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  +	 (error "Both :width and :height must be specified")
  +	 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  +	 (%pixbuf-new-from-file-at-scale filename 
  +	  (or width -1) (or height -1) preserve-aspect-p))
  +	(t (%pixbuf-new-from-file filename)))
       (if gerror
   	(signal-gerror gerror)
  -      pixbuf)))
  +      location)))
  +
  +#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.14.0")
  +(progn
  +  (defbinding %pixbuf-new-from-stream () pointer
  +    gio:input-stream-designator
  +    (nil (or null gio:cancellable))
  +    (nil (or null gerror) :out))
  +
  +  (defbinding %pixbuf-new-from-stream-at-scale () pointer
  +    gio:input-stream-designator
  +    (width int)
  +    (height int)
  +    (preserve-aspect-ratio boolean)
  +    (nil (or null gio:cancellable))
  +    (nil (or null gerror) :out))
  +
  +  (defun %load-from-stream (stream width height preserve-aspect-p)
  +    (multiple-value-bind (location gerror)
  +	(cond
  +	  ((or width height)
  +	   (%pixbuf-new-from-stream-at-scale stream
  +	    (or width -1) (or height -1) preserve-aspect-p))
  +	  (t (%pixbuf-new-from-stream stream)))
  +      (if gerror
  +	  (signal-gerror gerror)
  +	location))))
  +
  +(defmethod allocate-foreign ((pixbuf pixbuf) &key source (bits-per-sample 8)
  +			     (colorspace :rgb) (has-alpha t) width height 
  +			     (preserve-aspect-ratio t) destroy stride)
  +  (cond
  +   ((not source) 
  +    (%pixbuf-new colorspace has-alpha bits-per-sample width height))
  +   ((typep source 'pointer)
  +    ;; TODO: destory
  +    (%pixbuf-new-from-data source colorspace has-alpha bits-per-sample width height (or stride (* width (if has-alpha 4 3)))))
  +   ((and (vectorp source) (stringp (aref source 0)))
  +    (%pixbuf-new-from-xpm-data source))
  +   ((typep source 'vector)
  +
  +    )
  +   ((or (pathnamep source) (stringp source))
  +    #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  +    (unless preserve-aspect-ratio 
  +      (warn ":preserve-aspect-ratio not supported with this version of Gtk"))
  +    (%pixbuf-load source width height preserve-aspect-ratio))
  +   #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.14.0")
  +   ((typep source 'gio:input-stream-designator)
  +    (%load-from-stream source width height preserve-aspect-ratio))
  +   ((call-next-method))))
  +
  +
  +(defbinding (pixbuf-subpixbuf "gdk_pixbuf_new_subpixbuf") () 
  +    (or null (referenced pixbuf))
  +  pixbuf (src-x int) (src-y int) (width int) (height int))
  +
  +(defbinding pixbuf-copy () (or null (referenced pixbuf))
  +  pixbuf)
  +
  +
  +(defbinding pixbuf-get-option () (copy-of string)
  +  (pixbuf pixbuf)
  +  (key string))
  +
  +(defun pixbuf-load (filename &key width height size (preserve-aspect-ratio t))
  +  (make-instance 'pixbuf :source filename 
  +   :width (or size width) :height (or size height)
  +   :preserve-aspect-ratio preserve-aspect-ratio))
   
   
   ;; (defbinding pixbuf-get-file-info () (copy-of pixbuf-format)
  
positive.code:   (red (unsigned 8))
    (green (unsigned 8))
    (blue (unsigned 8)))
  
negative.code: 	   (symbol (string-downcase value))
  	   (number (format nil "~A" value)))
  	 values))
      (values keys values)))
  
  (defgeneric pixbuf-save (pixbuf dest type &rest options))
  
  (defmethod pixbuf-save (pixbuf (filename string) type &rest options)
    (multiple-value-bind (ok-p gerror)
        (multiple-value-call #'%pixbuf-savev 
         pixbuf filename (string-downcase type) 
         (%pixbuf-save-options options))
      (unless ok-p
        (signal-gerror gerror))))
  
  (defmethod pixbuf-save (pixbuf (pathname pathname) type &rest options)
    (apply #'pixbuf-save pixbuf (namestring (translate-logical-pathname pathname))
     type options))
  
  (define-callback stream-write-func boolean 
      ((data pointer) (length gsize) (gerror pointer) (stream-id pointer-data))
    (block stream-write
      (handler-case
  	(let ((stream (find-user-data stream-id)))
  	  (write-sequence
  	   (map-c-vector 'vector 'identity data '(unsigned-byte 8) length)
  	   stream))
        (serious-condition (condition)
  	(gerror-set-in-callback gerror (file-error-domain) 
  	 (enum-int :failed 'file-error-enum) (princ-to-string condition))
  	(return-from stream-write nil)))
      t))
  
  (defbinding %pixbuf-save-to-callbackv (pixbuf stream type keys values) boolean
    (pixbuf pixbuf)
    (stream-write-func callback)
    (stream pointer-data)
    (type string)
    (keys strings)
    (values strings)
    (nil (or null gerror) :out))
  
  (defmethod pixbuf-save (pixbuf (stream stream) type &rest options)
    (let ((stream-id (register-user-data stream)))
      (unwind-protect
  	 (multiple-value-bind (ok-p gerror)
  	     (multiple-value-call #'%pixbuf-save-to-callbackv
  	       pixbuf stream-id (string-downcase type) 
  	       (%pixbuf-save-options options))
  	   (unless ok-p
  	     (signal-gerror gerror)))
        (destroy-user-data stream-id))))
  
  
  ;; (defbinding pixbuf-new-from-xpm-data () (referenced pixbuf)
  ;;   (data (vector string)))
  
  (defbinding %pixbuf-new-subpixbuf () pixbuf ;; or (referenced pixbuf)?
    (pixbuf pixbuf)
  