climacs-cvs March 2006

climacs-cvs@common-lisp.net

3 participants
22 discussions

[climacs-cvs] CVS climacs
by thenriksen 26 Mar '06

26 Mar '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv14986 Modified Files: packages.lisp misc-commands.lisp lisp-syntax-commands.lisp base.lisp Log Message: Added region- and expression-indentation commands. --- /project/climacs/cvsroot/climacs/packages.lisp 2006/03/25 21:15:21 1.86 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/03/26 14:14:48 1.87 @@ -57,6 +57,7 @@ (defpackage :climacs-base (:use :clim-lisp :climacs-buffer) (:export #:do-buffer-region + #:do-buffer-region-lines #:previous-line #:next-line #:open-line #:kill-line #:empty-line-p @@ -73,6 +74,7 @@ #:upcase-word #:downcase-word #:capitalize-word #:tabify-region #:untabify-region #:indent-line + #:indent-region #:delete-indentation #:fill-line #:input-from-stream #:output-to-stream --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/03/03 19:38:57 1.4 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/03/26 14:14:48 1.5 @@ -531,6 +531,30 @@ 'indent-table '((#\j :control))) +(defun indent-region (pane mark1 mark2) + "Indent all lines in the region delimited by `mark1' and `mark2' + according to the rules of the active syntax in `pane'." + (let* ((buffer (buffer pane)) + (view (stream-default-view pane)) + (tab-space-count (tab-space-count view)) + (tab-width (and (climacs-pane:indent-tabs-mode buffer) + tab-space-count)) + (syntax (climacs-syntax:syntax buffer))) + (do-buffer-region-lines (line mark1 mark2) + (let ((indentation (climacs-syntax:syntax-line-indentation + line + tab-space-count + syntax))) + (indent-line line indentation tab-width))))) + +(define-command (com-indent-region :name t :command-table indent-table) () + "Indent every line of the current region as specified by the +syntax for the buffer." + (let* ((pane (current-window)) + (point (point pane)) + (mark (mark pane))) + (indent-region pane point mark))) + (define-command (com-delete-indentation :name t :command-table indent-table) () (delete-indentation (point (current-window)))) --- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/03/15 17:17:48 1.3 +++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/03/26 14:14:48 1.4 @@ -32,25 +32,42 @@ (define-command (com-eval-defun :name t :command-table lisp-table) () (let* ((pane (current-window)) - (point (point pane)) - (syntax (syntax (buffer pane)))) + (point (point pane)) + (syntax (syntax (buffer pane)))) (eval-defun point syntax))) (esa:set-key 'com-eval-defun - 'lisp-table - '((#\x :control :meta))) + 'lisp-table + '((#\x :control :meta))) (define-command (com-package :name t :command-table lisp-table) () (let* ((pane (current-window)) - (syntax (syntax (buffer pane))) - (package (climacs-lisp-syntax::package-of syntax))) + (syntax (syntax (buffer pane))) + (package (climacs-lisp-syntax::package-of syntax))) (esa:display-message (format nil "~A" (if (packagep package) - (package-name package) - package))))) + (package-name package) + package))))) (define-command (com-fill-paragraph :name t :command-table lisp-table) () ) (esa:set-key 'com-fill-paragraph - 'lisp-table - '((#\q :meta))) \ No newline at end of file + 'lisp-table + '((#\q :meta))) + +(define-command (com-indent-expression :name t :command-table lisp-table) + ((count 'integer :prompt "Number of expressions")) + (let* ((pane (current-window)) + (point (point pane)) + (mark (clone-mark point)) + (syntax (syntax (buffer pane))) + (view (stream-default-view pane)) + (tab-space-count (tab-space-count view))) + (if (plusp count) + (loop repeat count do (forward-expression mark syntax)) + (loop repeat (- count) do (backward-expression mark syntax))) + (indent-region pane (clone-mark point) mark))) + +(esa:set-key `(com-indent-expression ,*numeric-argument-marker*) + 'lisp-table + '((#\q :meta :control))) \ No newline at end of file --- /project/climacs/cvsroot/climacs/base.lisp 2005/08/27 22:07:45 1.45 +++ /project/climacs/cvsroot/climacs/base.lisp 2006/03/26 14:14:48 1.46 @@ -41,6 +41,27 @@ (loop for ,offset from ,offset1 below ,offset2 do ,@body))) +(defmacro do-buffer-region-lines ((line-var mark1 mark2) &body body) + "Iterate over the lines in the region delimited by `mark1' and `mark2'. + For each line, `line-var' will be bound to a mark positioned + at the beginning of the line and `body' will be executed. Note + that the iteration will always start from the mark specifying + the earliest position in the buffer." + (let ((mark-sym (gensym)) + (mark2-sym (gensym))) + `(progn + (when (mark< ,mark2 ,mark1) + (rotatef ,mark1 ,mark2)) + (let ((,mark-sym (clone-mark ,mark1)) + (,mark2-sym (clone-mark ,mark2))) + (loop while (mark<= ,mark-sym ,mark2-sym) + do + (let ((,line-var (clone-mark ,mark-sym))) + ,@body) + (end-of-line ,mark-sym) + (unless (end-of-buffer-p ,mark-sym) + (forward-object ,mark-sym))))))) + (defmethod previous-line (mark &optional column (count 1)) "Move a mark up COUNT lines conserving horizontal position." (unless column

1 0

[climacs-cvs] CVS climacs
by crhodes 25 Mar '06

25 Mar '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv2232 Modified Files: INSTALL gui.lisp Removed Files: esa.lisp Log Message: Modify gui.lisp to use frame arguments where applicable, as redisplay methods need not be run in the application thread. Document the need for external flexichain and esa checkouts, and remove esa.lisp. --- /project/climacs/cvsroot/climacs/INSTALL 2005/09/25 20:06:25 1.7 +++ /project/climacs/cvsroot/climacs/INSTALL 2006/03/25 22:29:12 1.8 @@ -7,21 +7,15 @@ Install instructions for Climacs. We assume that if you have gotten this far, it means that you have either extracted a tar file with everything in it, or checked out the files from some CVS repository. -If your directory contains a Flexichain subdirectory, skip directly to -paragraph 1 below. Otherwise start at paragraph 0. -0. You need to check out the Flexichain module from the Gsharp project - on common-lisp.net. If you are a member of that project, you can - do this: +0. You need to check out the flexichain and esa projects from + common-lisp.net. If you are not a member of those projects, here is + how you do it: - export CVS_RSH=ssh - cvs -z3 -d :ext:<username>@common-lisp.net:/project/gsharp/cvsroot co Flexichain + cvs -z3 -d :pserver:anonymous:anonymous@common-lisp.net:/project/flexichain/cvsroot co flexichain + cvs -z3 -d :pserver:anonymous:anonymous@common-lisp.net:/project/climacs/cvsroot co esa - If you are not a member, here is how you do it: - - cvs -d :pserver:anonymous@common-lisp.net:/project/gsharp/cvsroot login - <enter anonymous as password> - cvs -z3 -d :pserver:anonymous@common-lisp.net:/project/gsharp/cvsroot co Flexichain + Ensure that asdf can find the .asd files for these projects. 1. Start Lisp either from the shell or from Emacs @@ -46,5 +40,3 @@ For that reason, Climacs often depends on very fresh CVS versions of McCLIM. If you discover a bug, please try to install a new version of McCLIM before looking too hard for any other reasons. - - --- /project/climacs/cvsroot/climacs/gui.lisp 2006/03/03 19:38:57 1.204 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/03/25 22:29:12 1.205 @@ -225,7 +225,6 @@ (climacs :new-process new-process :process-name process-name :width width :height height)))) (defun display-info (frame pane) - (declare (ignore frame)) (let* ((master-pane (master-pane pane)) (buffer (buffer master-pane)) (size (size buffer)) @@ -265,15 +264,14 @@ "Isearch")) (princ #\) pane)) (with-text-family (pane :sans-serif) - (princ (if (recordingp *application-frame*) + (princ (if (recordingp frame) "Def" "") pane)))) (defun display-window (frame pane) "The display function used by the climacs application frame." - (declare (ignore frame)) - (redisplay-pane pane (eq pane (current-window)))) + (redisplay-pane pane (eq pane (car (windows frame))))) (defmethod handle-repaint :before ((pane extended-pane) region) (declare (ignore region)) @@ -282,25 +280,26 @@ (defvar *kill-ring* (make-instance 'kill-ring :max-size 7)) (defmethod execute-frame-command :around ((frame climacs) command) - (handler-case - (if (buffer-pane-p (current-window)) - (with-undo ((buffer (current-window))) - (call-next-method)) - (call-next-method)) - (offset-before-beginning () - (beep) (display-message "Beginning of buffer")) - (offset-after-end () - (beep) (display-message "End of buffer")) - (motion-before-beginning () - (beep) (display-message "Beginning of buffer")) - (motion-after-end () - (beep) (display-message "End of buffer")) - (no-expression () - (beep) (display-message "No expression around point")) - (no-such-operation () - (beep) (display-message "Operation unavailable for syntax")) - (buffer-read-only () - (beep) (display-message "Buffer is read only")))) + (let ((current-window (car (windows frame)))) + (handler-case + (if (buffer-pane-p current-window) + (with-undo ((buffer current-window)) + (call-next-method)) + (call-next-method)) + (offset-before-beginning () + (beep) (display-message "Beginning of buffer")) + (offset-after-end () + (beep) (display-message "End of buffer")) + (motion-before-beginning () + (beep) (display-message "Beginning of buffer")) + (motion-after-end () + (beep) (display-message "End of buffer")) + (no-expression () + (beep) (display-message "No expression around point")) + (no-such-operation () + (beep) (display-message "Operation unavailable for syntax")) + (buffer-read-only () + (beep) (display-message "Buffer is read only"))))) (defmethod execute-frame-command :after ((frame climacs) command) (loop for buffer in (buffers frame)

1 0

[climacs-cvs] CVS esa
by crhodes 25 Mar '06

25 Mar '06

Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv1896 Modified Files: esa.lisp Log Message: Rearrange the esa loop a tiny bit: run redisplay-frame-panes from execute-frame-command if (eq frame *application-frame*), and from the abort-gesture handler too. Make sure that the ESA methods on redisplay-frame-panes and execute-frame-command use the frame argument rather than *application-frame*. --- /project/climacs/cvsroot/esa/esa.lisp 2006/03/25 00:08:07 1.1.1.1 +++ /project/climacs/cvsroot/esa/esa.lisp 2006/03/25 22:24:15 1.2 @@ -266,15 +266,20 @@ (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p) (declare (ignore force-p)) - (when (null (remaining-keys *application-frame*)) - (setf (executingp *application-frame*) nil) + (when (null (remaining-keys frame)) + (setf (executingp frame) nil) (call-next-method))) (defmethod execute-frame-command :after ((frame esa-frame-mixin) command) - (setf (previous-command *standard-output*) + ;; FIXME: I'm not sure that we want to do this for commands sent + ;; from other threads; we almost certainly don't want to do it twice + ;; in such cases... + (setf (previous-command (car (windows frame))) (if (consp command) (car command) - command))) + command)) + (when (eq frame *application-frame*) + (redisplay-frame-panes frame))) (defgeneric find-applicable-command-table (frame)) @@ -299,16 +304,16 @@ (redisplay-frame-panes frame :force-p t) (loop do (restart-case - (progn - (handler-case - (let ((command-table (find-applicable-command-table frame))) - ;; for presentation-to-command-translators, - ;; which are searched for in - ;; (frame-command-table *application-frame*) - (setf (frame-command-table frame) command-table) - (process-gestures-or-command frame command-table)) - (abort-gesture () (display-message "Quit"))) - (redisplay-frame-panes frame)) + (handler-case + (let ((command-table (find-applicable-command-table frame))) + ;; for presentation-to-command-translators, + ;; which are searched for in + ;; (frame-command-table *application-frame*) + (setf (frame-command-table frame) command-table) + (process-gestures-or-command frame command-table)) + (abort-gesture () + (display-message "Quit") + (redisplay-frame-panes frame))) (return-to-esa () nil) (reset-esa () ;; This restart is used to jump out of deadlocks where

1 0

[climacs-cvs] CVS climacs
by thenriksen 25 Mar '06

25 Mar '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv26736 Modified Files: packages.lisp climacs.asd Log Message: Changed package and system definitions to use external :esa system. --- /project/climacs/cvsroot/climacs/packages.lisp 2006/03/03 19:38:57 1.85 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/03/25 21:15:21 1.86 @@ -161,32 +161,6 @@ #:url #:climacs-textual-view #:+climacs-textual-view+)) -#-mcclim -(defpackage :clim-extensions - (:use :clim-lisp :clim) - (:export - #:+blue-violet+ - #:+dark-blue+ - #:+dark-green+ - #:+dark-violet+ - #:+gray50+ - #:+gray85+ - #:+maroon+ - #:+purple+)) - -(defpackage :esa - (:use :clim-lisp :clim :clim-extensions) - (:export #:minibuffer-pane #:display-message - #:esa-pane-mixin #:previous-command - #:info-pane #:master-pane - #:esa-frame-mixin #:windows #:recordingp #:executingp - #:*numeric-argument-p* #:*current-gesture* - #:esa-top-level #:simple-command-loop - #:global-esa-table #:keyboard-macro-table - #:help-table - #:set-key - #:find-applicable-command-table)) - (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax --- /project/climacs/cvsroot/climacs/climacs.asd 2006/03/03 19:38:57 1.42 +++ /project/climacs/cvsroot/climacs/climacs.asd 2006/03/25 21:15:21 1.43 @@ -28,7 +28,7 @@ (defparameter *climacs-directory* (directory-namestring *load-truename*)) (defsystem :climacs - :depends-on (:mcclim :flexichain) + :depends-on (:mcclim :flexichain :esa) :components ((:module "cl-automaton" :components ((:file "automaton-package") @@ -70,14 +70,12 @@ (:file "prolog2paiprolog" :depends-on ("prolog-syntax")) (:file "ttcn3-syntax" :depends-on ("packages" "buffer" "syntax" "base" "pane")) - (:file "colors" :depends-on ("packages")) (:file "lisp-syntax" :depends-on ("packages" "syntax" "buffer" "base" "pane" - "gui" "colors")) + "gui")) (:file "lisp-syntax-commands" :depends-on ("lisp-syntax")) - (:file "esa" :depends-on ("packages" "colors")) (:file "gui" :depends-on ("packages" "syntax" "base" "buffer" "undo" "pane" - "esa" "kill-ring" "io" "text-syntax" - "abbrev" "colors")) + "kill-ring" "io" "text-syntax" + "abbrev" )) ;; (:file "buffer-commands" :depends-on ("gui")) (:file "developer-commands" :depends-on ("gui" "lisp-syntax")) (:file "file-commands" :depends-on ("gui")) @@ -85,7 +83,7 @@ (:file "search-commands" :depends-on ("gui")) (:file "window-commands" :depends-on ("gui")) (:file "unicode-commands" :depends-on ("gui")) - (:file "slidemacs" :depends-on ("packages" "buffer" "syntax" "base" "pane" "colors")) + (:file "slidemacs" :depends-on ("packages" "buffer" "syntax" "base" "pane" )) (:file "slidemacs-gui" :depends-on ("packages" "slidemacs" "pane" "buffer" "syntax" "gui")))) (defsystem :climacs.tests

1 0

[climacs-cvs] CVS climacs
by crhodes 25 Mar '06

25 Mar '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv24084 Modified Files: file-commands.lisp Log Message: Make the buffer of a syntax be the buffer created by MAKE-BUFFER rather than the buffer of (point pane). (In practice, this means the climacs-buffer (delegating) rather than the implementation buffer). (This is largely to facilitate the ability to print tablature along with the buffer name; there are probably other reasons to allow this.) --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/03/03 19:38:57 1.3 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/03/25 20:58:41 1.4 @@ -155,7 +155,7 @@ (setf (buffer (current-window)) buffer) (setf (syntax buffer) (make-instance (syntax-class-name-for-filepath filepath) - :buffer (buffer (point pane)))) + :buffer buffer)) ;; Don't want to create the file if it doesn't exist. (when (probe-file filepath) (with-open-file (stream filepath :direction :input)

1 0

[climacs-cvs] CVS esa
by thenriksen 25 Mar '06

25 Mar '06

Update of /project/climacs/cvsroot/esa In directory clnet:/home/thenriksen/esa Log Message: Initial import. Status: Vendor Tag: esa Release Tags: start N esa/colors.lisp N esa/esa-buffer.lisp N esa/esa-io.lisp N esa/esa.asd N esa/esa.lisp N esa/packages.lisp No conflicts created by this import

1 0

[climacs-cvs] CVS climacs
by thenriksen 15 Mar '06

15 Mar '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv366 Modified Files: lisp-syntax-commands.lisp Log Message: `com-package' assumed `package-of' would always return a valid package object. Fixed. --- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/03/15 12:14:22 1.2 +++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/03/15 17:17:48 1.3 @@ -44,7 +44,9 @@ (let* ((pane (current-window)) (syntax (syntax (buffer pane))) (package (climacs-lisp-syntax::package-of syntax))) - (esa:display-message (format nil "~A" (package-name package))))) + (esa:display-message (format nil "~A" (if (packagep package) + (package-name package) + package))))) (define-command (com-fill-paragraph :name t :command-table lisp-table) () )

1 0

[climacs-cvs] CVS climacs
by thenriksen 15 Mar '06

15 Mar '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv23859 Modified Files: lisp-syntax-commands.lisp Log Message: Fix `com-package'. --- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/02/07 15:27:50 1.1 +++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/03/15 12:14:22 1.2 @@ -44,7 +44,7 @@ (let* ((pane (current-window)) (syntax (syntax (buffer pane))) (package (climacs-lisp-syntax::package-of syntax))) - (display-message (format nil "~s" package)))) + (esa:display-message (format nil "~A" (package-name package))))) (define-command (com-fill-paragraph :name t :command-table lisp-table) () )

1 0

[climacs-cvs] CVS climacs
by crhodes 14 Mar '06

14 Mar '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv25029 Modified Files: unicode-commands.lisp Log Message: Make unicode-commands (really "latin1-commands") more useful. :dead--acute and friends were apparently from an older, typoed version of mcclim; those keysyms had long since been replaced by :dead-acute. Rewrite the implementation of the dead-diacritic commands anyway, so that the next change is easier to make. Now some of these dead commands work for me and others don't; this is the usual shifted/unshifted problem -- I get dead-circumflex by typing AltGr+', which is unshifted, whereas the implementation presumably works on those keyboards where you get dead-circumflex by hitting ^ (which is Shift+6?). Bleeding-edge SBCL/CLX users can also type latin1 characters directly (depending on what they've got in their keymap); for instance, for me, AltGr+1 gives me a superscript 1; Shift+3 gives me a pound sign. --- /project/climacs/cvsroot/climacs/unicode-commands.lisp 2005/11/12 09:38:32 1.1 +++ /project/climacs/cvsroot/climacs/unicode-commands.lisp 2006/03/14 14:45:43 1.2 @@ -28,79 +28,101 @@ (in-package :climacs-gui) -(define-command (com-insert-charcode :name t :command-table self-insert-table) - ((code 'integer :prompt "Code point")) - (insert-object (point (current-window)) (code-char code))) +(do ((i 160 (+ i 1))) + ((> i 255)) + (set-key `(com-self-insert ,*numeric-argument-marker*) + 'self-insert-table (list (code-char i)))) -(set-key '(com-insert-charcode 193) 'self-insert-table '((:dead--acute)(#\A))) -(set-key '(com-insert-charcode 201) 'self-insert-table '((:dead--acute)(#\E))) -(set-key '(com-insert-charcode 205) 'self-insert-table '((:dead--acute)(#\I))) -(set-key '(com-insert-charcode 211) 'self-insert-table '((:dead--acute)(#\O))) -(set-key '(com-insert-charcode 218) 'self-insert-table '((:dead--acute)(#\U))) -(set-key '(com-insert-charcode 221) 'self-insert-table '((:dead--acute)(#\Y))) -(set-key '(com-insert-charcode 225) 'self-insert-table '((:dead--acute)(#\a))) -(set-key '(com-insert-charcode 233) 'self-insert-table '((:dead--acute)(#\e))) -(set-key '(com-insert-charcode 237) 'self-insert-table '((:dead--acute)(#\i))) -(set-key '(com-insert-charcode 243) 'self-insert-table '((:dead--acute)(#\o))) -(set-key '(com-insert-charcode 250) 'self-insert-table '((:dead--acute)(#\u))) -(set-key '(com-insert-charcode 253) 'self-insert-table '((:dead--acute)(#\y))) -(set-key '(com-insert-charcode 199) 'self-insert-table '((:dead--acute)(#\C))) -(set-key '(com-insert-charcode 231) 'self-insert-table '((:dead--acute)(#\c))) -(set-key '(com-insert-charcode 215) 'self-insert-table '((:dead--acute)(#\x))) -(set-key '(com-insert-charcode 247) 'self-insert-table '((:dead--acute)(#\-))) -(set-key '(com-insert-charcode 222) 'self-insert-table '((:dead--acute)(#\T))) -(set-key '(com-insert-charcode 254) 'self-insert-table '((:dead--acute)(#\t))) -(set-key '(com-insert-charcode 223) 'self-insert-table '((:dead--acute)(#\s))) -(set-key '(com-insert-charcode 39) 'self-insert-table '((:dead--acute)(#\Space))) - -(set-key '(com-insert-charcode 197) 'self-insert-table '((:dead--acute)(:dead--acute)(#\A))) -(set-key '(com-insert-charcode 229) 'self-insert-table '((:dead--acute)(:dead--acute)(#\a))) - -(set-key '(com-insert-charcode 192) 'self-insert-table '((:dead--grave)(#\A))) -(set-key '(com-insert-charcode 200) 'self-insert-table '((:dead--grave)(#\E))) -(set-key '(com-insert-charcode 204) 'self-insert-table '((:dead--grave)(#\I))) -(set-key '(com-insert-charcode 210) 'self-insert-table '((:dead--grave)(#\O))) -(set-key '(com-insert-charcode 217) 'self-insert-table '((:dead--grave)(#\U))) -(set-key '(com-insert-charcode 224) 'self-insert-table '((:dead--grave)(#\a))) -(set-key '(com-insert-charcode 232) 'self-insert-table '((:dead--grave)(#\e))) -(set-key '(com-insert-charcode 236) 'self-insert-table '((:dead--grave)(#\i))) -(set-key '(com-insert-charcode 242) 'self-insert-table '((:dead--grave)(#\o))) -(set-key '(com-insert-charcode 249) 'self-insert-table '((:dead--grave)(#\u))) -(set-key '(com-insert-charcode 96) 'self-insert-table '((:dead--grave)(#\Space))) - -(set-key '(com-insert-charcode 196) 'self-insert-table '((:dead--diaeresis :shift)(#\A))) -(set-key '(com-insert-charcode 203) 'self-insert-table '((:dead--diaeresis :shift)(#\E))) -(set-key '(com-insert-charcode 207) 'self-insert-table '((:dead--diaeresis :shift)(#\I))) -(set-key '(com-insert-charcode 214) 'self-insert-table '((:dead--diaeresis :shift)(#\O))) -(set-key '(com-insert-charcode 220) 'self-insert-table '((:dead--diaeresis :shift)(#\U))) -(set-key '(com-insert-charcode 228) 'self-insert-table '((:dead--diaeresis :shift)(#\a))) -(set-key '(com-insert-charcode 235) 'self-insert-table '((:dead--diaeresis :shift)(#\e))) -(set-key '(com-insert-charcode 239) 'self-insert-table '((:dead--diaeresis :shift)(#\i))) -(set-key '(com-insert-charcode 246) 'self-insert-table '((:dead--diaeresis :shift)(#\o))) -(set-key '(com-insert-charcode 252) 'self-insert-table '((:dead--diaeresis :shift)(#\u))) -(set-key '(com-insert-charcode 255) 'self-insert-table '((:dead--diaeresis :shift)(#\y))) -(set-key '(com-insert-charcode 34) 'self-insert-table '((:dead--diaeresis :shift)(#\Space))) - -(set-key '(com-insert-charcode 195) 'self-insert-table '((:dead--tilde :shift)(#\A))) -(set-key '(com-insert-charcode 209) 'self-insert-table '((:dead--tilde :shift)(#\N))) -(set-key '(com-insert-charcode 227) 'self-insert-table '((:dead--tilde :shift)(#\a))) -(set-key '(com-insert-charcode 241) 'self-insert-table '((:dead--tilde :shift)(#\n))) -(set-key '(com-insert-charcode 198) 'self-insert-table '((:dead--tilde :shift)(#\E))) -(set-key '(com-insert-charcode 230) 'self-insert-table '((:dead--tilde :shift)(#\e))) -(set-key '(com-insert-charcode 208) 'self-insert-table '((:dead--tilde :shift)(#\D))) -(set-key '(com-insert-charcode 240) 'self-insert-table '((:dead--tilde :shift)(#\d))) -(set-key '(com-insert-charcode 216) 'self-insert-table '((:dead--tilde :shift)(#\O))) -(set-key '(com-insert-charcode 248) 'self-insert-table '((:dead--tilde :shift)(#\o))) -(set-key '(com-insert-charcode 126) 'self-insert-table '((:dead--tilde :shift)(#\Space))) - -(set-key '(com-insert-charcode 194) 'self-insert-table '((:dead--circumflex :shift)(#\A))) -(set-key '(com-insert-charcode 202) 'self-insert-table '((:dead--circumflex :shift)(#\E))) -(set-key '(com-insert-charcode 206) 'self-insert-table '((:dead--circumflex :shift)(#\I))) -(set-key '(com-insert-charcode 212) 'self-insert-table '((:dead--circumflex :shift)(#\O))) -(set-key '(com-insert-charcode 219) 'self-insert-table '((:dead--circumflex :shift)(#\U))) -(set-key '(com-insert-charcode 226) 'self-insert-table '((:dead--circumflex :shift)(#\a))) -(set-key '(com-insert-charcode 234) 'self-insert-table '((:dead--circumflex :shift)(#\e))) -(set-key '(com-insert-charcode 238) 'self-insert-table '((:dead--circumflex :shift)(#\i))) -(set-key '(com-insert-charcode 244) 'self-insert-table '((:dead--circumflex :shift)(#\o))) -(set-key '(com-insert-charcode 251) 'self-insert-table '((:dead--circumflex :shift)(#\u))) -(set-key '(com-insert-charcode 94) 'self-insert-table '((:dead--circumflex :shift)(#\Space))) +(define-command (com-insert-charcode :name t :command-table self-insert-table) + ((code 'integer :prompt "Code point") (count 'integer)) + (let ((char (code-char code))) + (loop repeat count do (insert-character char)))) + +(macrolet + ((set-charcode-key (code sequence) + `(set-key + `(com-insert-charcode ,',code ,*numeric-argument-marker*) + 'self-insert-table + ',sequence)) + (set-dead-acute-key (code &rest sequence) + `(set-charcode-key ,code ((:dead-acute) ,@sequence))) + (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-dead-tilde-key (code &rest sequence) + `(set-charcode-key ,code ((:dead-tilde :shift) ,@sequence))) + (set-dead-circumflex-key (code &rest sequence) + `(set-charcode-key ,code ((:dead-circumflex :shift) ,@sequence)))) + (set-dead-acute-key 193 (#\A)) + (set-dead-acute-key 201 (#\E)) + (set-dead-acute-key 205 (#\I)) + (set-dead-acute-key 211 (#\O)) + (set-dead-acute-key 218 (#\U)) + (set-dead-acute-key 221 (#\Y)) + (set-dead-acute-key 225 (#\a)) + (set-dead-acute-key 233 (#\e)) + (set-dead-acute-key 237 (#\i)) + (set-dead-acute-key 243 (#\o)) + (set-dead-acute-key 250 (#\u)) + (set-dead-acute-key 253 (#\y)) + (set-dead-acute-key 199 (#\C)) + (set-dead-acute-key 231 (#\c)) + (set-dead-acute-key 215 (#\x)) + (set-dead-acute-key 247 (#\-)) + (set-dead-acute-key 222 (#\T)) + (set-dead-acute-key 254 (#\t)) + (set-dead-acute-key 223 (#\s)) + (set-dead-acute-key 39 (#\Space)) + + (set-dead-acute-key 197 (:dead-acute) (#\A)) + (set-dead-acute-key 229 (:dead-acute) (#\a)) + + (set-dead-grave-key 192 (#\A)) + (set-dead-grave-key 200 (#\E)) + (set-dead-grave-key 204 (#\I)) + (set-dead-grave-key 210 (#\O)) + (set-dead-grave-key 217 (#\U)) + (set-dead-grave-key 224 (#\a)) + (set-dead-grave-key 232 (#\e)) + (set-dead-grave-key 236 (#\i)) + (set-dead-grave-key 242 (#\o)) + (set-dead-grave-key 249 (#\u)) + (set-dead-grave-key 96 (#\Space)) + + (set-dead-diaresis-key 196 (#\A)) + (set-dead-diaresis-key 203 (#\E)) + (set-dead-diaresis-key 207 (#\I)) + (set-dead-diaresis-key 214 (#\O)) + (set-dead-diaresis-key 220 (#\U)) + (set-dead-diaresis-key 228 (#\a)) + (set-dead-diaresis-key 235 (#\e)) + (set-dead-diaresis-key 239 (#\i)) + (set-dead-diaresis-key 246 (#\o)) + (set-dead-diaresis-key 252 (#\u)) + (set-dead-diaresis-key 255 (#\y)) + (set-dead-diaresis-key 34 (#\Space)) + + (set-dead-tilde-key 195 (#\A)) + (set-dead-tilde-key 209 (#\N)) + (set-dead-tilde-key 227 (#\a)) + (set-dead-tilde-key 241 (#\n)) + + (set-dead-tilde-key 198 (#\E)) + (set-dead-tilde-key 230 (#\e)) + (set-dead-tilde-key 208 (#\D)) + (set-dead-tilde-key 240 (#\d)) + (set-dead-tilde-key 248 (#\o)) + (set-dead-tilde-key 126 (#\Space)) + + (set-dead-circumflex-key 194 (#\A)) + (set-dead-circumflex-key 202 (#\E)) + (set-dead-circumflex-key 206 (#\I)) + (set-dead-circumflex-key 212 (#\O)) + (set-dead-circumflex-key 219 (#\U)) + (set-dead-circumflex-key 226 (#\a)) + (set-dead-circumflex-key 234 (#\e)) + (set-dead-circumflex-key 238 (#\i)) + (set-dead-circumflex-key 244 (#\o)) + (set-dead-circumflex-key 251 (#\u)) + (set-dead-circumflex-key 94 (#\Space)))

1 0

[climacs-cvs] CVS climacs/cl-automaton
by tmoore 03 Mar '06

03 Mar '06

Update of /project/climacs/cvsroot/climacs/cl-automaton In directory clnet:/tmp/cvs-serv1782/cl-automaton Modified Files: state-and-transition.lisp Log Message: A straggler from the ACL/CLIM check in --- /project/climacs/cvsroot/climacs/cl-automaton/state-and-transition.lisp 2005/09/25 20:06:26 1.2 +++ /project/climacs/cvsroot/climacs/cl-automaton/state-and-transition.lisp 2006/03/03 21:01:44 1.3 @@ -9,7 +9,9 @@ (defconstant +min-char-code+ 0) (defconstant +max-char-code+ (1- char-code-limit)) -(deftype char-code-type () `(integer ,+min-char-code+ ,+max-char-code+)) +;;; In Allegro (for one), defconstants aren't available as values at compile +;;; time. +(deftype char-code-type () `(integer 0 ,(1- char-code-limit))) (defclass state () ((accept :initform nil :accessor accept :type boolean)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs March 2006