;;;-*- Mode: Lisp; Package: CCL -*-
;;;
;;; window-header.lisp
;;;
;;; Provides a set-window-header method to present information about a window's contents in
;;; a header at the top of the window's content area. Uses the modern look & feel 
;;; of the Appearance Manager with bacward compatability for pre MacOS 8.
;;;
;;; Copyright ©1999 Terje Norderhaug and Media Design inĄProgress
;;;
;;; Use and copying of this software and preparation of derivative works
;;; based upon this software are permitted, so long as this copyright 
;;; notice is included intact.
;;;
;;; This software is made available AS IS, and no warranty is made about 
;;; the software or its performance. 
;;;
;;; Author: Terje Norderhaug <terje@in-progress.com> of Media Design in*Progress.
;;;
;;; Latest version available from <http://www.in-progress.com/src/window-header.lisp>.
;;; Tested on MCL 4.2, but should also work with other recent versions of MCL.
;;; Should normally be used with the Appearance Manager extension to MCL by Eric Russell.
;;;
;;; For technical details, see:
;; http://developer.apple.com/techpubs/macos8/HumanInterfaceToolbox/AppManager/ProgWithAppearanceMgr/Appearance.6a.html#13607

#| VERSION HISTORY:

2001-Aug-03 Terje  Changed kThemeStateDisabled to kThemeStateInactive (suggested by Takehiko Abe)
2000-Jun-16 Terje  Fixed positioning of text to allow multiple headers (syggested by Barry Perryman) 
1999-Nov-07 Terje  window-header keyword has default value.
1999-Aug-13 Terje  Version 1.0 released

|#

(in-package :ccl)

(require :appearance "ccl:interfaces;appearance")
(require :appearance-manager)
(require :appearance-activity-mixin)

(export 'window-header-mixin)
(export 'set-window-header)
(export 'update-window-header)

(defconstant TRAPS::$kThemeStateInactive 0) ;; MCL 4.3 appearance interface fails to define this constant!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WINDOW HEADER MIXIN

(defclass window-header-mixin ()
  ((header-subview :initform NIL)
   (window-header :initarg :window-header :initform NIL)) 
  (:documentation "Mixin that makes a window maintain a header"))

(defmethod initialize-instance :after ((window window-header-mixin) &key)
  (update-window-header window))

(defmethod generate-window-header ((window window-header-mixin))
  (with-slots (window-header) window
    (etypecase window-header
      (string window-header)
      (null "")
      ((or function symbol) (or (funcall window-header window) "")))))

(defmethod set-window-header ((window window-header-mixin) new-header) 
  "Sets the window's header to the new header"
  (setf (slot-value window 'window-header) new-header)
  (update-window-header window))

(defmethod update-window-header (window)
  "No action so that the update can be called for any window class"
  (declare (ignore window))
  NIL)

(defmethod update-window-header ((window window-header-mixin))
  "Updates the header display if the window header has changed"
  (with-slots (header-subview) window
    (unless header-subview
      (setf header-subview
        (make-instance 'window-header-dialog-item))
      (add-subviews window header-subview))
    (let ((new-header (generate-window-header window)))
      (unless (equal (dialog-item-text header-subview) new-header)
        (set-dialog-item-text header-subview new-header)))))

(defmethod window-size-parts :before ((window window-header-mixin))
  (with-slot-values (header-subview) window
    (when header-subview
      (set-view-size header-subview 
        (point-h (view-size window)) 
        (point-v (view-size header-subview))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WINDOW HEADER DIALOG ITEM

(defclass window-header-dialog-item (appearance-activity-mixin dialog-item)
  ((list-header-p :initarg :list-header-p :initform NIL 
     :documentation "Set to true if the dialog item is used as header for other dialog items"))
  (:default-initargs
   :view-position #@(0 0)
   :view-font '("Geneva" 9)))

(defmethod view-default-size ((item window-header-dialog-item))
  (if (view-window item)
    (make-point (point-h (view-size (view-window item))) 20)
    #@(0 20)))

(defmethod view-draw-contents ((item window-header-dialog-item))
  (with-item-rect (rect item)
    (#_InsetRect rect -1 -1)
    (with-slot-values (list-header-p) item
      (cond
        ((appearance-available-p)
           (if list-header-p
             (#_DrawThemeWindowListViewHeader rect (if (window-active-p (view-window item))
                                                   #$kThemeStateActive #$kThemeStateInactive))
             (#_DrawThemeWindowHeader rect (if (window-active-p (view-window item))
                                             #$kThemeStateActive #$kThemeStateInactive))))
        (T
           (#_eraserect rect)
           (with-fore-color (if (draw-active-p item)
                              *black-color* *gray-color*)
             (unless list-header-p
               (#_moveto (rref rect rect.left) (- (rref rect rect.bottom) 3))
               (#_lineto (rref rect rect.right)(- (rref rect rect.bottom) 3)))
             (#_moveto (rref rect rect.left) (1- (rref rect rect.bottom)))
             (#_lineto (rref rect rect.right)(1- (rref rect rect.bottom)))))))
    (with-font-focused-view item
      (with-fore-color (if (draw-active-p item)
                         *black-color* *gray-color*)
        (with-cstrs ((text (dialog-item-text item)))
         (when text
          (let* ((length (length (dialog-item-text item)))
                 (str-width (#_TextWidth text 0 length))
                 (rect-left (rref rect rect.left))
                 (rect-right (rref rect rect.right))
                 (box-width (- rect-right rect-left))
                 (diff (- box-width str-width)))
              (#_MoveTo (ash diff -1) 13) ; (#_MoveTo (+ rect-left (ash diff -1)) 13)
              (#_DrawText text 0 length))))))))

(defmethod set-view-size :after ((item window-header-dialog-item) h &optional v)
  (declare (ignore h v))
  (invalidate-view item))

(defmethod view-corners ((item window-header-dialog-item))
  (multiple-value-call #'inset-corners #@(-1 -1) (call-next-method)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WINDOW LIST VIEW DIALOG ITEM

;; ## window-list-view-header-dialog-item is only here temporarily, and is likely to be 
;; ## moved to its own file and/or be associated with specific dialog items.

(defclass window-list-view-header-dialog-item (window-header-dialog-item)
  ()
  (:default-initargs
   :view-position #@(0 21)
   :list-header-p T))

#| DEMO:

(init-appearance-manager)

(defclass my-window (window window-header-mixin)
  ())

(setf w 
  (make-instance 'my-window :window-header "34.5 Mb, 666 files"))

(set-window-header w "This is another header")

|#