mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim
by thenriksen 14 Dec '06

14 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv9245 Modified Files: NEWS Log Message: Added some more notes about new stuff. --- /project/mcclim/cvsroot/mcclim/NEWS 2006/12/12 18:54:57 1.12 +++ /project/mcclim/cvsroot/mcclim/NEWS 2006/12/14 22:02:16 1.13 @@ -11,6 +11,10 @@ ** specification compliance: DELETE-GESTURE-NAME function now implemented. ** specification compliance: PRESENTATION-TYPE-SPECIFIER-P presentaion function now implemented. +** specification compliance: DISPLAY-COMMAND-TABLE-MENU function now + implemented. +** specification compliance: DISPLAY-COMMAND-MENU function now + implemented. * Changes in mcclim-0.9.3 "All Souls' Day" relative to 0.9.2: ** backend improvement: The Null backend now registers itself in the

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 14 Dec '06

14 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv20066 Modified Files: menu.lisp decls.lisp commands.lisp Log Message: Moved `display-command-table-menu' to menu.lisp and implemented `display-command-menu'. --- /project/mcclim/cvsroot/mcclim/menu.lisp 2006/05/13 00:19:36 1.36 +++ /project/mcclim/cvsroot/mcclim/menu.lisp 2006/12/14 19:43:51 1.37 @@ -415,3 +415,43 @@ (- real-height 4))) (incf x width) (incf x x-spacing))))) + +(defmethod display-command-table-menu ((command-table standard-command-table) + (stream fundamental-output-stream) + &rest args + &key max-width max-height n-rows n-columns + x-spacing y-spacing initial-spacing + row-wise (cell-align-x :left) + (cell-align-y :top) (move-cursor t)) + (formatting-item-list (stream :max-width max-width :max-height max-height :n-rows n-rows + :n-columns n-columns :x-spacing x-spacing :y-spacing y-spacing + :initial-spacing initial-spacing :row-wise row-wise + :move-cursor move-cursor) + (map-over-command-table-menu-items + #'(lambda (item-name accelerator item) + (declare (ignore accelerator)) + (formatting-cell (stream :align-x cell-align-x :align-y cell-align-y) + (cond ((eq (command-menu-item-type item) :menu) + (with-text-style (stream (make-text-style :serif '(:bold :italic) nil)) + (write-string item-name stream) + (terpri stream)) + (surrounding-output-with-border (stream) + (apply #'display-command-table-menu + (find-command-table (command-menu-item-value item)) + stream args))) + ((eq (command-menu-item-type item) :command) + (let ((name (command-name (command-menu-item-value item)))) + (when (command-line-name-for-command name command-table :errorp nil) + (present name 'command-name :stream stream))))))) + command-table))) + +(defmethod display-command-menu (frame (stream fundamental-output-stream) + &rest args &key + (command-table (frame-command-table frame)) + initial-spacing row-wise max-width + max-height n-rows n-columns + (cell-align-x :left) (cell-align-y :top)) + (declare (ignore initial-spacing row-wise max-width max-height + n-rows n-columns cell-align-x cell-align-y)) + (with-keywords-removed (args (:command-table)) + (apply #'display-command-table-menu command-table stream args))) --- /project/mcclim/cvsroot/mcclim/decls.lisp 2006/12/13 22:31:57 1.44 +++ /project/mcclim/cvsroot/mcclim/decls.lisp 2006/12/14 19:43:51 1.45 @@ -659,6 +659,18 @@ (defgeneric run-frame-top-level (frame &key &allow-other-keys)) (defgeneric command-enabled (command-name frame)) (defgeneric (setf command-name) (enabled command-name frame)) +(defgeneric display-command-menu (frame stream &key command-table + initial-spacing row-wise max-width + max-height n-rows n-columns + cell-align-x cell-align-y) + (:documentation "Display the command table associated with +`command-table' on `stream' by calling +`display-command-table-menu'. If no command table is +provided, (frame-command-table frame) will be used. + +The arguments `initial-spacing', `row-wise', +`max-width', `max-height', `n-rows', `n-columns', `cell-align-x', +and `cell-align-y' are as for `formatting-item-list'.")) ;;;; 28.5.2 Frame Manager Operations --- /project/mcclim/cvsroot/mcclim/commands.lisp 2006/12/13 22:30:31 1.66 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2006/12/14 19:43:51 1.67 @@ -541,35 +541,6 @@ gesture)) gesture))) -(defmethod display-command-table-menu ((command-table standard-command-table) - (stream fundamental-output-stream) - &rest args - &key max-width max-height n-rows n-columns - x-spacing y-spacing initial-spacing - row-wise (cell-align-x :left) - (cell-align-y :top) (move-cursor t)) - (formatting-item-list (stream :max-width max-width :max-height max-height :n-rows n-rows - :n-columns n-columns :x-spacing x-spacing :y-spacing y-spacing - :initial-spacing initial-spacing :row-wise row-wise - :move-cursor move-cursor) - (map-over-command-table-menu-items - #'(lambda (item-name accelerator item) - (declare (ignore accelerator)) - (formatting-cell (stream :align-x cell-align-x :align-y cell-align-y) - (cond ((eq (command-menu-item-type item) :menu) - (with-text-style (stream (make-text-style :serif '(:bold :italic) nil)) - (write-string item-name stream) - (terpri stream)) - (surrounding-output-with-border (stream) - (apply #'display-command-table-menu - (find-command-table (command-menu-item-value item)) - stream args))) - ((eq (command-menu-item-type item) :command) - (let ((name (command-name (command-menu-item-value item)))) - (when (command-line-name-for-command name command-table :errorp nil) - (present name 'command-name :stream stream))))))) - command-table))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Commands

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 13 Dec '06

13 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8248 Modified Files: decls.lisp Log Message: Added portable implementation of `display-command-table-menu'. --- /project/mcclim/cvsroot/mcclim/decls.lisp 2006/12/10 23:35:12 1.43 +++ /project/mcclim/cvsroot/mcclim/decls.lisp 2006/12/13 22:31:57 1.44 @@ -583,6 +583,20 @@ (stream object type view &key buffer-start rescan query-identifier for-context-type)) +;;; 27.3 Command Menus + +(defgeneric display-command-table-menu (command-table stream &key max-width + max-height n-rows n-columns x-spacing + y-spacing initial-spacing row-wise + cell-align-x cell-align-y move-cursor) + (:documentation "Display a menu of the commands accessible in +`command-table' to `stream'. + +`max-width', `max-height', `n-rows', `n-columns', `x-spacing', +`y-spacing', `row-wise', `initial-spacing', `cell-align-x', +`cell-align-y', and `move-cursor' are as for +`formatting-item-list'.")) + ;;; 28.2 Specifying the Panes of a Frame (defgeneric destroy-frame (frame))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 13 Dec '06

13 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8176 Modified Files: commands.lisp Log Message: Added portable implementation of `display-command-table-menu'. --- /project/mcclim/cvsroot/mcclim/commands.lisp 2006/11/08 01:18:22 1.65 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2006/12/13 22:30:31 1.66 @@ -541,6 +541,35 @@ gesture)) gesture))) +(defmethod display-command-table-menu ((command-table standard-command-table) + (stream fundamental-output-stream) + &rest args + &key max-width max-height n-rows n-columns + x-spacing y-spacing initial-spacing + row-wise (cell-align-x :left) + (cell-align-y :top) (move-cursor t)) + (formatting-item-list (stream :max-width max-width :max-height max-height :n-rows n-rows + :n-columns n-columns :x-spacing x-spacing :y-spacing y-spacing + :initial-spacing initial-spacing :row-wise row-wise + :move-cursor move-cursor) + (map-over-command-table-menu-items + #'(lambda (item-name accelerator item) + (declare (ignore accelerator)) + (formatting-cell (stream :align-x cell-align-x :align-y cell-align-y) + (cond ((eq (command-menu-item-type item) :menu) + (with-text-style (stream (make-text-style :serif '(:bold :italic) nil)) + (write-string item-name stream) + (terpri stream)) + (surrounding-output-with-border (stream) + (apply #'display-command-table-menu + (find-command-table (command-menu-item-value item)) + stream args))) + ((eq (command-menu-item-type item) :command) + (let ((name (command-name (command-menu-item-value item)))) + (when (command-line-name-for-command name command-table :errorp nil) + (present name 'command-name :stream stream))))))) + command-table))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Commands

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 13 Dec '06

13 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv32310 Modified Files: presentation-defs.lisp Log Message: Moved presentation method to after the definition of the relevant type. --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/12/13 19:36:00 1.64 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/12/13 21:33:43 1.65 @@ -1632,11 +1632,6 @@ :options #.+completion-options+ :inherit-from t) -(define-presentation-method presentation-type-specifier-p ((type sequence)) - (and (listp type) - (consp (rest type)) - (presentation-type-specifier-p (second type)))) - (define-presentation-method presentation-typep (object (type completion)) (map nil #'(lambda (obj) (when (funcall test object (funcall value-key obj)) @@ -1840,6 +1835,11 @@ :inherit-from 't :parameters-are-types t) +(define-presentation-method presentation-type-specifier-p ((type sequence)) + (and (listp type) + (consp (rest type)) + (presentation-type-specifier-p (second type)))) + (define-presentation-method presentation-typep (object (type sequence)) ;; XXX TYPE here is the sequence element type, not the whole type specifier (unless (or (listp object) (vectorp object))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by thenriksen 13 Dec '06

13 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv28359/Apps/Listener Modified Files: dev-commands.lisp Log Message: Fixed minor typo that prevented multiple value returns from being printed properly. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/12/03 22:56:46 1.39 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/12/13 21:05:11 1.40 @@ -1468,7 +1468,7 @@ (with-output-as-presentation (t value (presentation-type-of value) :single-box t) - (present (first values) 'expression)))) + (present value 'expression)))) (with-drawing-options (t :ink +olivedrab+) (cond ((null values) (format t "No values.~%"))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 13 Dec '06

13 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv25558/Drei Modified Files: lisp-syntax.lisp Log Message: No longer presenting every lexeme as a string. That was probably a bad idea to begin with. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/12/11 22:04:55 1.13 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/12/13 20:41:56 1.14 @@ -1906,8 +1906,7 @@ (with-slots (ink face) parser-symbol (setf ink (medium-ink (sheet-medium stream)) face (text-style-face (medium-text-style (sheet-medium stream)))) - (let ((string (form-string syntax parser-symbol))) - (present string 'string :stream stream)))))) + (write-string (form-string syntax parser-symbol) stream))))) (defmethod display-parse-tree :before ((parse-symbol lisp-lexeme) stream (drei drei) (syntax lisp-syntax))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 13 Dec '06

13 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv17296 Modified Files: presentation-defs.lisp Log Message: Hopefully fixed `presentation-type-specifier-p'. Of course, I also thought this the last two times. --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/12/12 22:17:42 1.63 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/12/13 19:36:00 1.64 @@ -207,11 +207,9 @@ otherwise return false." ;; Apparently, this funtion has to handle arbitrary objects. (let ((name (presentation-type-name object))) - (when (and (or (symbolp name) - (and (typep name 'class) - (not (typep name 'built-in-class)))) + (when (and (typep name '(or symbol class)) (get-ptype-metaclass name)) - (%presentation-type-specifier-p t object)))) + (funcall-presentation-generic-function presentation-type-specifier-p object)))) (defun default-describe-presentation-type (description stream plural-count) (if (symbolp description) @@ -1634,6 +1632,11 @@ :options #.+completion-options+ :inherit-from t) +(define-presentation-method presentation-type-specifier-p ((type sequence)) + (and (listp type) + (consp (rest type)) + (presentation-type-specifier-p (second type)))) + (define-presentation-method presentation-typep (object (type completion)) (map nil #'(lambda (obj) (when (funcall test object (funcall value-key obj))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 13 Dec '06

13 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv17106 Modified Files: presentations.lisp Log Message: Added method on `get-ptype-metaclass' that specifies that a CLOS class is its own ptype metaclass (for handling of anynomous classes as per the CLIM spec). --- /project/mcclim/cvsroot/mcclim/presentations.lisp 2006/08/05 19:54:31 1.77 +++ /project/mcclim/cvsroot/mcclim/presentations.lisp 2006/12/13 19:35:01 1.78 @@ -466,6 +466,12 @@ (defmethod get-ptype-metaclass ((type (eql *builtin-t-class*))) type) +(defmethod get-ptype-metaclass ((type class)) + type) + +(defmethod get-ptype-metaclass (type) + (error "~A is not the name of a presentation type" type)) + ;;; external functions (defun find-presentation-type-class (name &optional (errorp t) environment) (declare (ignore environment))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 13 Dec '06

13 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv9667 Modified Files: dialog.lisp Log Message: Now `*use-goatee*' also affects calls to `accept' within `accepting-values'. --- /project/mcclim/cvsroot/mcclim/dialog.lisp 2006/11/08 01:18:22 1.23 +++ /project/mcclim/cvsroot/mcclim/dialog.lisp 2006/12/13 15:31:07 1.24 @@ -449,7 +449,9 @@ (surrounding-output-with-border (stream :shape :inset :move-cursor t) (setq editing-stream - (make-instance 'standard-input-editing-stream + (make-instance (if *use-goatee* + 'goatee-input-editing-stream + 'standard-input-editing-stream) :stream stream :cursor-visibility nil :background-ink +grey90+

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs