mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 13 Feb '07

13 Feb '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv26101 Modified Files: packages.lisp core.lisp Log Message: Fixed `delete-indentation', added `join-line' and exported some more symbols from DREI-LISP-SYNTAX. --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/01/15 11:35:54 1.12 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/02/13 12:14:12 1.13 @@ -410,6 +410,7 @@ #:indent-region #:fill-line #:fill-region #:indent-line #:delete-indentation + #:join-line #:set-syntax #:*killed-rectangle* @@ -445,7 +446,8 @@ #:edit-definition #:form #:form-to-object - #:form-conversion-error) + #:form-conversion-error + #:forward-one-list #:backward-one-list #:forward-list #:backward-list) (:shadow clim:form) (:documentation "Implementation of the syntax module used for editing Common Lisp code.")) --- /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2007/02/12 19:32:58 1.4 +++ /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2007/02/13 12:14:12 1.5 @@ -294,11 +294,33 @@ (let ((working-mark (clone-mark mark))) (beginning-of-line working-mark) (let ((end-offset (loop for offset from (offset working-mark) below (size *current-buffer*) - unless (whitespacep syntax (buffer-object *current-buffer* offset)) + for buffer-object = (buffer-object *current-buffer* offset) + until (char= buffer-object #\Newline) + unless (whitespacep syntax buffer-object) return offset))) (when end-offset (delete-region working-mark end-offset))))) +(defgeneric join-line (syntax mark) + (:documentation "Join the line that `mark' is in to the +previous line, and remove whitespace objects at the join +point. `Syntax' is used for judging what a whitespace character +is.")) + +(defmethod join-line ((syntax syntax) (mark mark)) + (beginning-of-line mark) + (unless (beginning-of-buffer-p mark) + (delete-range mark -1) + (loop until (end-of-buffer-p mark) + while (whitespacep syntax (object-after mark)) + do (delete-range mark 1)) + (loop until (beginning-of-buffer-p mark) + while (whitespacep syntax (object-before mark)) + do (delete-range mark -1)) + (when (and (not (beginning-of-buffer-p mark)) + (constituentp (object-before mark))) + (insert-object mark #\Space)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Syntax handling

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 12 Feb '07

