[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Specialized Pop-Up Menus

On Sat Jul 17 15:43:35 allender@aristotle.ils.nwu.edu writes:
   I am trying to create a specialized version of pop-up windows which
   have a minimum width and some other font.  In Inside Macintosh:
   Toolbox Essentials I discovered two commands which come close --
   popUpFixedWidth and popupUseWFont (page 5-28).  From their descriptions
   these sound like what I want, but I'm not sure how to use them?
   Has anyone have code that adds one or more of these features?
   If not how/where do I add this code to make a modified popup class?
Here is some code for manipulating pop-up menus under system 7.
If you want to use marking menus (basically menus formed by making
connected straight-line strokes), see the pub/MCL2/contrib directory
at cambridge.apple.com (menu-enhancementes.sit.hqx).
Here is the code for modifying popp-up menus with the source credited:
;;;-*- Mode: Lisp; Package: gc -*-
(in-package :gc)
;;;   File           : system7-pop-up-menu.lisp
;;;   Pathname       : Daten:Gerd:contribs:dialog-items:menu-dialog-items:
;;;   Module         :
;;;   Abstract       :
;;; Written by :
;;; Gerd Kamp
;;; University of Hamburg,
;;; Computer-Science Department,
;;; Artificial Intelligence Laboratory,
;;; Bodenstedtstr. 16
;;; 2000 Hamburg 50
;;; Germany
;;; Copyright (c) 1992 by Gerd Kamp. All rights reserved.
;;; Use and copying of this software and preparation of derivative works
;;; based upon this software are permitted, so long as the following
;;; conditions are met:
;;;      o no fees or compensation are charged for use, copies, or
;;;        access to this software
;;;      o this copyright notice is included intact.
;;; This software is made available AS IS, and no warranty is made about
;;; the software or its performance.
;;; Please send bug reports, comments and suggestions to
;;; kamp@informatik.uni-hamburg.de or the real address mentioned above
;;; Created: 23:18:12  Do., 14.01.1993
;;; Last modified: 10:27:07  Mo., 22.02.1993
;;; Modification history:
This file provides a quick hack to use pop-up-menus as defined on IM VI pp.
3-16 (At least the things I need). To achieve this result it is necessary
to slightly patch control-dialog-item (I think it is now cleaner :-)).
There is no support of popUpAddResMenu as well as popUpTitleJustXXX does
not the things I expected it to do.
It does not support hierarchical menus cause they are not allowed by the
apple human interface-guidelines
So please feel encouraged to modify this dialog-item, but please send me
youre changes.
(export '(system-7-pop-up-menu
We need system 7
(let ((pop-up-available (> (ccl::gestalt :|pop!|)
  (unless pop-up-available
      (format nil "Sorry, these contribs need the Pop Up Menu Control
Dialog Item  delivered with System 7. Installation aborted")
      :size #@(350 120))
The patches to control-dialog-item etc.
The proc id's of the standard control-dialog-items are hard coded in
original mcl, I thinks that's not Clossy, cause it's not extendable, so we
do make it into a method
(defmethod procId ((item ccl::control-dialog-item))
  (error "No procID specified for control-dialog-item ~s" item))
(defmethod procId ((item radio-button-dialog-item))
  (declare (ignore item))
(defmethod procId ((item check-box-dialog-item))
  (declare (ignore item))
(defmethod procId ((item button-dialog-item))
  (declare (ignore item))
(defmethod procId ((item ccl::scroll-bar-dialog-item))
  (declare (ignore item))
(let ((*warn-if-redefine-kernel* nil))
  (defclass ccl::control-dialog-item (dialog-item)
    ((refcon :accessor ccl::refcon :initform 0)
     (min :accessor ccl::ctl-min :initform 0)
     (max :accessor ccl::ctl-max :initform 1)
     (value :accessor ccl::ctl-value :initform 0))))
(let ((*warn-if-redefine-kernel* nil))
  (defmethod install-view-in-window :before ((dialog-item
ccl::control-dialog-item) dialog)
  (ccl::set-default-size-and-position dialog-item (view-container dialog-item))
  (with-pstrs ((sp (dialog-item-text dialog-item)))
    (ccl::with-item-rect (rect dialog-item)
      (setf (dialog-item-handle dialog-item)
             (wptr dialog)
             (ccl::ctl-value dialog-item)
             (ccl::ctl-min dialog-item)
             (ccl::ctl-max dialog-item)
             (procId dialog-item)
             (ccl::refcon dialog-item))))
    (unless (dialog-item-enabled-p dialog-item)
      ;sync up what we believe with what the mac believes.
      (#_HiliteControl (dialog-item-handle dialog-item) 255)))))
Now here goes the implementation of the pop-up-menu
We have to do this with to slots fixed-width-p and use-window-font-p cause
we only have a reader for procId not a writer
(this would result in a more severe path of control dialog-item: a new
slot). so we have to store the values and use them in the procId method.
(defclass system-7-pop-up-menu (menu ccl::control-dialog-item)
  ((fixed-width-p :initarg :fixed-width-p)
   (use-window-font-p :initarg :use-window-font-p))
    :fixed-width-p t
    :use-window-font-p t
    #'(lambda (item)
        (menu-item-action (menu-selection item)))))
(defmethod install-view-in-window :before ((item system-7-pop-up-menu)
                                           (window window))
           (menu-install item))
(defmethod ccl::ctl-min ((item system-7-pop-up-menu))
  (menu-id item))
(defmethod ccl::ctl-max ((item system-7-pop-up-menu))
  (string-width (dialog-item-text item)
                (view-font item)))
(defmethod ccl::ctl-value ((menu system-7-pop-up-menu))
  (+ (slot-value menu 'value)
     (logand 65355 (third (multiple-value-list (font-codes (view-font
(defmethod menu-selection ((menu system-7-pop-up-menu))
  (when (and (dialog-item-handle menu)
             (menu-items menu))
  (let ((value (#_GetCtlValue (dialog-item-handle menu))))
    (nth (max 0 (1- value)) (menu-items menu)))))
(defmethod (setf menu-selection) ((new-selection fixnum) (menu
  (when (menu-item-enabled-p (nth (1- new-selection) (menu-items menu)))
    (#_SetCtlValue (dialog-item-handle menu) new-selection)
    (when (view-window menu)
      (invalidate-view menu)))
  (menu-selection menu))
(defmethod (setf menu-selection) ((new-selection menu-item) (menu
  (setf (menu-selection menu)
        (1+ (position new-selection (menu-items menu)))))
(defmethod initialize-instance :after ((menu system-7-pop-up-menu)
                                       (title-justification :left))
  ;; this doesn't work as described in IM VI, any clues?
  (setf (slot-value menu 'value)
        (case title-justification
          (:center 1)
          (:right 255)
          (otherwise 0))))
(defmethod menu-title ((menu system-7-pop-up-menu))
  (dialog-item-text menu))
(defmethod menu-install ((menu system-7-pop-up-menu))
  "Creates the actual Macintosh menu with all of the menu's current items."
  (let* ((menu-items (menu-items menu)))
    (apply #'remove-menu-items menu menu-items)
    (ccl::init-menu-id menu)
    (with-pstrs ((menu-title (menu-title menu)))
      (let ((menu-handle (#_NewMenu :word (slot-value menu 'menu-id)
                                   :ptr menu-title
        (#_InsertMenu :ptr menu-handle
                     :word -1)
        (setf (slot-value menu 'menu-handle) menu-handle)))
    (let* ((colors (part-color-list menu)))
        (unless colors (return))
        (set-part-color menu (pop colors) (pop colors))))
    (apply #'add-menu-items menu menu-items)))
(defmethod menu-deinstall ((menu system-7-pop-up-menu))
  (let* ((*menubar-frozen* t))
(defmethod remove-view-from-window :after ((menu system-7-pop-up-menu))
           (menu-deinstall menu))
(defmethod procId ((item system-7-pop-up-menu))
  (+ 1008
     (if (slot-value item 'use-window-font-p) 8 0)
     (if (slot-value item 'fixed-width-p) 1 0)))
(defmethod view-click-event-handler ((item system-7-pop-up-menu) where
                                     &aux ok)
  (with-focused-dialog-item (item)
    (let ((handle (dialog-item-handle item)))
      (setq ok (#_TrackControl :ptr handle :long where :long -1 )))
                            (view-draw-contents item))
  (unless (eq ok 0) (dialog-item-action item)))
(defmethod ccl::dialog-item-width-correction ((menu system-7-pop-up-menu))
  (third (multiple-value-list (font-info (view-font menu)))))
(make-instance 'window
  (list (setq a (make-instance 'system-7-pop-up-menu
          :dialog-item-text "fgsagurptru"
          :view-size #@(400 40)
          :view-font  '("Courier" 24)
          :help-spec "sdfasdfasfdsaf"
          :title-justification :center
          (list (make-instance 'menu-item :menu-item-title "sdgfsa3jk"
                               :menu-item-action #'(lambda () (print "aaa"))
                               :style '(:bold :outline))
                (make-instance 'menu-item :menu-item-title "hjdsgfjdgf")))
;same with fixed-width-p nil
(make-instance 'window
  (list (setq a (make-instance 'system-7-pop-up-menu
          :dialog-item-text "fgsagurptru"
          :view-size #@(400 40)
          :view-font  '("Courier" 12)
          :fixed-width-p nil
          :help-spec "sdfasdfasfdsaf"
          :title-justification :center
          (list (make-instance 'menu-item :menu-item-title "sdgfsa3jk"
                               :menu-item-action #'(lambda () (print "aaa")))
                (make-instance 'menu-item :menu-item-title "hjdsgfjdgf")))