November 2006 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 30 Nov '06

30 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv7984 Modified Files: drei.lisp Log Message: Fixed `with-bound-drei-special-variables' to also allow null values. --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/19 11:39:45 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/30 17:33:31 1.9 @@ -706,17 +706,17 @@ (princ c minibuffer)))))) (defmacro with-bound-drei-special-variables ((drei-instance &key - current-buffer - current-window - current-mark - current-point - current-syntax - kill-ring - minibuffer - command-parser - partial-command-parser - previous-command - prompt) + (current-buffer nil current-buffer-p) + (current-window nil current-window-p) + (current-mark nil current-mark-p) + (current-point nil current-point-p) + (current-syntax nil current-syntax-p) + (kill-ring nil kill-ring-p) + (minibuffer nil minibuffer-p) + (command-parser nil command-parser-p) + (partial-command-parser nil partial-command-parser-p) + (previous-command nil previous-command-p) + (prompt nil prompt-p)) &body body) "Evaluate `body' with a set of Drei special variables (`*current-buffer*', `*current-window*', @@ -731,17 +731,28 @@ variables, but also some CLIM special variables needed for ESA-style command parsing." (once-only (drei-instance) - `(let* ((*current-buffer* ,(or current-buffer `(buffer ,drei-instance))) - (*current-window* ,(or current-window drei-instance)) - (*current-mark* ,(or current-mark `(mark ,drei-instance))) - (*current-point* ,(or current-point `(point ,drei-instance))) - (*current-syntax* ,(or current-syntax `(syntax *current-buffer*))) - (*kill-ring* ,(or kill-ring `(kill-ring ,drei-instance))) - (*minibuffer* ,(or minibuffer `(or (minibuffer ,drei-instance) *minibuffer*))) - (*command-parser* ,(or command-parser ''esa-command-parser)) - (*partial-command-parser* ,(or partial-command-parser ''esa-partial-command-parser)) - (*previous-command* ,(or previous-command `(previous-command ,drei-instance))) - (*extended-command-prompt* ,(or prompt "Extended command: "))) + `(let* ((*current-buffer* ,(if current-buffer-p current-buffer + `(buffer ,drei-instance))) + (*current-window* ,(if current-window-p current-window + drei-instance)) + (*current-mark* ,(if current-mark-p current-mark + `(mark ,drei-instance))) + (*current-point* ,(if current-point-p current-point + `(point ,drei-instance))) + (*current-syntax* ,(if current-syntax-p current-syntax + `(syntax *current-buffer*))) + (*kill-ring* ,(if kill-ring-p kill-ring + `(kill-ring ,drei-instance))) + (*minibuffer* ,(if minibuffer-p minibuffer + `(or (minibuffer ,drei-instance) *minibuffer*))) + (*command-parser* ,(if command-parser-p command-parser + ''esa-command-parser)) + (*partial-command-parser* ,(if partial-command-parser-p partial-command-parser + ''esa-partial-command-parser)) + (*previous-command* ,(if previous-command-p previous-command + `(previous-command ,drei-instance))) + (*extended-command-prompt* ,(if prompt-p prompt + "Extended command: "))) ,@body))) (defgeneric invoke-performing-drei-operations (drei continuation &key with-undo update-syntax redisplay)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 30 Nov '06

30 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv2898 Modified Files: motion.lisp Log Message: Improved the page and paragraph motion methods. Basically, my philosophy is that all the unit methods must behave similarly wrt. where they move to within the seperator whitespace. This will mean that the Climacs paragraph motion commands are not identical to those of Emacs, but I believe the consistency is worth this. --- /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2006/11/18 22:02:41 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2006/11/30 17:00:09 1.3 @@ -351,8 +351,13 @@ reached.")) (defmethod forward-one-page (mark syntax) - (when (search-forward mark (coerce (page-delimiter syntax) 'vector)) - t)) + (unless (end-of-buffer-p mark) + (forward-object mark 1) + (if (search-forward mark (coerce (page-delimiter syntax) 'vector)) + (progn (backward-object mark (length (page-delimiter syntax))) + t) + (progn (end-of-buffer mark) + nil)))) (defgeneric backward-one-page (mark syntax) (:documentation @@ -361,9 +366,13 @@ reached.")) (defmethod backward-one-page (mark syntax) - (when (search-backward mark (coerce (page-delimiter syntax) 'vector)) - (forward-object mark) - t)) + (unless (beginning-of-buffer-p mark) + (backward-object mark 1) + (if (search-backward mark (coerce (page-delimiter syntax) 'vector)) + (progn (forward-object mark (length (page-delimiter syntax))) + t) + (progn (beginning-of-buffer mark) + nil)))) (define-motion-fns page) @@ -464,9 +473,13 @@ Return T if successful, or NIL if the buffer limit was reached.")) (defmethod backward-one-paragraph (mark syntax) - (when (search-backward mark (coerce (paragraph-delimiter syntax) 'vector)) - (forward-object mark) - t)) + (unless (beginning-of-buffer-p mark) + (backward-object mark 1) + (if (search-backward mark (coerce (paragraph-delimiter syntax) 'vector)) + (progn (forward-object mark (length (paragraph-delimiter syntax))) + t) + (progn (beginning-of-buffer mark) + nil)))) (defgeneric forward-one-paragraph (mark syntax) (:documentation @@ -474,9 +487,13 @@ Return T if successful, or NIL if the buffer limit was reached.")) (defmethod forward-one-paragraph (mark syntax) - (when (search-forward mark (coerce (paragraph-delimiter syntax) 'vector)) - (backward-object mark) - t)) + (unless (end-of-buffer-p mark) + (forward-object mark 1) + (if (search-forward mark (coerce (paragraph-delimiter syntax) 'vector)) + (progn (backward-object mark (length (paragraph-delimiter syntax))) + t) + (progn (end-of-buffer mark) + nil)))) (define-motion-fns paragraph)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 29 Nov '06

29 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv19881 Modified Files: editing.lisp Log Message: We also need different line-transposition methods for left- and right-sticky-marks. --- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/29 09:39:57 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/29 09:59:00 1.4 @@ -299,7 +299,7 @@ ;; Autogenerated TRANSPOSE-LINES is not good enough. (defmethod transpose-lines - (mark syntax) + ((mark left-sticky-mark) syntax) (beginning-of-line mark) (unless (beginning-of-buffer-p mark) (backward-line mark syntax)) @@ -312,11 +312,28 @@ (unless (end-of-buffer-p mark) (delete-range mark)) (end-of-line mark) - (insert-object mark #\Newline) (forward-line mark syntax 0) (insert-sequence mark line) (insert-object mark #\Newline))) +(defmethod transpose-lines + ((mark right-sticky-mark) syntax) + (beginning-of-line mark) + (unless (beginning-of-buffer-p mark) + (backward-line mark syntax)) + (let* ((bol (offset mark)) + (eol (progn (end-of-line mark) + (offset mark))) + (line (buffer-sequence (buffer mark) bol eol))) + (delete-region bol mark) + ;; Remove newline at end of line as well. + (unless (end-of-buffer-p mark) + (delete-range mark)) + (end-of-line mark) + (insert-object mark #\Newline) + (forward-line mark syntax 0) + (insert-sequence mark line))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Word editing

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 29 Nov '06

29 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv17375 Modified Files: editing.lisp Log Message: Hm! Apparently we need different transposition methods for left- and right-sticky-marks. --- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/14 10:31:37 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/29 09:39:57 1.3 @@ -166,7 +166,7 @@ (:documentation ,(concat "Transpose two " plural " at MARK."))) (defmethod ,transpose - (mark syntax) + ((mark right-sticky-mark) syntax) (let (start1 end1 start2 end2) (,backward mark syntax 1 nil) (setf start1 (clone-mark mark)) @@ -190,7 +190,33 @@ (insert-sequence mark obj2) (update-syntax (buffer syntax) syntax) - (,forward mark syntax 1 nil)))))))) + (,forward mark syntax 1 nil)))) + (defmethod ,transpose + ((mark left-sticky-mark) syntax) + (let (start1 end1 start2 end2) + (,backward mark syntax 1 nil) + (setf start1 (clone-mark mark)) + (,forward mark syntax 1 #'error-limit-action) + (setf end1 (clone-mark mark)) + (,forward mark syntax 1 #'error-limit-action) + (setf end2 (clone-mark mark)) + (,backward mark syntax 1 nil) + (setf start2 (clone-mark mark)) + (let ((obj1 (buffer-sequence (buffer mark) (offset start1) (offset end1))) + (obj2 (buffer-sequence (buffer mark) (offset start2) (offset end2)))) + (,forward-delete mark syntax 1 nil) + (insert-sequence mark obj1) + (,forward mark syntax 1 nil) + ;; KLUDGE: Having to do this manually is ugly, but it + ;; is necessary if the motion functions uses syntax + ;; information. + (update-syntax (buffer syntax) + syntax) + (,backward mark syntax 2 nil) + (,forward-delete mark syntax 1 nil) + (insert-sequence mark obj2) + (update-syntax (buffer syntax) + syntax)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 28 Nov '06

28 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv21217 Modified Files: kill-ring.lisp Log Message: Oops. This should obviously be `setf' and not `set'. --- /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2006/11/19 11:39:45 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2006/11/28 23:34:10 1.3 @@ -118,8 +118,8 @@ (unless (typep size 'integer) (error "Error, ~S, is not an integer value" size)) (if (< size 5) - (set (slot-value kr 'max-size) 5) - (setf (slot-value kr 'max-size) size)) + (setf (slot-value kr 'max-size) 5) + (setf (slot-value kr 'max-size) size)) (let ((len (kill-ring-length kr))) (if (> len size) (loop for n from 1 to (- len size)

1 0

[mcclim-cvs] CVS mcclim/Drei
by rstrandh 27 Nov '06

27 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv21171/Drei Modified Files: lisp-syntax.lisp Log Message: Make Drei handle package names given as options at the beginning of the buffer. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/22 13:50:44 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/27 12:28:01 1.7 @@ -1376,7 +1376,7 @@ (let ((osp (option-specified-package syntax))) (typecase osp (package osp) - (string osp))) + (string (find-package osp)))) (find-package (option-specified-package syntax)) (find-package :clim-user)))))

1 0

[mcclim-cvs] CVS mcclim/ESA
by rstrandh 27 Nov '06

27 Nov '06

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv15811/ESA Modified Files: esa.lisp Log Message: Make the ESA example work again after recent changes. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2006/11/18 20:47:46 1.2 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2006/11/27 11:54:49 1.3 @@ -1559,8 +1559,8 @@ (defclass example-pane (esa-pane-mixin application-pane) ((contents :initform "hello" :accessor contents))) -(define-application-frame example (standard-application-frame - esa-frame-mixin) +(define-application-frame example (esa-frame-mixin + standard-application-frame) () (:panes (window (let* ((my-pane

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 27 Nov '06

27 Nov '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv17221 Modified Files: presentation-defs.lisp input-editing-drei.lisp Log Message: The presentation history functions are now named more sensibly. Also, a change to `accept': we add the object to the presentation history of the type that was asked for, not the type that was returned. Input history should work in the Listener now (but there are still issues for non-trivial forms, unfortunately). --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/11/22 14:53:12 1.60 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/11/27 07:44:46 1.61 @@ -500,6 +500,18 @@ finally (return (values nil nil)))) (defun presentation-history-next (history ptype) + (let ((first-object (goatee::backward history))) + (loop + for first-time = t then nil + for cell = first-object then (goatee::backward history) + for (object . object-ptype) = (goatee::contents cell) + while (or first-time (not (eq first-object cell))) + if (presentation-subtypep object-ptype ptype) + return (values object object-ptype) + end + finally (return (values nil nil))))) + +(defun presentation-history-previous (history ptype) (let ((first-object (goatee::forward history))) (loop for first-time = t then nil @@ -511,18 +523,6 @@ end finally (return (values nil nil))))) -(defun presentation-history-previous (history ptype) - (let ((first-object (goatee::backward history))) - (loop - for first-time = t then nil - for cell = first-object then (goatee::backward history) - for (object . object-ptype) = (goatee::contents cell) - while (or first-time (not (eq first-object cell))) - if (presentation-subtypep object-ptype ptype) - return (values object object-ptype) - end - finally (return (values nil nil))))) - (defmacro with-object-on-history ((history object ptype) &body body) `(goatee::with-object-on-ring ((cons ,object ,ptype) ,history) ,@body)) @@ -723,7 +723,7 @@ (let* ((default-from-history (and (not defaultp) provide-default)) (history (get-history)) (results - (multiple-value-list + (multiple-value-list (if history (let ((*active-history-type* real-history-type)) (cond (defaultp @@ -746,7 +746,7 @@ (when results-history (presentation-history-add results-history (car results) - (cadr results))) + real-type)) (values-list results))))))) (defmethod stream-accept ((stream standard-extended-input-stream) type --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/20 09:00:56 1.2 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/27 07:44:46 1.3 @@ -199,16 +199,8 @@ ;;; rely on internal features and implement input-editor support in ;;; CLIM-INTERNALS (Goatee does the same trick). -(defun history-yank (stream input-buffer gesture numeric-argument) - (let* ((accepting-type *active-history-type*) - (history (and accepting-type - (presentation-type-history accepting-type)))) - (when history - (multiple-value-bind (object type) - (presentation-history-head history accepting-type) - (presentation-replace-input stream object type (stream-default-view stream)))))) - (defun history-yank-next (stream input-buffer gesture numeric-argument) + (declare (ignore input-buffer gesture numeric-argument)) (let* ((accepting-type *active-history-type*) (history (and accepting-type (presentation-type-history accepting-type)))) @@ -219,6 +211,7 @@ (presentation-replace-input stream object type (stream-default-view stream))))))) (defun history-yank-previous (stream input-buffer gesture numeric-argument) + (declare (ignore input-buffer gesture numeric-argument)) (let* ((accepting-type *active-history-type*) (history (and accepting-type (presentation-type-history accepting-type)))) @@ -228,8 +221,6 @@ (when type (presentation-replace-input stream object type (stream-default-view stream))))))) -(add-input-editor-command '((#\y :control :meta)) 'history-yank) - -(add-input-editor-command '((#\p :meta)) 'history-yank-next) +(add-input-editor-command '((#\n :meta)) 'history-yank-next) -(add-input-editor-command '((#\n :meta)) 'history-yank-previous) +(add-input-editor-command '((#\p :meta)) 'history-yank-previous)

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 26 Nov '06

26 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv3899 Modified Files: ffi.lisp gadgets.lisp Log Message: Implement DE-/ACTIVATE-GADGET natively. * ffi.lisp: Regenerated. * gagets.lisp ((realize-native-widget :around) (activate-gadget :after native-widget-mixin) (deactivate-gadget :after native-widget-mixin)): De/activate the widget. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp 2006/11/25 21:11:33 1.6 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp 2006/11/26 17:54:08 1.7 @@ -1293,6 +1293,12 @@ (events :int) ;gint ) +(defcfun "gtk_widget_set_sensitive" + :void + (widget :pointer) ;GtkWidget * + (sensitive :int) ;gboolean + ) + (defcfun "gtk_widget_set_size_request" :void (widget :pointer) ;GtkWidget * --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/11/25 21:11:33 1.13 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/11/26 17:54:08 1.14 @@ -585,6 +585,21 @@ (gtk_toggle_button_set_active (mirror-widget mirror) (if value 1 0)))))) +(defmethod realize-native-widget :around ((gadget native-widget-mixin)) + (let ((widget (call-next-method))) + (gtk_widget_set_sensitive widget (if (gadget-active-p gadget) 1 0)) + widget)) + +(defmethod activate-gadget :after ((gadget native-widget-mixin)) + (with-gtk () + (when (native-widget gadget) + (gtk_widget_set_sensitive (native-widget gadget) 1)))) + +(defmethod deactivate-gadget :after ((gadget native-widget-mixin)) + (with-gtk () + (when (native-widget gadget) + (gtk_widget_set_sensitive (native-widget gadget) 0)))) + ;;; Scroll bars.

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 25 Nov '06

25 Nov '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv29938 Modified Files: event.lisp gtk-ffi.lisp Log Message: "Oops." Fixed some more bugs introduced with the FFI regeneration last week. * event.lisp (INVOKE-LATER): g_idle_add takes a pointer, not a long. * gtk-ffi.lisp (DEFCFUN): Don't check the cairo status of cairo_font_face_status. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/11/12 20:12:19 1.13 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/11/25 21:14:53 1.14 @@ -403,7 +403,7 @@ (with-gtk () (let ((i (incf *later-counter*))) (setf (gethash i *later-table*) fun) - (g_idle_add (cffi:get-callback 'idle-function) i)))) + (g_idle_add (cffi:get-callback 'idle-function) (cffi:make-pointer i))))) (cffi:defcallback idle-function :int ((data :long)) ;hack --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/11/20 19:53:44 1.16 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/11/25 21:14:53 1.17 @@ -44,7 +44,8 @@ (defmacro defcfun (name rtype &rest argtypes) (if (and (eq rtype 'cairo_status_t) - (not (equal name "cairo_status"))) + (not (or (equal name "cairo_status") + (equal name "cairo_font_face_status")))) `(def-cairo-fun ,name ,rtype ,@argtypes) `(cffi:defcfun (,name ,(intern (string-upcase name) :clim-gtkairo)) ,rtype

1 0