Update of /project/climacs/cvsroot/climacs In directory cl-net:/tmp/cvs-serv5237
Modified Files: climacs.lisp Log Message: Entry points now accept the :text-style keyword argument.
Thanks to Andy Hefner.
--- /project/climacs/cvsroot/climacs/climacs.lisp 2008/01/26 11:28:53 1.6 +++ /project/climacs/cvsroot/climacs/climacs.lisp 2009/02/23 13:49:19 1.7 @@ -38,17 +38,19 @@ (frame-manager-frames frame-manager)))))
(defun climacs (&rest args &key new-process (process-name "Climacs") + (text-style *climacs-text-style*) (width 900) (height 400)) "Starts up a climacs session" - (declare (ignore new-process process-name width height)) + (declare (ignore new-process process-name width height text-style)) (apply #'climacs-common nil args))
(defun climacs-rv (&rest args &key new-process (process-name "Climacs") + (text-style *climacs-text-style*) (width 900) (height 400)) "Starts up a climacs session with alternative colors." ;; SBCL doesn't inherit dynamic bindings when starting new ;; processes, so start a new processes and THEN setup the colors. - (declare (ignore width height)) + (declare (ignore text-style width height)) (flet ((run () (let ((*background-color* +black+) (*foreground-color* +gray+) @@ -62,10 +64,11 @@ (run))))
(defun edit-file (thing &rest args - &key (process-name "Climacs") (width 900) (height 400)) + &key (process-name "Climacs") (width 900) (height 400) + (text-style *climacs-text-style*)) "Edit THING in an existing climacs process or start a new one. THING can be a filename (edit the file) or symbol (edit its function definition)." - (declare (ignore process-name width height)) + (declare (ignore process-name width height text-style)) (let ((climacs-frame (find-climacs-frame)) (command (typecase thing @@ -83,8 +86,10 @@ t)
(defun climacs-common (command &key new-process (process-name "Climacs") + (text-style *climacs-text-style*) (width 900) (height 400)) (let* ((frame (make-application-frame 'climacs :width width :height height)) + (*climacs-text-style* text-style) (*application-frame* frame) (esa:*esa-instance* frame)) (adopt-frame (find-frame-manager) *application-frame*)