April 2008 - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 30 Apr '08

30 Apr '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv7853/ESA Modified Files: esa.lisp Removed Files: dead-keys.lisp Log Message: Really Fix dead keys. Now integrated with the gesture reading machinery in standard-extended-input-steeam, so it can be circumvented if you really don't want it by handling events manually. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/04/29 20:52:05 1.21 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/04/30 21:27:46 1.22 @@ -551,21 +551,20 @@ (setf (overriding-handler (super-command-processor command-processor)) nil)) (defmethod process-gesture :around ((command-processor command-loop-command-processor) gesture) - (handling-dead-keys (gesture) - (cond ((find gesture *abort-gestures* - :test #'gesture-matches-gesture-name-p) - ;; It is to be expected that the abort function might signal - ;; `abort-gesture'. If that happens, we must end the command - ;; loop, but ONLY if this is signalled. - (handler-case (funcall (abort-function command-processor)) - (abort-gesture (c) - (end-command-loop command-processor) - (signal c)))) - (t - (call-next-method) - (when (funcall (end-condition command-processor)) - (funcall (end-function command-processor)) - (end-command-loop command-processor)))))) + (cond ((find gesture *abort-gestures* + :test #'gesture-matches-gesture-name-p) + ;; It is to be expected that the abort function might signal + ;; `abort-gesture'. If that happens, we must end the command + ;; loop, but ONLY if this is signalled. + (handler-case (funcall (abort-function command-processor)) + (abort-gesture (c) + (end-command-loop command-processor) + (signal c)))) + (t + (call-next-method) + (when (funcall (end-condition command-processor)) + (funcall (end-function command-processor)) + (end-command-loop command-processor))))) (defun process-gestures-for-numeric-argument (gestures) "Processes a list of gestures for numeric argument @@ -774,12 +773,9 @@ ;; well, something that either requires this kind of repeated ;; rescanning of accumulated input data or some yet-unimplemented ;; complex state retaining mechanism (such as continuations). - (loop for gesture = (esa-read-gesture :command-processor command-processor) - for first = t then nil - do (handling-dead-keys (gesture first) - (let ((*current-gesture* gesture)) - (unless (process-gesture command-processor *current-gesture*) - (return)))))) + (loop (let ((*current-gesture* (esa-read-gesture :command-processor command-processor))) + (unless (process-gesture command-processor *current-gesture*) + (return))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 30 Apr '08

30 Apr '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv7853 Modified Files: mcclim.asd stream-input.lisp Added Files: dead-keys.lisp Log Message: Really Fix dead keys. Now integrated with the gesture reading machinery in standard-extended-input-steeam, so it can be circumvented if you really don't want it by handling events manually. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/04/29 16:27:42 1.81 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/04/30 21:27:48 1.82 @@ -164,6 +164,7 @@ "stream-output" "recording")) (:file "stream-input" :depends-on ("decls" "protocol-classes" "Lisp-Dep" "input" "ports" "sheets" "events" "encapsulate" "transforms" "utils")) + (:file "dead-keys" :depends-on ("stream-input")) (:file "text-selection" :depends-on ("decls" "protocol-classes" "Lisp-Dep" "X11-colors" "medium" "output" "transforms" "sheets" "stream-output" "ports" "recording" "regions" @@ -259,8 +260,7 @@ :components ((:file "packages") (:file "utils" :depends-on ("packages")) (:file "colors" :depends-on ("packages")) - (:file "dead-keys" :depends-on ("utils")) - (:file "esa" :depends-on ("colors" "packages" "utils" "dead-keys")) + (:file "esa" :depends-on ("colors" "packages" "utils")) (:file "esa-buffer" :depends-on ("packages" "esa")) (:file "esa-io" :depends-on ("packages" "esa" "esa-buffer")) (:file "esa-command-parser" :depends-on ("packages" "esa")))))) --- /project/mcclim/cvsroot/mcclim/stream-input.lisp 2007/02/07 12:44:17 1.51 +++ /project/mcclim/cvsroot/mcclim/stream-input.lisp 2008/04/30 21:27:48 1.52 @@ -122,9 +122,77 @@ do (handle-event (event-sheet event) event)) nil) +(defvar *dead-key-table* (make-hash-table :test 'equal) + "A hash table mapping keyboard event names and characters to +either a similar hash table or characters.") + +(defclass dead-key-merging-mixin () + ((state :initform *dead-key-table*) + (last-deadie-gesture) ; For avoiding name clash with standard-extended-input-stream + (last-state)) + (:documentation "A mixin class for extended input streams that +takes care of handling dead keys. This is done by still passing +every gesture on, but accenting the final one as per the dead +keys read.")) + +(defmethod stream-read-gesture :around + ((stream dead-key-merging-mixin) + &key timeout peek-p + (input-wait-test *input-wait-test*) + (input-wait-handler *input-wait-handler*) + (pointer-button-press-handler + *pointer-button-press-handler*)) + (with-slots (state last-deadie-gesture last-state) stream + (handler-case + (loop with start-time = (get-internal-real-time) + with end-time = start-time + for gesture = (call-next-method stream + :timeout (when timeout + (- timeout (/ (- end-time start-time) + internal-time-units-per-second))) + :peek-p peek-p + :input-wait-test input-wait-test + :input-wait-handler input-wait-handler + :pointer-button-press-handler + pointer-button-press-handler) + do (setf end-time (get-internal-real-time) + last-deadie-gesture gesture + last-state state) + do (if (typep gesture '(or keyboard-event character)) + (let ((value (gethash (if (characterp gesture) + gesture + (keyboard-event-key-name gesture)) + state))) + (etypecase value + (null + (cond ((eq state *dead-key-table*) + (return gesture)) + ((or (and (typep gesture 'keyboard-event) + (keyboard-event-character gesture)) + (characterp gesture)) + (setf state *dead-key-table*)))) + (character + (setf state *dead-key-table*) + (return value)) + (hash-table + (return (setf state value))))) + (return gesture))) + ;; Policy decision: an abort cancels the current composition. + (abort-gesture (c) + (setf state *dead-key-table*) + (signal c))))) + +(defmethod stream-unread-gesture :around ((stream dead-key-merging-mixin) gesture) + (if (typep gesture '(or keyboard-event character)) + (with-slots (state last-deadie-gesture last-state) stream + (setf state last-state) + (call-next-method stream last-deadie-gesture)) + (call-next-method))) + (defclass standard-extended-input-stream (extended-input-stream ;; FIXME: is this still needed? - standard-sheet-input-mixin) + standard-sheet-input-mixin + dead-key-merging-mixin) ((pointer) (cursor :initarg :text-cursor) (last-gesture :accessor last-gesture :initform nil --- /project/mcclim/cvsroot/mcclim/dead-keys.lisp 2008/04/30 21:27:48 NONE +++ /project/mcclim/cvsroot/mcclim/dead-keys.lisp 2008/04/30 21:27:48 1.1 ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*- ;;; (c) copyright 2008 by ;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. ;;; Define various dead keys - perhaps this should be more ;;; backend-agnostic? Bah... (in-package :clim-internals) (defun set-dead-key-combination (character gestures table) "Set `gestures' to result in `character' in the hash table `table' (see `*dead-key-table*' for the format of the hash table)." (assert (not (null gestures))) (if (null (rest gestures)) ;; Just add it directly to this table. (setf (gethash (first gestures) table) character) ;; Ensure that the subtable exists. (let ((new-table (setf (gethash (first gestures) table) (gethash (first gestures) table (make-hash-table :test 'equal))))) (set-dead-key-combination character (rest gestures) new-table)))) (defmacro define-dead-key-combination (character (&rest gestures)) "Define a dead key combination that results in `character' when `gestures' (either characters or key names) is entered." (assert (>= (length gestures) 2)) `(set-dead-key-combination ,character ',gestures *dead-key-table*)) (define-dead-key-combination (code-char 193) (:dead-acute #\a)) (define-dead-key-combination (code-char 201) (:dead-acute #\e)) (define-dead-key-combination (code-char 205) (:dead-acute #\i)) (define-dead-key-combination (code-char 211) (:dead-acute #\o)) (define-dead-key-combination (code-char 218) (:dead-acute #\u)) (define-dead-key-combination (code-char 221) (:dead-acute #\y)) (define-dead-key-combination (code-char 225) (:dead-acute #\a)) (define-dead-key-combination (code-char 233) (:dead-acute #\e)) (define-dead-key-combination (code-char 237) (:dead-acute #\i)) (define-dead-key-combination (code-char 243) (:dead-acute #\o)) (define-dead-key-combination (code-char 250) (:dead-acute #\u)) (define-dead-key-combination (code-char 253) (:dead-acute #\y)) (define-dead-key-combination (code-char 199) (:dead-acute #\c)) (define-dead-key-combination (code-char 231) (:dead-acute #\c)) (define-dead-key-combination (code-char 215) (:dead-acute #\x)) (define-dead-key-combination (code-char 247) (:dead-acute #\-)) (define-dead-key-combination (code-char 222) (:dead-acute #\t)) (define-dead-key-combination (code-char 254) (:dead-acute #\t)) (define-dead-key-combination (code-char 223) (:dead-acute #\s)) (define-dead-key-combination (code-char 39) (:dead-acute #\space)) (define-dead-key-combination (code-char 197) (:dead-acute :dead-acute #\a)) (define-dead-key-combination (code-char 229) (:dead-acute :dead-acute #\a)) (define-dead-key-combination (code-char 192) (:dead-grave #\a)) (define-dead-key-combination (code-char 200) (:dead-grave #\e)) (define-dead-key-combination (code-char 204) (:dead-grave #\i)) (define-dead-key-combination (code-char 210) (:dead-grave #\o)) (define-dead-key-combination (code-char 217) (:dead-grave #\u)) (define-dead-key-combination (code-char 224) (:dead-grave #\a)) (define-dead-key-combination (code-char 232) (:dead-grave #\e)) (define-dead-key-combination (code-char 236) (:dead-grave #\i)) (define-dead-key-combination (code-char 242) (:dead-grave #\o)) (define-dead-key-combination (code-char 249) (:dead-grave #\u)) (define-dead-key-combination (code-char 96) (:dead-grave #\space)) (define-dead-key-combination (code-char 96) (:dead-grave :dead-grave)) (define-dead-key-combination (code-char 196) (:dead-diaeresis #\a)) (define-dead-key-combination (code-char 203) (:dead-diaeresis #\e)) (define-dead-key-combination (code-char 207) (:dead-diaeresis #\i)) (define-dead-key-combination (code-char 214) (:dead-diaeresis #\o)) (define-dead-key-combination (code-char 220) (:dead-diaeresis #\u)) (define-dead-key-combination (code-char 228) (:dead-diaeresis #\a)) (define-dead-key-combination (code-char 235) (:dead-diaeresis #\e)) (define-dead-key-combination (code-char 239) (:dead-diaeresis #\i)) (define-dead-key-combination (code-char 246) (:dead-diaeresis #\o)) (define-dead-key-combination (code-char 252) (:dead-diaeresis #\u)) (define-dead-key-combination (code-char 255) (:dead-diaeresis #\y)) (define-dead-key-combination (code-char 168) (:dead-diaeresis #\space)) (define-dead-key-combination (code-char 168) (:dead-diaeresis :dead-diaeresis)) (define-dead-key-combination (code-char 195) (:dead-tilde #\a)) (define-dead-key-combination (code-char 209) (:dead-tilde #\n)) (define-dead-key-combination (code-char 227) (:dead-tilde #\a)) (define-dead-key-combination (code-char 241) (:dead-tilde #\n)) (define-dead-key-combination (code-char 198) (:dead-tilde #\e)) (define-dead-key-combination (code-char 230) (:dead-tilde #\e)) (define-dead-key-combination (code-char 208) (:dead-tilde #\d)) (define-dead-key-combination (code-char 240) (:dead-tilde #\d)) (define-dead-key-combination (code-char 245) (:dead-tilde #\o)) (define-dead-key-combination (code-char 126) (:dead-tilde #\space)) (define-dead-key-combination (code-char 126) (:dead-tilde :dead-tilde)) (define-dead-key-combination (code-char 194) (:dead-circumflex #\a)) (define-dead-key-combination (code-char 202) (:dead-circumflex #\e)) (define-dead-key-combination (code-char 206) (:dead-circumflex #\i)) (define-dead-key-combination (code-char 212) (:dead-circumflex #\o)) (define-dead-key-combination (code-char 219) (:dead-circumflex #\u)) (define-dead-key-combination (code-char 226) (:dead-circumflex #\a)) (define-dead-key-combination (code-char 234) (:dead-circumflex #\e)) (define-dead-key-combination (code-char 238) (:dead-circumflex #\i)) (define-dead-key-combination (code-char 244) (:dead-circumflex #\o)) (define-dead-key-combination (code-char 251) (:dead-circumflex #\u)) (define-dead-key-combination (code-char 94) (:dead-circumflex #\space)) (define-dead-key-combination (code-char 94) (:dead-circumflex :dead-circumflex))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 30 Apr '08

30 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv7853/Drei Modified Files: drei-clim.lisp input-editor.lisp Log Message: Really Fix dead keys. Now integrated with the gesture reading machinery in standard-extended-input-steeam, so it can be circumvented if you really don't want it by handling events manually. --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/04/29 20:52:02 1.43 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/04/30 21:27:46 1.44 @@ -392,6 +392,10 @@ (declare (ignore args)) (display-drei-area drei)) +(defmethod execute-drei-command ((drei drei-area) command) + (let ((*standard-input* (or *minibuffer* *standard-input*))) + (call-next-method))) + ;;; Implementation of the displayed-output-record and region protocol ;;; for Drei areas. The redisplay-related stuff is in ;;; drei-redisplay.lisp. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/08 13:24:48 1.46 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/04/30 21:27:46 1.47 @@ -565,32 +565,37 @@ (old-buffer-contents (buffer-sequence buffer 0 (size buffer)))) (with-bound-drei-special-variables (drei :prompt "M-x ") (update-drei-buffer stream) - ;; Commands are permitted to signal immediate rescans, but - ;; we may need to do some stuff first. - (unwind-protect - (accepting-from-user (drei) - ;; We narrow the buffer to the last object before - ;; input-position, so the user will not be able to - ;; delete arguments prompts or other things. - (drei-core:with-narrowed-buffer (drei - (loop for index from - (1- (input-position stream)) above 0 - when (typep (buffer-object buffer index) - 'noise-string) - return (1+ index) - finally (return 0)) - t t) - (handler-case (process-gestures-or-command drei) - (unbound-gesture-sequence (c) - (display-message "~A is unbound" (gesture-name (gestures c)))) - (abort-gesture (c) - (if (member (abort-gesture-event c) - *abort-gestures* - :test #'event-matches-gesture-name-p) - (signal 'abort-gesture :event (abort-gesture-event c)) - (when was-directly-processing - (display-message "Aborted"))))))) - (update-drei-buffer stream)) + ;; Since we have an unread gesture in the encapsulated stream, + ;; we should use that for further input. *standard-input* is + ;; bound back to the minibuffer (maybe) when an actual command + ;; is executed. + (let ((*standard-input* (encapsulating-stream-stream stream))) + ;; Commands are permitted to signal immediate rescans, but + ;; we may need to do some stuff first. + (unwind-protect + (accepting-from-user (drei) + ;; We narrow the buffer to the last object before + ;; input-position, so the user will not be able to + ;; delete arguments prompts or other things. + (drei-core:with-narrowed-buffer (drei + (loop for index from + (1- (input-position stream)) above 0 + when (typep (buffer-object buffer index) + 'noise-string) + return (1+ index) + finally (return 0)) + t t) + (handler-case (process-gestures-or-command drei) + (unbound-gesture-sequence (c) + (display-message "~A is unbound" (gesture-name (gestures c)))) + (abort-gesture (c) + (if (member (abort-gesture-event c) + *abort-gestures* + :test #'event-matches-gesture-name-p) + (signal 'abort-gesture :event (abort-gesture-event c)) + (when was-directly-processing + (display-message "Aborted"))))))) + (update-drei-buffer stream))) (let ((first-mismatch (buffer-array-mismatch buffer old-buffer-contents))) (display-drei drei :redisplay-minibuffer t) (cond ((null first-mismatch)

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 29 Apr '08

29 Apr '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv30176/ESA Modified Files: dead-keys.lisp esa.lisp packages.lisp Log Message: Actually fix dead keys. Turns out I got confused in my own maze of command processors. Still needs a proper design decision about what to do wrt. abort gestures (C-g). --- /project/mcclim/cvsroot/mcclim/ESA/dead-keys.lisp 2008/04/29 16:27:42 1.1 +++ /project/mcclim/cvsroot/mcclim/ESA/dead-keys.lisp 2008/04/29 20:52:04 1.2 @@ -113,18 +113,26 @@ (define-dead-key-combination (code-char 251) (:dead-circumflex #\u)) (define-dead-key-combination (code-char 94) (:dead-circumflex #\space)) -(defmacro handling-dead-keys ((gesture) &body body) +(defmacro handling-dead-keys ((gesture &optional restart) &body body) "Accumulate dead keys and subsequent characters. `Gesture' should be a symbol bound to either a gesture or an input event. When it has been determined that a sequence of `gesture's either does or doesn't result in a full gesture, `body' will be -evaluated with `gesture' bound to that gesture." +evaluated with `gesture' bound to that gesture. If `restart' is +true, start over with a new accumulation. If an `abort-gesture' +condition is signalled in `body', the accumulation will be +cleared." (with-gensyms (state-sym) `(retaining-value (,state-sym *dead-key-table*) + (when ,restart + (setf ,state-sym *dead-key-table*)) (flet ((invoke-body (,gesture) (setf ,state-sym *dead-key-table*) - ,@body)) - (if (typep gesture '(or keyboard-event character)) + (handler-case (progn ,@body) + (abort-gesture (c) + (setf ,state-sym *dead-key-table*) + (signal c))))) + (if (typep ,gesture '(or keyboard-event character)) (let ((value (gethash (if (characterp ,gesture) ,gesture (keyboard-event-key-name ,gesture)) --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/04/29 16:27:42 1.20 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/04/29 20:52:05 1.21 @@ -550,7 +550,7 @@ (end-command-loop (overriding-handler command-processor))) (setf (overriding-handler (super-command-processor command-processor)) nil)) -(defmethod process-gesture ((command-processor command-loop-command-processor) gesture) +(defmethod process-gesture :around ((command-processor command-loop-command-processor) gesture) (handling-dead-keys (gesture) (cond ((find gesture *abort-gestures* :test #'gesture-matches-gesture-name-p) @@ -562,10 +562,7 @@ (end-command-loop command-processor) (signal c)))) (t - (setf (accumulated-gestures command-processor) - (nconc (accumulated-gestures command-processor) - (list gesture))) - (process-gestures command-processor) + (call-next-method) (when (funcall (end-condition command-processor)) (funcall (end-function command-processor)) (end-command-loop command-processor)))))) @@ -777,11 +774,12 @@ ;; well, something that either requires this kind of repeated ;; rescanning of accumulated input data or some yet-unimplemented ;; complex state retaining mechanism (such as continuations). - (loop - (setf *current-gesture* - (esa-read-gesture :command-processor command-processor)) - (unless (process-gesture command-processor *current-gesture*) - (return)))) + (loop for gesture = (esa-read-gesture :command-processor command-processor) + for first = t then nil + do (handling-dead-keys (gesture first) + (let ((*current-gesture* gesture)) + (unless (process-gesture command-processor *current-gesture*) + (return)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/04/29 16:27:42 1.18 +++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/04/29 20:52:05 1.19 @@ -89,6 +89,7 @@ #:find-applicable-command-table #:esa-command-parser #:esa-partial-command-parser + #:handling-dead-keys #:gesture-matches-gesture-name-p #:meta-digit #:proper-gesture-p

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 29 Apr '08

29 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv30176/Drei Modified Files: drei-clim.lisp Log Message: Actually fix dead keys. Turns out I got confused in my own maze of command processors. Still needs a proper design decision about what to do wrt. abort gestures (C-g). --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/02/16 21:33:40 1.42 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/04/29 20:52:02 1.43 @@ -296,11 +296,12 @@ (*abort-gestures* *esa-abort-gestures*) (*standard-input* drei)) (accepting-from-user (drei) - (handler-case (process-gesture drei gesture) - (unbound-gesture-sequence (c) - (display-message "~A is unbound" (gesture-name (gestures c)))) - (abort-gesture () - (display-message "Aborted"))) + (handling-dead-keys (gesture) + (handler-case (process-gesture drei gesture) + (unbound-gesture-sequence (c) + (display-message "~A is unbound" (gesture-name (gestures c)))) + (abort-gesture () + (display-message "Aborted")))) (display-drei drei :redisplay-minibuffer t) (when (modified-p (view drei)) (when (gadget-value-changed-callback drei)

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 29 Apr '08

29 Apr '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv10422 Modified Files: mcclim.asd Log Message: Improved dead key handling for ESAs (well, some of them). Now uses a clever state machine to merge dead keys, rather than the old command table hack. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/04/23 12:05:30 1.80 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/04/29 16:27:42 1.81 @@ -259,7 +259,8 @@ :components ((:file "packages") (:file "utils" :depends-on ("packages")) (:file "colors" :depends-on ("packages")) - (:file "esa" :depends-on ("colors" "packages" "utils")) + (:file "dead-keys" :depends-on ("utils")) + (:file "esa" :depends-on ("colors" "packages" "utils" "dead-keys")) (:file "esa-buffer" :depends-on ("packages" "esa")) (:file "esa-io" :depends-on ("packages" "esa" "esa-buffer")) (:file "esa-command-parser" :depends-on ("packages" "esa")))))) @@ -319,7 +320,6 @@ :pathname #p"Persistent/persistent-undo.lisp" :depends-on ("packages" "buffer" "persistent-buffer" "undo")) (:file "misc-commands" :depends-on ("basic-commands")) - (:file "unicode-commands" :depends-on ("core" "drei-clim")) (:file "search-commands" :depends-on ("core" "targets" "drei-clim")) (:file "lr-syntax" :depends-on ("fundamental-syntax" "core" "drawing-options")) (:file "lisp-syntax" :depends-on ("lr-syntax" "motion" "core"))

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 29 Apr '08

29 Apr '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv10422/ESA Modified Files: esa.lisp packages.lisp utils.lisp Added Files: dead-keys.lisp Log Message: Improved dead key handling for ESAs (well, some of them). Now uses a clever state machine to merge dead keys, rather than the old command table hack. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/02/03 08:38:26 1.19 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/04/29 16:27:42 1.20 @@ -550,21 +550,25 @@ (end-command-loop (overriding-handler command-processor))) (setf (overriding-handler (super-command-processor command-processor)) nil)) -(defmethod process-gesture :around ((command-processor command-loop-command-processor) gesture) - (cond ((find gesture *abort-gestures* - :test #'gesture-matches-gesture-name-p) - ;; It is to be expected that the abort function might signal - ;; `abort-gesture'. If that happens, we must end the command - ;; loop, but ONLY if this is signalled. - (handler-case (funcall (abort-function command-processor)) - (abort-gesture (c) - (end-command-loop command-processor) - (signal c)))) - (t - (call-next-method) - (when (funcall (end-condition command-processor)) - (funcall (end-function command-processor)) - (end-command-loop command-processor))))) +(defmethod process-gesture ((command-processor command-loop-command-processor) gesture) + (handling-dead-keys (gesture) + (cond ((find gesture *abort-gestures* + :test #'gesture-matches-gesture-name-p) + ;; It is to be expected that the abort function might signal + ;; `abort-gesture'. If that happens, we must end the command + ;; loop, but ONLY if this is signalled. + (handler-case (funcall (abort-function command-processor)) + (abort-gesture (c) + (end-command-loop command-processor) + (signal c)))) + (t + (setf (accumulated-gestures command-processor) + (nconc (accumulated-gestures command-processor) + (list gesture))) + (process-gestures command-processor) + (when (funcall (end-condition command-processor)) + (funcall (end-function command-processor)) + (end-command-loop command-processor)))))) (defun process-gestures-for-numeric-argument (gestures) "Processes a list of gestures for numeric argument --- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/02/03 08:38:26 1.17 +++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/04/29 16:27:42 1.18 @@ -46,6 +46,7 @@ #:capitalize #:ensure-array-size #:values-max-min + #:retaining-value #:build-menu #:define-menu-table #:observable-mixin #:add-observer #:remove-observer --- /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2008/01/29 22:59:30 1.11 +++ /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2008/04/29 16:27:42 1.12 @@ -261,6 +261,18 @@ `(call-method ,(first around) (,@(rest around) (make-method ,form))) form)))) +(defmacro retaining-value ((bound-symbol &optional initial-value) &body body) + "Evaluate `body' with `bound-symbol' bound to +`initial-value' (default NIL). Th next time `body' is evaluated, +`bound-symbol' will be bound to whatever its value was the last +time evaluation of `body' ended." + (let ((symbol (gensym))) + `(progn (unless (boundp ',symbol) + (setf (symbol-value ',symbol) ,initial-value)) + (let ((,bound-symbol (symbol-value ',symbol))) + (unwind-protect (progn ,@body) + (setf (symbol-value ',symbol) ,bound-symbol)))))) + (defun build-menu (command-tables &rest commands) "Create a command table inheriting commands from `command-tables', which must be a list of command table --- /project/mcclim/cvsroot/mcclim/ESA/dead-keys.lisp 2008/04/29 16:27:42 NONE +++ /project/mcclim/cvsroot/mcclim/ESA/dead-keys.lisp 2008/04/29 16:27:42 1.1 ;;; -*- Mode: Lisp; Package: ESA -*- ;;; (c) copyright 2008 by ;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. ;;; Elegantly handle dead keys by collapsing into single characters. (in-package :esa) (defvar *dead-key-table* (make-hash-table :test 'equal) "A hash table mapping keyboard event names and characters to either a similar hash table or characters.") (defun set-dead-key-combination (character gestures table) "Set `gestures' to result in `character' in the hash table `table' (see `*dead-key-table*' for the format of the hash table)." (assert (not (null gestures))) (if (null (rest gestures)) ;; Just add it directly to this table. (setf (gethash (first gestures) table) character) ;; Ensure that the subtable exists. (let ((new-table (setf (gethash (first gestures) table) (gethash (first gestures) table (make-hash-table :test 'equal))))) (set-dead-key-combination character (rest gestures) new-table)))) (defmacro define-dead-key-combination (character (&rest gestures)) "Define a dead key combination that results in `character' when `gestures' (either characters or key names) is entered." (assert (>= (length gestures) 2)) `(set-dead-key-combination ,character ',gestures *dead-key-table*)) (define-dead-key-combination (code-char 193) (:dead-acute #\a)) (define-dead-key-combination (code-char 201) (:dead-acute #\e)) (define-dead-key-combination (code-char 205) (:dead-acute #\i)) (define-dead-key-combination (code-char 211) (:dead-acute #\o)) (define-dead-key-combination (code-char 218) (:dead-acute #\u)) (define-dead-key-combination (code-char 221) (:dead-acute #\y)) (define-dead-key-combination (code-char 225) (:dead-acute #\a)) (define-dead-key-combination (code-char 233) (:dead-acute #\e)) (define-dead-key-combination (code-char 237) (:dead-acute #\i)) (define-dead-key-combination (code-char 243) (:dead-acute #\o)) (define-dead-key-combination (code-char 250) (:dead-acute #\u)) (define-dead-key-combination (code-char 253) (:dead-acute #\y)) (define-dead-key-combination (code-char 199) (:dead-acute #\c)) (define-dead-key-combination (code-char 231) (:dead-acute #\c)) (define-dead-key-combination (code-char 215) (:dead-acute #\x)) (define-dead-key-combination (code-char 247) (:dead-acute #\-)) (define-dead-key-combination (code-char 222) (:dead-acute #\t)) (define-dead-key-combination (code-char 254) (:dead-acute #\t)) (define-dead-key-combination (code-char 223) (:dead-acute #\s)) (define-dead-key-combination (code-char 39) (:dead-acute #\space)) (define-dead-key-combination (code-char 197) (:dead-acute :dead-acute #\a)) (define-dead-key-combination (code-char 229) (:dead-acute :dead-acute #\a)) (define-dead-key-combination (code-char 192) (:dead-grave #\a)) (define-dead-key-combination (code-char 200) (:dead-grave #\e)) (define-dead-key-combination (code-char 204) (:dead-grave #\i)) (define-dead-key-combination (code-char 210) (:dead-grave #\o)) (define-dead-key-combination (code-char 217) (:dead-grave #\u)) (define-dead-key-combination (code-char 224) (:dead-grave #\a)) (define-dead-key-combination (code-char 232) (:dead-grave #\e)) (define-dead-key-combination (code-char 236) (:dead-grave #\i)) (define-dead-key-combination (code-char 242) (:dead-grave #\o)) (define-dead-key-combination (code-char 249) (:dead-grave #\u)) (define-dead-key-combination (code-char 96) (:dead-grave #\space)) (define-dead-key-combination (code-char 196) (:dead-diaeresis #\a)) (define-dead-key-combination (code-char 203) (:dead-diaeresis #\e)) (define-dead-key-combination (code-char 207) (:dead-diaeresis #\i)) (define-dead-key-combination (code-char 214) (:dead-diaeresis #\o)) (define-dead-key-combination (code-char 220) (:dead-diaeresis #\u)) (define-dead-key-combination (code-char 228) (:dead-diaeresis #\a)) (define-dead-key-combination (code-char 235) (:dead-diaeresis #\e)) (define-dead-key-combination (code-char 239) (:dead-diaeresis #\i)) (define-dead-key-combination (code-char 246) (:dead-diaeresis #\o)) (define-dead-key-combination (code-char 252) (:dead-diaeresis #\u)) (define-dead-key-combination (code-char 255) (:dead-diaeresis #\y)) (define-dead-key-combination (code-char 34) (:dead-diaeresis #\space)) (define-dead-key-combination (code-char 195) (:dead-tilde #\a)) (define-dead-key-combination (code-char 209) (:dead-tilde #\n)) (define-dead-key-combination (code-char 227) (:dead-tilde #\a)) (define-dead-key-combination (code-char 241) (:dead-tilde #\n)) (define-dead-key-combination (code-char 198) (:dead-tilde #\e)) (define-dead-key-combination (code-char 230) (:dead-tilde #\e)) (define-dead-key-combination (code-char 208) (:dead-tilde #\d)) (define-dead-key-combination (code-char 240) (:dead-tilde #\d)) (define-dead-key-combination (code-char 245) (:dead-tilde #\o)) (define-dead-key-combination (code-char 126) (:dead-tilde #\space)) (define-dead-key-combination (code-char 194) (:dead-circumflex #\a)) (define-dead-key-combination (code-char 202) (:dead-circumflex #\e)) (define-dead-key-combination (code-char 206) (:dead-circumflex #\i)) (define-dead-key-combination (code-char 212) (:dead-circumflex #\o)) (define-dead-key-combination (code-char 219) (:dead-circumflex #\u)) (define-dead-key-combination (code-char 226) (:dead-circumflex #\a)) (define-dead-key-combination (code-char 234) (:dead-circumflex #\e)) (define-dead-key-combination (code-char 238) (:dead-circumflex #\i)) (define-dead-key-combination (code-char 244) (:dead-circumflex #\o)) (define-dead-key-combination (code-char 251) (:dead-circumflex #\u)) (define-dead-key-combination (code-char 94) (:dead-circumflex #\space)) (defmacro handling-dead-keys ((gesture) &body body) "Accumulate dead keys and subsequent characters. `Gesture' should be a symbol bound to either a gesture or an input event. When it has been determined that a sequence of `gesture's either does or doesn't result in a full gesture, `body' will be evaluated with `gesture' bound to that gesture." (with-gensyms (state-sym) `(retaining-value (,state-sym *dead-key-table*) (flet ((invoke-body (,gesture) (setf ,state-sym *dead-key-table*) ,@body)) (if (typep gesture '(or keyboard-event character)) (let ((value (gethash (if (characterp ,gesture) ,gesture (keyboard-event-key-name ,gesture)) ,state-sym))) (etypecase value (null (if (eq ,state-sym *dead-key-table*) (invoke-body ,gesture) (setf ,state-sym *dead-key-table*))) (character (invoke-body value)) (hash-table (setf ,state-sym value)))) (invoke-body ,gesture))))))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 29 Apr '08

29 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv10422/Drei Removed Files: unicode-commands.lisp Log Message: Improved dead key handling for ESAs (well, some of them). Now uses a clever state machine to merge dead keys, rather than the old command table hack.

1 0

[mcclim-cvs] CVS mcclim/Backends/CLX
by thenriksen 28 Apr '08

28 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv5400/Backends/CLX Modified Files: keysyms.lisp Log Message: Filter shift modifier state in CLX backend. Also updated a bunch of key bindings to not specify :SHIFT anymore. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/keysyms.lisp 2004/08/01 14:09:01 1.10 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/keysyms.lisp 2008/04/28 20:48:55 1.11 @@ -42,31 +42,38 @@ (defun x-event-to-key-name-and-modifiers (port event-key keycode state) (multiple-value-bind (clim-modifiers shift-lock? caps-lock? mode-switch?) (clim-xcommon:x-event-state-modifiers port state) + ;; We filter away the shift state if there is a difference between + ;; the shifted and unshifted keysym. This is so eg. #\A will not + ;; look like "#\A with a Shift modifier", as this makes gesture + ;; processing more difficult. (let* ((display (clx-port-display port)) (shift? (logtest +shift-key+ clim-modifiers)) - (keysym (xlib:keycode->keysym display keycode - (+ (if (if shift-lock? - (not shift?) - (if caps-lock? t shift?)) - 1 0) - (if mode-switch? - 2 0)))) - (keysym-keyword (clim-xcommon:lookup-keysym keysym)) - (char (xlib:keysym->character display keysym - (+ (if (if shift-lock? - (not shift?) - (if caps-lock? t shift?)) - 1 0) - (if mode-switch? - 2 0))))) - (values char - (clim-xcommon:x-keysym-to-clim-modifiers port - event-key - char - (clim-xcommon:lookup-keysym - keysym) - state) - keysym-keyword)))) + (shift-modifier? (if shift-lock? + (not shift?) + (if caps-lock? t shift?))) + (shifted-keysym (xlib:keycode->keysym display keycode + (+ 1 (if mode-switch? + 2 0)))) + (unshifted-keysym (xlib:keycode->keysym display keycode + (if mode-switch? + 2 0))) + (keysym (if shift-modifier? + shifted-keysym + unshifted-keysym))) + (let* ((keysym-keyword (clim-xcommon:lookup-keysym keysym)) + (char (xlib:keysym->character display keysym + (+ (if shift-modifier? + 1 0) + (if mode-switch? + 2 0)))) + (modifiers (clim-xcommon:x-keysym-to-clim-modifiers + port event-key char (clim-xcommon:lookup-keysym keysym) + state))) + (values char + (if (= shifted-keysym unshifted-keysym) + modifiers + (logandc2 modifiers +shift-key+)) + keysym-keyword))))) ;;;;

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 28 Apr '08

28 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv5400/Drei Modified Files: basic-commands.lisp core-commands.lisp misc-commands.lisp search-commands.lisp unicode-commands.lisp Log Message: Filter shift modifier state in CLX backend. Also updated a bunch of key bindings to not specify :SHIFT anymore. --- /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2008/02/03 08:55:01 1.13 +++ /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2008/04/28 20:48:55 1.14 @@ -242,7 +242,7 @@ (set-key `(com-backward-paragraph ,*numeric-argument-marker*) 'movement-table - '((#\{ :shift :meta))) + '((#\{ :meta))) (set-key `(com-backward-paragraph ,*numeric-argument-marker*) 'movement-table @@ -250,7 +250,7 @@ (set-key `(com-forward-paragraph ,*numeric-argument-marker*) 'movement-table - '((#\} :shift :meta))) + '((#\} :meta))) (set-key `(com-forward-paragraph ,*numeric-argument-marker*) 'movement-table --- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/02/03 07:16:49 1.17 +++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/04/28 20:48:55 1.18 @@ -156,7 +156,7 @@ (set-key `(com-mark-word ,*numeric-argument-marker*) 'marking-table - '((#\@ :meta :shift))) + '((#\@ :meta))) (set-key `(com-mark-paragraph ,*numeric-argument-marker*) 'marking-table @@ -264,7 +264,7 @@ (set-key 'com-delete-indentation 'indent-table - '((#\^ :shift :meta))) + '((#\^ :meta))) (define-command (com-auto-fill-mode :name t :command-table fill-table) () (let ((view (current-view))) @@ -297,7 +297,7 @@ (set-key 'com-beginning-of-buffer 'movement-table - '((#\< :shift :meta))) + '((#\< :meta))) (set-key 'com-beginning-of-buffer 'movement-table @@ -331,7 +331,7 @@ (set-key 'com-end-of-buffer 'movement-table - '((#\> :shift :meta))) + '((#\> :meta))) (set-key 'com-end-of-buffer 'movement-table @@ -510,7 +510,7 @@ (set-key 'com-undo 'editing-table - '((#\_ :shift :control))) + '((#\_ :control))) (set-key 'com-undo 'editing-table @@ -522,7 +522,7 @@ (set-key 'com-redo 'editing-table - '((#\_ :shift :meta))) + '((#\_ :meta))) (set-key 'com-redo 'editing-table --- /project/mcclim/cvsroot/mcclim/Drei/misc-commands.lisp 2007/12/19 11:02:01 1.4 +++ /project/mcclim/cvsroot/mcclim/Drei/misc-commands.lisp 2008/04/28 20:48:55 1.5 @@ -68,7 +68,7 @@ (set-key `(com-eval-expression ,*unsupplied-argument-marker* ,*numeric-argument-marker*) 'editor-table - '((#\: :shift :meta))) + '((#\: :meta))) (set-key 'com-count-lines-page 'info-table --- /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2008/04/18 11:22:29 1.9 +++ /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2008/04/28 20:48:55 1.10 @@ -393,7 +393,7 @@ (set-key 'com-query-replace 'search-table - '((#\% :shift :meta))) + '((#\% :meta))) (define-command (com-query-replace-replace :name t :command-table query-replace-drei-table) () (let ((state (query-replace-state (drei-instance)))) --- /project/mcclim/cvsroot/mcclim/Drei/unicode-commands.lisp 2007/12/19 11:02:01 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/unicode-commands.lisp 2008/04/28 20:48:55 1.3 @@ -49,11 +49,11 @@ (set-dead-grave-key (code &rest sequence) `(set-charcode-key ,code ((:dead-grave) ,@sequence))) (set-dead-diaresis-key (code &rest sequence) - `(set-charcode-key ,code ((:dead-diaresis :shift) ,@sequence))) + `(set-charcode-key ,code ((:dead-diaeresis) ,@sequence))) (set-dead-tilde-key (code &rest sequence) - `(set-charcode-key ,code ((:dead-tilde :shift) ,@sequence))) + `(set-charcode-key ,code ((:dead-tilde) ,@sequence))) (set-dead-circumflex-key (code &rest sequence) - `(set-charcode-key ,code ((:dead-circumflex :shift) ,@sequence)))) + `(set-charcode-key ,code ((:dead-circumflex) ,@sequence)))) (set-dead-acute-key 193 (#\A)) (set-dead-acute-key 201 (#\E)) (set-dead-acute-key 205 (#\I))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by thenriksen 26 Apr '08

26 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv18250/Apps/Listener Modified Files: package.lisp Log Message: Use the CLIM-EXTENSIONS package in CLIM-LISTENER so that Display Image works. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/package.lisp 2006/11/24 18:37:54 1.3 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/package.lisp 2008/04/26 21:19:59 1.4 @@ -2,7 +2,7 @@ (in-package :cl-user) (defpackage "CLIM-LISTENER" - (:use "CLIM" "CLIM-LISP") + (:use "CLIM" "CLIM-LISP" "CLIM-EXTENSIONS") (:export #:run-listener #:dev-commands)) (in-package :clim-listener)

1 0

[mcclim-cvs] CVS mcclim/Doc
by afuchs 23 Apr '08

23 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Doc In directory clnet:/tmp/cvs-serv23626/Doc Modified Files: mcclim.texi Log Message: Update the version numbers to 0.9.7-dev. Tree is unfrozen now. --- /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2008/04/23 11:36:05 1.11 +++ /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2008/04/23 12:05:36 1.12 @@ -6,7 +6,7 @@ @setfilename mcclim @settitle McCLIM User's Manual -@set MCCLIMVERSION 0.9.6 +@set MCCLIMVERSION 0.9.7-dev @copying Copyright @copyright{} 2004,2005,2006,2007,2008 the McCLIM hackers.

1 0

[mcclim-cvs] CVS mcclim
by afuchs 23 Apr '08

23 Apr '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv23626 Modified Files: NEWS mcclim.asd Log Message: Update the version numbers to 0.9.7-dev. Tree is unfrozen now. --- /project/mcclim/cvsroot/mcclim/NEWS 2008/04/21 06:13:26 1.36 +++ /project/mcclim/cvsroot/mcclim/NEWS 2008/04/23 12:05:28 1.37 @@ -1,3 +1,6 @@ +* Changes in mcclim-0.9.7 relative to 0.9.6: + + * Changes in mcclim-0.9.6 relative to 0.9.5: ** Bug fix: ESA's help commands are better at finding bindings and describing them --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/04/23 11:36:05 1.79 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/04/23 12:05:30 1.80 @@ -549,7 +549,7 @@ ;;; The actual McCLIM system that people should to use in their ASDF ;;; package dependency lists. (defsystem :mcclim - :version "0.9.6" + :version "0.9.7-dev" :depends-on (:clim-looks)) (defmethod perform :after ((op load-op) (c (eql (find-system :clim))))

1 0

[mcclim-cvs] CVS mcclim-website
by afuchs 23 Apr '08

23 Apr '08

Update of /project/mcclim/cvsroot/mcclim-website In directory clnet:/tmp/cvs-serv15125 Modified Files: index.html Log Message: Update website for 0.9.6 --- /project/mcclim/cvsroot/mcclim-website/index.html 2008/02/11 19:26:32 1.5 +++ /project/mcclim/cvsroot/mcclim-website/index.html 2008/04/23 11:46:30 1.6 @@ -67,9 +67,9 @@ </ul> <h2><a name="downloads">Releases</a></h2> <p> - The most recent release of McCLIM is 0.9.5, in September 2007, + The most recent release of McCLIM is 0.9.6, in April 2008, available here: <a - href="downloads/mcclim-0.9.5.tar.gz">mcclim-0.9.5.tar.gz</a>. It + href="downloads/mcclim-0.9.6.tar.gz">mcclim-0.9.6.tar.gz</a>. It is also available via <a href="http://cliki.net/asdf-install">ASDF-INSTALL</a>. </p> @@ -77,6 +77,9 @@ <h2>Recent News</h2> <p> + 2007-04-23: McCLIM 0.9.6 "St. George's Day" released. + </p> + <p> 2007-09-02: McCLIM 0.9.5 "Eastern Orthodox Lithurgical New Year" released. </p> @@ -145,7 +148,7 @@ </div> <br> <hr> -$Date: 2008/02/11 19:26:32 $ +$Date: 2008/04/23 11:46:30 $

1 0

[mcclim-cvs] CVS mcclim-website/downloads
by afuchs 23 Apr '08

23 Apr '08

Update of /project/mcclim/cvsroot/mcclim-website/downloads In directory clnet:/tmp/cvs-serv15125/downloads Modified Files: index.html Log Message: Update website for 0.9.6 --- /project/mcclim/cvsroot/mcclim-website/downloads/index.html 2008/01/26 17:27:49 1.1.1.1 +++ /project/mcclim/cvsroot/mcclim-website/downloads/index.html 2008/04/23 11:46:30 1.2 @@ -43,7 +43,7 @@ </ul> <h2>Tarballs</h2> <h2>Releases</h2> -<p> The most recent release of McCLIM is 0.9.5, in September 2007, available here: <a href="mcclim-0.9.5.tar.gz">mcclim-0.9.5.tar.gz</a>. It is also available via <a href="http://cliki.net/asdf-install">ASDF-INSTALL</a>.</p> +<p> The most recent release of McCLIM is 0.9.6, in April 2008, available here: <a href="mcclim-0.9.6.tar.gz">mcclim-0.9.6.tar.gz</a>. It is also available via <a href="http://cliki.net/asdf-install">ASDF-INSTALL</a>.</p> <p> A compressed tar file of the <a href="http://common-lisp.net/cvs_tarballs/mcclim.tar.gz">repository</a> is made nightly. </p> @@ -52,7 +52,7 @@ </table> <br> <hr> -$Date: 2008/01/26 17:27:49 $ +$Date: 2008/04/23 11:46:30 $

1 0

[mcclim-cvs] CVS mcclim/ReleaseNotes
by afuchs 23 Apr '08

23 Apr '08

Update of /project/mcclim/cvsroot/mcclim/ReleaseNotes In directory clnet:/tmp/cvs-serv12460/ReleaseNotes Added Files: 0-9-6-st-george's-day Log Message: Prepare for the 0.9.6 release. --- /project/mcclim/cvsroot/mcclim/ReleaseNotes/0-9-6-st-george's-day 2008/04/23 11:36:06 NONE +++ /project/mcclim/cvsroot/mcclim/ReleaseNotes/0-9-6-st-george's-day 2008/04/23 11:36:06 1.1

1 0

[mcclim-cvs] CVS mcclim
by afuchs 23 Apr '08

23 Apr '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv12460 Modified Files: mcclim.asd Log Message: Prepare for the 0.9.6 release. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/04/14 16:46:37 1.78 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/04/23 11:36:05 1.79 @@ -549,7 +549,7 @@ ;;; The actual McCLIM system that people should to use in their ASDF ;;; package dependency lists. (defsystem :mcclim - :version "0.9.6-dev" + :version "0.9.6" :depends-on (:clim-looks)) (defmethod perform :after ((op load-op) (c (eql (find-system :clim))))

1 0

[mcclim-cvs] CVS mcclim/Doc
by afuchs 23 Apr '08

23 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Doc In directory clnet:/tmp/cvs-serv12460/Doc Modified Files: mcclim.texi Log Message: Prepare for the 0.9.6 release. --- /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2007/09/02 18:55:28 1.10 +++ /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2008/04/23 11:36:05 1.11 @@ -6,10 +6,10 @@ @setfilename mcclim @settitle McCLIM User's Manual -@set MCCLIMVERSION 0.9.6-dev +@set MCCLIMVERSION 0.9.6 @copying -Copyright @copyright{} 2004,2005,2006 the McCLIM hackers. +Copyright @copyright{} 2004,2005,2006,2007,2008 the McCLIM hackers. @end copying @dircategory Common Lisp

1 0

[mcclim-cvs] CVS mcclim
by ahefner 21 Apr '08

21 Apr '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv2698 Modified Files: NEWS Log Message: My changes. --- /project/mcclim/cvsroot/mcclim/NEWS 2008/04/14 16:46:37 1.35 +++ /project/mcclim/cvsroot/mcclim/NEWS 2008/04/21 06:13:26 1.36 @@ -24,6 +24,15 @@ CLIM 2.2 semantics. The :keystrokes value is not handled yet. ** Specification compliance: :PRINTER functions for MENU-CHOOSE are now called with the menu item, not the display object. +** Improvement: Faster drawing and AA text rendering. AA text requires + a fix to the Xrender support of CLX, available in Christophe Rhodes's + current CLX distribution from darcs. +** Improvement: Look up arbitrary truetype fonts by name via fontconfig. +** New extension: mcclim-truetype: provides a 100% lisp path for + AA fonts with CLX using cl-vectors and zpb-ttf, as an alternative + to mcclim-freetype. +** Bug fix: correct computation of bounding rectangle after + clear-output-record and recompute-extent-for-new-child. * Changes in mcclim-0.9.5 relative to 0.9.4: ** Installation: the systems clim-listener, clim-examples,

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 20 Apr '08

20 Apr '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv4340 Modified Files: commands.lisp Log Message: Fixed broken :insert-default t in command parameters. It wasn't being passed along in the call to ACCEPT in the acceptor. I feel a bit odd about this fix, because I vaguely recall that this used to work, at least in Climacs, but the code pretty obviously filtered :insert-default keywords away. --- /project/mcclim/cvsroot/mcclim/commands.lisp 2008/04/15 19:52:57 1.78 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2008/04/20 07:19:10 1.79 @@ -663,7 +663,7 @@ (defun accept-form-for-argument (stream arg) (let ((accept-keys '(:default :default-type :display-default - :prompt :documentation))) + :prompt :documentation :insert-default))) (destructuring-bind (name ptype &rest key-args &key (mentioned-default nil mentioned-default-p) &allow-other-keys) @@ -692,7 +692,7 @@ (defun accept-form-for-argument-partial (stream ptype-arg command-arg original-command-arg ) (let ((accept-keys '(:default :default-type :display-default - :prompt :documentation))) + :prompt :documentation :insert-default))) (destructuring-bind (name ptype &rest key-args) ptype-arg (declare (ignore name))

1 0

[mcclim-cvs] CVS playpen
by ahefner 20 Apr '08

20 Apr '08

Update of /project/mcclim/cvsroot/playpen In directory clnet:/tmp/cvs-serv12245 Log Message: Initial import. Status: Vendor Tag: initial Release Tags: start N playpen/playpen.asd N playpen/scratch.text N playpen/src/package.lisp N playpen/src/windowing.h N playpen/src/wtest_1.c N playpen/src/x11.c No conflicts created by this import

2 1

[mcclim-cvs] CVS mcclim
by thenriksen 19 Apr '08

19 Apr '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv11778 Modified Files: presentation-defs.lisp Log Message: Fixed STRING-INPUT-EDITING-STREAM to not fail on many common use cases. --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2008/04/19 07:51:22 1.76 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2008/04/19 09:26:49 1.77 @@ -1047,12 +1047,13 @@ (defmethod stream-read-gesture ((stream string-input-editing-stream) &key peek-p &allow-other-keys) - (prog1 (if (= (stream-scan-pointer stream) (length (stream-input-buffer stream))) - (second (first (gethash (first *activation-gestures*) - climi::*gesture-names*))) ; XXX - will always be non-NIL? - (aref (stream-input-buffer stream) (stream-scan-pointer stream))) - (unless peek-p - (incf (stream-scan-pointer stream))))) + (unless (> (stream-scan-pointer stream) (length (stream-input-buffer stream))) + (prog1 (if (= (stream-scan-pointer stream) (length (stream-input-buffer stream))) + (second (first (gethash (first *activation-gestures*) + climi::*gesture-names*))) ; XXX - will always be non-NIL? + (aref (stream-input-buffer stream) (stream-scan-pointer stream))) + (unless peek-p + (incf (stream-scan-pointer stream)))))) (defmethod stream-unread-gesture ((stream string-input-editing-stream) gesture) (decf (stream-scan-pointer stream)))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 19 Apr '08

19 Apr '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv24668 Modified Files: presentation-defs.lisp Log Message: Fix the utterly broken ACCEPT-FROM-STRING to at least work for common cases. Still WIP. --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2008/02/01 17:02:55 1.75 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2008/04/19 07:51:22 1.76 @@ -964,6 +964,102 @@ (declare (ignore type view other-args)) nil) +;;; For ACCEPT-FROM-STRING, use this barebones input-editing-stream. +(defclass string-input-editing-stream (input-editing-stream fundamental-character-input-stream) + ((input-buffer :accessor stream-input-buffer) + (insertion-pointer :accessor stream-insertion-pointer + :initform 0 + :documentation "This is not used for anything at any point.") + (scan-pointer :accessor stream-scan-pointer + :initform 0 + :documentation "This is not used for anything at any point.")) + (:documentation "An implementation of the input-editing stream +protocol retrieving gestures from a provided string.")) + +(defmethod initialize-instance :after ((stream string-input-editing-stream) + &key (string (error "A string must be provided")) + (start 0) (end (length string)) + &allow-other-keys) + (setf (stream-input-buffer stream) + (replace (make-array (- end start) :fill-pointer (- end start)) + string :start1 start :end2 end))) + +(defmethod stream-element-type ((stream string-input-editing-stream)) + 'character) + +(defmethod close ((stream string-input-editing-stream) &key abort) + (declare (ignore abort))) + +(defmethod stream-peek-char ((stream string-input-editing-stream)) + (let ((char (read-char-no-hang stream nil nil))) + (when char + (unread-char char stream)) + (or char :eof))) + +(defmethod stream-read-char-no-hang ((stream string-input-editing-stream)) + (if (> (stream-scan-pointer stream) (length (stream-input-buffer stream))) + :eof + (stream-read-gesture stream))) + +(defmethod stream-read-char ((stream string-input-editing-stream)) + (stream-read-gesture stream)) + +(defmethod stream-listen ((stream string-input-editing-stream)) + (< (stream-scan-pointer stream) (length (stream-input-buffer stream)))) + +(defmethod stream-unread-char ((stream string-input-editing-stream) char) + (stream-unread-gesture stream char)) + +(defmethod invoke-with-input-editor-typeout ((stream string-input-editing-stream) continuation + &key erase) + (declare (ignore erase))) + +(defmethod input-editor-format ((stream string-input-editing-stream) format-string + &rest args) + (declare (ignore args))) + +(defmethod stream-rescanning-p ((stream string-input-editing-stream)) + t) + +(defmethod reset-scan-pointer ((stream string-input-editing-stream) + &optional scan-pointer) + (declare (ignore scan-pointer))) + +(defmethod immediate-rescan ((stream string-input-editing-stream))) + +(defmethod queue-rescan ((stream string-input-editing-stream))) + +(defmethod rescan-if-necessary ((stream string-input-editing-stream) + &optional inhibit-activation) + (declare (ignore inhibit-activation))) + +(defmethod erase-input-buffer ((stream string-input-editing-stream) + &optional start-position) + (declare (ignore start-position))) + +(defmethod redraw-input-buffer ((stream string-input-editing-stream) + &optional start-position) + (declare (ignore start-position))) + +(defmethod stream-process-gesture ((stream string-input-editing-stream) gesture type) + (when (characterp gesture) + (values gesture type))) + +(defmethod stream-read-gesture ((stream string-input-editing-stream) + &key peek-p &allow-other-keys) + (prog1 (if (= (stream-scan-pointer stream) (length (stream-input-buffer stream))) + (second (first (gethash (first *activation-gestures*) + climi::*gesture-names*))) ; XXX - will always be non-NIL? + (aref (stream-input-buffer stream) (stream-scan-pointer stream))) + (unless peek-p + (incf (stream-scan-pointer stream))))) + +(defmethod stream-unread-gesture ((stream string-input-editing-stream) gesture) + (decf (stream-scan-pointer stream))) + +(defmethod stream-accept ((stream string-input-editing-stream) type &rest args) + (apply #'accept-1 stream type args)) + ;;; XXX This needs work! It needs to do everything that accept does for ;;; expanding ptypes and setting up recursive call procesusing (defun accept-from-string (type string @@ -982,7 +1078,7 @@ (start 0) (end (length string))) (declare (ignore view)) - ;;; XXX work in progress here. + ;; XXX work in progress here. (with-activation-gestures ((if additional-activations-p additional-activation-gestures activation-gestures) @@ -999,13 +1095,12 @@ type) 0)) (simple-parse-error "Empty string"))) - (let ((index 0)) + (let ((stream (make-instance 'string-input-editing-stream + :string string :start start :end end))) (multiple-value-bind (val ptype) - (with-input-from-string (stream string :start start :end end - :index index) - (with-keywords-removed (args (:start :end)) - (apply #'stream-accept stream type :view +textual-view+ args))) - (values val ptype index)))) + (with-keywords-removed (args (:start :end)) + (apply #'stream-accept stream type :history nil :view +textual-view+ args)) + (values val ptype (+ (stream-scan-pointer stream) start))))) (define-presentation-generic-function %presentation-refined-position-test presentation-refined-position-test

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by thenriksen 18 Apr '08

18 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv2123/Apps/Listener Modified Files: icons.lisp Log Message: Explicitly provide a :port nil argument to make-pattern-from-bitmap-file so that no port thread will be started by the Listener at load-time. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/icons.lisp 2008/04/14 16:46:28 1.8 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/icons.lisp 2008/04/18 11:46:40 1.9 @@ -35,7 +35,8 @@ (defmacro deficon (var pathname) `(eval-when (:load-toplevel :execute) (defparameter ,var (make-pattern-from-bitmap-file - ,(merge-pathnames pathname *icon-path*) :format :xpm)))) + ,(merge-pathnames pathname *icon-path*) + :format :xpm :port nil)))) (defvar *icon-cache* (make-hash-table :test #'equal)) @@ -46,7 +47,7 @@ (make-pattern-from-bitmap-file (merge-pathnames (parse-namestring filename) *icon-path*) - :format :xpm)))) + :format :xpm :port nil)))) ;; Don't particularly need these any more.. (deficon *folder-icon* #P"folder.xpm")

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 18 Apr '08

18 Apr '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv29836/Drei Modified Files: search-commands.lisp Log Message: Fixed silly bug in Drei search/replace. --- /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2008/01/30 11:48:40 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2008/04/18 11:22:29 1.9 @@ -424,7 +424,7 @@ (occurrences occurrences) (targets targets)) state (let ((string1-length (length string1)) - (mark (point (drei-instance targets)))) + (mark (point (view (drei-instance targets))))) (backward-object mark string1-length) (replace-one-string mark string1-length @@ -443,7 +443,7 @@ (occurrences occurrences) (targets targets)) state (let ((string1-length (length string1)) - (mark (point (drei-instance targets)))) + (mark (point (view (drei-instance targets))))) (loop do (backward-object mark string1-length) (replace-one-string mark string1-length

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs April 2008