ift-icon-dialog-item.lisp

[liberte@cs.uiuc.edu (Daniel LaLiberte)]

Here is an extension to the Interface Tools to give you icon buttons
based on icon-dialog-items found in the Examples folder.  There is not
much to it, so maybe this will be an inspiration for people to add
extensions for other dialog items.  One thing I would really like is
a popup menu.

Dan LaLiberte
liberte@cs.uiuc.edu
(Join the League for Programming Freedom: league@prep.ai.mit.edu)
--------
;;; Extension to IFT for icon-dialog-items
;;; I use oodles-of-utils to set up the resource file where the icon resides.

;;; Problem: make sure you are using a valid icon resource ID or you 
;;; may crash MCL or worse.

(in-package :interface-tools)

(require 'icon-dialog-item)

;; Fixes to icon-dialog-item.lisp
(defmethod ccl::view-default-size ((view ccl:icon-dialog-item))
  #@(32 32))

(defmethod ccl::set-view-size :before ((view ccl:icon-dialog-item) h &optional v)
  (declare (ignore h v))
  (invalidate-view view))


;;;; Extensions to IFT for icon-dialog-item ;;;;;

(add-editable-dialog-item (make-instance 'ccl:icon-dialog-item
                                         :icon ccl:*note-icon*))
;; (remove-editable-dialog-item 'ccl:icon-dialog-item)
;; (remove-editable-dialog-item 'ccl:array-dialog-item)


(defmethod add-editor-items :after ((icon-item ccl:icon-dialog-item) editor)
  (let* ((position *editor-items-start-pos*)
         (size #@(116 16))
         (delta (make-point 0 (+ (point-v size) 5))))
    (add-subviews 
     editor
     (make-dialog-item 'check-box-dialog-item
                         position size "Color Icon"
                         #'(lambda (item)
                             (setf (ccl::color-p icon-item)
                                   (check-box-checked-p item))
                             (invalidate-view icon-item t)
                             )
                         :check-box-checked-p (ccl::color-p icon-item))
     (make-dialog-item 'button-dialog-item
                       (setq position (add-points position delta))
                       size "Set icon #"
                       #'(lambda (item)
                             (declare (ignore item))
                             (setf (ccl::icon icon-item)
                                   (read-from-string
                                    (get-string-from-user
                                     "Please enter a new icon number for the icon."
                                     :initial-string
                                     (format nil "~s" (ccl::icon icon-item)))))
                             (invalidate-view icon-item t)
                             ))
     )))


(defmethod object-source-code ((item ccl:icon-dialog-item))
  (nconc (call-next-method)
         `(:color-p ,(ccl::color-p item))
         `(:icon ,(ccl::icon item))
         ))