CLIM mail archive


Static scrollable menus

A short CLIM2.0 demo. Less is more.
(in-package "CLIM-USER")

;;; Example of a static scrollable menu for load selection.
;;; Something to implement SELECT-FILE type applications?
;;; O. B. Clos

(defun static-menu ()
  (format *trace-output* "~&Loading from menu...")
  (find-application-frame 'static-menu :frame-class 'static-menu :create t :own-process t))

(define-application-frame static-menu ()
  ((items :initarg :items :initform (loop for i from 1 upto 100 collect (format nil "~R" i))))
   (menu :application
	 :incremental-redisplay t
	 :display-after-commands t
	 :display-function #'display-items
	 :width 150 :height 420 :top 0 :left 610
	 :end-of-line-action :allow
	 :end-of-page-action :allow
	 :initial-cursor-visibility nil
	 :scroll-bars :vertical))
  (:pointer-documentation t)
  (:layouts (normal menu))
  (:command-table (static-menu
		   :menu (("Load" :command (com-menu-load) :documentation "Load item")
			  ("Refresh" :command (com-menu-refresh) :documentation "Refresh menu")
			  ("Exit" :command (com-menu-exit))))))

(define-presentation-type static-menu-item ())

(defmethod display-items ((frame static-menu) stream)
  (with-slots (items) frame
    (when items
      (formatting-table (stream)
	    for name in items
	    when name
	    do (formatting-row (stream)
		 (formatting-cell (stream)
		   (present name 'static-menu-item :stream stream))))))))

;;; Define application commands
(define-static-menu-command (com-menu-load :menu "Load")
    ((item 'static-menu-item :gesture :select))
  (notify-user *application-frame* (format nil "Define a command to load selected item ~a." item)))

(define-static-menu-command (com-menu-refresh :menu "Refresh")
  (redisplay-frame-pane *application-frame*
			(get-frame-pane *application-frame* 'menu)
			 :force-p t))

(define-static-menu-command (com-menu-exit :menu "Exit")
  (frame-exit *application-frame*))

;;; Translate item selection into the load command
(define-presentation-to-command-translator static-menu-select
    (static-menu-item com-menu-load static-menu :menu nil :gesture :select
	       :pointer-documentation "Menu")
  (list object))

Main Index | Thread Index