CLIM mail archive
[Prev][Next][Index][Thread]
Static scrollable menus
A short CLIM2.0 demo. Less is more.
;;;---------------------------static-menu.lisp---------------------------
(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))))
(:panes
(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)
(loop
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")
(object)
(list object))
Main Index |
Thread Index