Plaster
New
List
Login
common-lisp
default
scymtym
2022.09.13 08:16:00
(defpackage :clim-calendar.clim (:use #:clim-lisp #:clim)) (in-package :clim-calendar.clim) (define-application-frame calendar () ((%month-pane :initarg :month-pane :accessor month-pane) (%input-pane :initarg :input-pane :accessor input-pane)) (:panes (calendar (multiple-value-bind (pane stream) (make-clim-stream-pane ; :type 'month-pane ) (setf (month-pane *application-frame*) stream) pane)) (input (multiple-value-bind (pane stream) (make-clim-stream-pane ; :type 'input-pane ) (setf (input-pane *application-frame*) stream) pane)) (interactor :interactor)) (:layouts (default calendar) (input (vertically () calendar input))) (:menu-bar t)) (defun run () (find-application-frame 'calendar)) (defun update-pane-month (by) ) (define-calendar-command (com-next :menu t :name t) () (update-pane-month 1)) (define-calendar-command (com-previous :menu t :name t) () (update-pane-month -1)) (define-calendar-command (com-add-event :menu t :name t) () (unwind-protect (setf (frame-current-layout *application-frame*) 'input) (execute-frame-command *application-frame* '(com-add-event-helper)))) (define-calendar-command (com-add-event-helper) () (let ((name nil) (start nil) (end nil) (all-day-p nil) (stream (input-pane *application-frame*))) (window-clear stream) (accepting-values (stream :resynchronize-every-pass t) (setf name (apply #'accept 'string :stream stream :prompt "Name" (and name (list :default name)))) (fresh-line stream) (setf start (apply #'accept 'string :stream stream :prompt "Start" (and start (list :default start)))) (terpri stream) (setf end (apply #'accept 'string :stream stream :prompt "End" (and end (list :default end)))) (terpri stream) (setf all-day-p (accept 'boolean :stream stream :prompt "Lasts all day?" :view +toggle-button-view+ :default all-day-p))) (window-clear stream) (setf (frame-current-layout *application-frame*) 'default))) (define-calendar-command (com-list-events :menu t :name t) () ) ;; (define-calendar-command (com-select-date :menu t :name t) ;; ((date 'date))) ;; (define-presentation-translator timestamp-to-timestring)
Raw
Annotate
Repaste