12 Feb '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv27220 Modified Files: core.lisp core-commands.lisp Log Message: Improved `delete-indentation', now does the intuitive thing. --- /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2007/01/14 17:57:01 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2007/02/12 19:32:58 1.4 @@ -285,19 +285,19 @@ (defmethod indent-line ((mark right-sticky-mark) indentation tab-width) (indent-line* mark indentation tab-width nil)) -(defun delete-indentation (mark) - (beginning-of-line mark) - (unless (beginning-of-buffer-p mark) - (delete-range mark -1) - (loop until (end-of-buffer-p mark) - while (buffer-whitespacep (object-after mark)) - do (delete-range mark 1)) - (loop until (beginning-of-buffer-p mark) - while (buffer-whitespacep (object-before mark)) - do (delete-range mark -1)) - (when (and (not (beginning-of-buffer-p mark)) - (constituentp (object-before mark))) - (insert-object mark #\Space)))) +(defgeneric delete-indentation (syntax mark) + (:documentation "Delete all indentation in the line of `mark' +with the whitespace rules of `syntax'. The default method just +removes leading whitespace characters.")) + +(defmethod delete-indentation ((syntax syntax) (mark mark)) + (let ((working-mark (clone-mark mark))) + (beginning-of-line working-mark) + (let ((end-offset (loop for offset from (offset working-mark) below (size *current-buffer*) + unless (whitespacep syntax (buffer-object *current-buffer* offset)) + return offset))) + (when end-offset + (delete-region working-mark end-offset))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2006/11/14 10:31:37 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2007/02/12 19:32:58 1.4 @@ -257,7 +257,7 @@ the current line, and point after that space. If there is no previous non-blank line, deletes all whitespace at the beginning of the buffer at leaves point there." - (delete-indentation *current-point*)) + (delete-indentation *current-syntax* *current-point*)) (set-key 'com-delete-indentation 'indent-table

1 0

[mcclim-cvs] CVS mcclim/Drei/Tests
by thenriksen 12 Feb '07

12 Feb '07

Update of /project/mcclim/cvsroot/mcclim/Drei/Tests In directory clnet:/tmp/cvs-serv27220/Tests Modified Files: core-tests.lisp Log Message: Improved `delete-indentation', now does the intuitive thing. --- /project/mcclim/cvsroot/mcclim/Drei/Tests/core-tests.lisp 2006/12/04 07:54:51 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/core-tests.lisp 2007/02/12 19:32:57 1.2 @@ -363,6 +363,28 @@ (buffer-is #. (format nil "~A~A~A~A~A I am to be indented" #\Tab #\Tab #\Tab #\Tab #\Tab))))) +(test delete-indentation + (with-drei-environment (:initial-contents "") + (delete-indentation *current-syntax* *current-point*) + (buffer-is "")) + (with-drei-environment (:initial-contents "Foo") + (delete-indentation *current-syntax* *current-point*) + (buffer-is "Foo")) + (with-drei-environment (:initial-contents " Foo") + (delete-indentation *current-syntax* *current-point*) + (buffer-is "Foo")) + (with-drei-environment (:initial-contents " Foo ") + (delete-indentation *current-syntax* *current-point*) + (buffer-is "Foo ")) + (with-drei-environment (:initial-contents " Foo + Bar + Baz") + (forward-line *current-point* *current-syntax*) + (delete-indentation *current-syntax* *current-point*) + (buffer-is " Foo +Bar + Baz"))) + (test set-syntax (dolist (syntax-designator `("Lisp" drei-lisp-syntax::lisp-syntax ,(find-class 'drei-lisp-syntax::lisp-syntax)))

1 0

[mcclim-cvs] CVS mcclim/Doc
by thenriksen 10 Feb '07

10 Feb '07

Update of /project/mcclim/cvsroot/mcclim/Doc In directory clnet:/tmp/cvs-serv15654/Doc Modified Files: ex3.lisp Log Message: Made the `string' present method respect the :accept keyword argument, updated an example program to exploit this. --- /project/mcclim/cvsroot/mcclim/Doc/ex3.lisp 2004/07/22 12:05:24 1.1 +++ /project/mcclim/cvsroot/mcclim/Doc/ex3.lisp 2007/02/10 21:32:21 1.2 @@ -21,9 +21,11 @@ (define-superapp-command (com-quit :name t) () (frame-exit *application-frame*)) -(define-presentation-type name-of-month ()) +(define-presentation-type name-of-month () + :inherit-from 'string) -(define-presentation-type day-of-month ()) +(define-presentation-type day-of-month () + :inherit-from 'integer) (define-superapp-command (com-out :name t) () (with-output-as-presentation (t "The third month" 'name-of-month)

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 10 Feb '07

10 Feb '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv15654 Modified Files: presentation-defs.lisp Log Message: Made the `string' present method respect the :accept keyword argument, updated an example program to exploit this. --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2007/02/05 03:06:14 1.70 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2007/02/10 21:32:22 1.71 @@ -1618,8 +1618,10 @@ (define-presentation-method present (object (type string) stream (view textual-view) &key acceptably for-context-type) - (declare (ignore acceptably for-context-type)) - (princ object stream)) + (declare (ignore for-context-type)) + (if acceptably + (prin1 object stream) + (princ object stream))) (define-presentation-method accept ((type string) stream (view textual-view) &key (default nil defaultp)

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by pscott 08 Feb '07

08 Feb '07

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv26056 Modified Files: test.lisp Log Message: Added political correctness. This file was originally for my own use only, and it got committed to the CVS repository by accident. Now that it's here, I've decided to clean it up a little bit. To that end, I also added a comment explaining what the file is for. --- /project/mcclim/cvsroot/mcclim/Apps/Inspector/test.lisp 2005/03/11 21:25:29 1.1 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/test.lisp 2007/02/08 05:50:02 1.2 @@ -1,3 +1,7 @@ +;; This is a test file which doesn't properly test anything. It just +;; has a bunch of code which may occasionally be useful for testing +;; Clouseau, if you squint at it. All data dictated by wild whims. + (in-package :clouseau) (defclass oddity () @@ -17,8 +21,8 @@ (defstruct historical-event (severity 5 :type (integer 0 10)) - (tragedy "" :type string) - (farce "" :type string)) + (attribute "" :type string) + (pirate "" :type string)) (defclass packrat (queer-oddity salad-mixin) ((name :initform "Willy the Packrat" @@ -30,9 +34,9 @@ (an-array :initform #2A((1 0 0) (0 1 0) (0 0 1)) :documentation "An identity matrix") (global-fun :initform #'inspector) - (creationism :initform (make-historical-event :severity 7 - :tragedy "Scopes monkey trial" - :farce "ID Creationism")) + (reunion :initform (make-historical-event :severity 7 + :attribute "Sephiroth!" + :pirate "Sephiroth?")) (l :initform #'(lambda (x) (declare (number x)) (1+ x)))

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by pscott 08 Feb '07

08 Feb '07

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv25884 Modified Files: inspector.lisp Log Message: * Cosmetic improvement to hash table display * Added horrible hack to fix bug with display of generic functions. I have no idea why this is even necessary, and I find myself QUITE UNNERVED that I'm even writing it. It shouldn't break anything, though! Probably! --- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2007/02/08 05:12:33 1.34 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2007/02/08 05:47:46 1.35 @@ -447,7 +447,7 @@ (show-hash-table-status object pane :message "Hash table"))) (defmethod inspect-object ((object hash-table) pane) (inspector-table (object pane) - (progn (format pane "~A (test: ~A)" 'hash-table (hash-table-test object)) + (progn (format pane "~A (test: ~A) " 'hash-table (hash-table-test object)) (show-hash-table-status object pane)) (loop for key being the hash-keys of object do (formatting-row (pane) @@ -879,4 +879,10 @@ (fboundp object) (tracedp object)))) (object) - (list object)) \ No newline at end of file + (list object)) + +;; FIXME: This is a horrible hack to gloss over issues that I don't +;; properly understand. See +;; <http://common-lisp.net/pipermail/mcclim-devel/2005-February/003700.html> +(defmethod clim:presentation-type-of ((object standard-generic-function)) + 'clim:expression) \ No newline at end of file

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by pscott 08 Feb '07

08 Feb '07

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv21361/Apps/Inspector Modified Files: inspector.lisp Log Message: Added much snazzy eye candy for people dealing with hash tables. Hash tables are now displayed in a pretty graphical format which shows how much of the array is used and how far it is to the rehash threshold. --- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2005/09/13 11:07:40 1.33 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2007/02/08 05:12:33 1.34 @@ -90,7 +90,7 @@ (defmethod inspect-object :around (object pane) (cond ((member object *inspected-objects*) (with-output-as-presentation - (pane object (presentation-type-of object)) + (pane object (presentation-type-of object)) (princ "===" pane))) ; Prevent infinite loops ((not (gethash object (dico *application-frame*))) (inspect-object-briefly object pane)) @@ -113,7 +113,7 @@ (defmethod inspect-object (object pane) (with-output-as-presentation - (pane object (presentation-type-of object)) + (pane object (presentation-type-of object)) (prin1 object pane))) @@ -124,7 +124,7 @@ (define-presentation-type long-list-tail () :inherit-from t) -(define-presentation-method present (object (type settable-slot) +(define-presentation-method present (object (type settable-slot) stream (view textual-view) &key acceptably for-context-type) @@ -417,21 +417,45 @@ (inspect-cons-as-cells object pane) (inspect-cons-as-list object pane))) +(defun show-hash-table-status (hash pane &key (message "Usage Graph")) + "Show a hash table's status graphically on a given +pane. Display a given message, which defaults to 'Usage Graph'." + (with-room-for-graphics (pane :height 20) + (let* ((my-beige (make-rgb-color 0.9372549 0.8862745 0.8862745)) + (used-color (make-rgb-color 0.43529412 0.7921569 0.87058824)) + (text-color (make-rgb-color 0.7176471 0.29803923 0.2)) + (pattern (make-rectangular-tile + (make-pattern #2A((0 1 0 0 0) + (1 0 0 0 0) + (0 0 0 0 1) + (0 0 0 1 0) + (0 0 1 0 0)) + (list my-beige +black+)) 5 5))) + (draw-rectangle* pane 0 0 150 20 :filled t :ink my-beige) + (draw-rectangle* pane 0 0 (* 150 (/ (hash-table-count hash) + (hash-table-size hash))) + 20 :filled t :ink used-color :line-thickness 0) + (draw-rectangle* pane (* 150 (hash-table-rehash-threshold hash)) 0 150 20 + :filled t :ink pattern :line-thickness 0) + (draw-rectangle* pane 0 0 150 20 :filled nil :ink +black+) + (draw-text* pane message 7 10 :align-y :center :align-x :left + :text-size :small :ink text-color :text-face :italic)))) (defmethod inspect-object-briefly ((object hash-table) pane) (with-output-as-presentation (pane object (presentation-type-of object)) - (princ 'hash-table pane))) + (show-hash-table-status object pane :message "Hash table"))) (defmethod inspect-object ((object hash-table) pane) (inspector-table (object pane) - (format pane "~A (test: ~A)" 'hash-table (hash-table-test object)) + (progn (format pane "~A (test: ~A)" 'hash-table (hash-table-test object)) + (show-hash-table-status object pane)) (loop for key being the hash-keys of object - do (formatting-row (pane) - (formatting-cell (pane :align-x :right) - (inspect-object key pane)) - (formatting-cell (pane) (princ "=" pane)) - (formatting-cell (pane) - (inspect-object (gethash key object) pane)))))) + do (formatting-row (pane) + (formatting-cell (pane :align-x :right) + (inspect-object key pane)) + (formatting-cell (pane) (princ "=" pane)) + (formatting-cell (pane) + (inspect-object (gethash key object) pane)))))) (defmethod inspect-object ((object generic-function) pane) (inspector-table (object pane)

1 0

[mcclim-cvs] CVS mcclim/ESA
by crhodes 07 Feb '07

07 Feb '07

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv16608/ESA Modified Files: esa.lisp Log Message: New click-to-focus policy for text-editor gadgets and panes, implemented for the CLX, Null and gtkairo backends (but gtk_window_get_focus() hand-inserted into gtkairo/ffi.lisp). PORT-KEYBOARD-INPUT-FOCUS is now a trampoline to PORT-FRAME-KEYBOARD-INPUT-FOCUS, a per-port function to set the keyboard focus for a particular frame. Not implemented for Beagle or OpenGL backends. Now Drei / Goatee gadgets don't have to do their own keyboard focus handling on arm/disarm any more. Various kludges sprinkled all over the place to make this so. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2006/12/10 00:08:30 1.4 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/02/07 12:44:21 1.5 @@ -119,10 +119,10 @@ ;; error: there's no feedback, unlike emacs' quite nice "[no ;; match]". (loop - (handler-case - (return (call-next-method)) - (parse-error () - nil)))) + (handler-case + (with-input-focus (pane) + (return (call-next-method))) + (parse-error () nil)))) (defmethod stream-accept ((pane minibuffer-pane) type &rest args &key (view (stream-default-view pane))

1 0

[mcclim-cvs] CVS mcclim/Looks
by crhodes 07 Feb '07

07 Feb '07

Update of /project/mcclim/cvsroot/mcclim/Looks In directory clnet:/tmp/cvs-serv16608/Looks Modified Files: pixie.lisp Log Message: New click-to-focus policy for text-editor gadgets and panes, implemented for the CLX, Null and gtkairo backends (but gtk_window_get_focus() hand-inserted into gtkairo/ffi.lisp). PORT-KEYBOARD-INPUT-FOCUS is now a trampoline to PORT-FRAME-KEYBOARD-INPUT-FOCUS, a per-port function to set the keyboard focus for a particular frame. Not implemented for Beagle or OpenGL backends. Now Drei / Goatee gadgets don't have to do their own keyboard focus handling on arm/disarm any more. Various kludges sprinkled all over the place to make this so. --- /project/mcclim/cvsroot/mcclim/Looks/pixie.lisp 2007/02/05 03:31:59 1.19 +++ /project/mcclim/cvsroot/mcclim/Looks/pixie.lisp 2007/02/07 12:44:22 1.20 @@ -1098,18 +1098,6 @@ (display-gadget-background pane (gadget-current-color pane) 0 0 (- x2 x1) (- y2 y1)) (goatee::redisplay-all (area pane)))))) -(defmethod armed-callback :after ((gadget pixie-text-field-pane) client id) - (declare (ignore client id)) - (let ((port (port gadget))) - (setf (previous-focus gadget) (port-keyboard-input-focus port)) - (setf (port-keyboard-input-focus port) gadget))) - -(defmethod disarmed-callback :after ((gadget pixie-text-field-pane) client id) - (declare (ignore client id)) - (let ((port (port gadget))) - (setf (port-keyboard-input-focus port) (previous-focus gadget)) - (setf (previous-focus gadget) nil))) - (defmethod handle-event ((gadget pixie-text-field-pane) (event key-press-event)) (let ((gesture (convert-to-gesture event)) (*activation-gestures* *standard-activation-gestures*))

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