August 2005 - climacs-cvs@common-lisp.net

[climacs-cvs] CVS update: climacs/slidemacs-gui.lisp climacs/gui.lisp climacs/esa.lisp
by dmurray＠common-lisp.net 30 Aug '05

30 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29630 Modified Files: slidemacs-gui.lisp gui.lisp esa.lisp Log Message: Changed ESA's set-key to automatically create dead-escape equivalents to :meta commands. Changed all global-set-keys to use set-key instead. Now key-chords are assigned next to the command definitions. All commands currently in global-climacs-table. The next task is to redistribute them among relevant groupings of tables. Date: Tue Aug 30 19:28:53 2005 Author: dmurray Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.16 climacs/slidemacs-gui.lisp:1.17 --- climacs/slidemacs-gui.lisp:1.16 Wed Jun 22 20:36:13 2005 +++ climacs/slidemacs-gui.lisp Tue Aug 30 19:28:52 2005 @@ -543,13 +543,27 @@ (setf (syntax buffer) (make-instance 'slidemacs-gui-syntax :buffer buffer)))))) -(climacs-gui::global-set-key '(#\= :control) 'com-next-talking-point) -(climacs-gui::global-set-key '(#\- :control) 'com-previous-talking-point) -(climacs-gui::global-set-key '(#\= :meta) 'com-increase-presentation-font-sizes) -(climacs-gui::global-set-key '(#\- :meta) 'com-decrease-presentation-font-sizes) -(climacs-gui::global-set-key '(#\= :control :meta) 'com-last-talking-point) -(climacs-gui::global-set-key '(#\- :control :meta) 'com-first-talking-point) -(climacs-gui::global-set-key '(#\s :control :meta) 'com-flip-slidemacs-syntax) +(esa:set-key 'com-next-talking-point + 'climacs-gui::global-climacs-table + '((#\= :control))) +(esa:set-key 'com-previous-talking-point + 'climacs-gui::global-climacs-table + '((#\- :control))) +(esa:set-key 'com-increase-presentation-font-sizes + 'climacs-gui::global-climacs-table + '((#\= :meta))) +(esa:set-key 'com-decrease-presentation-font-sizes + 'climacs-gui::global-climacs-table + '((#\- :meta))) +(esa:set-key 'com-last-talking-point + 'climacs-gui::global-climacs-table + '((#\= :control :meta))) +(esa:set-key 'com-first-talking-point + 'climacs-gui::global-climacs-table + '((#\- :control :meta))) +(esa:set-key 'com-flip-slidemacs-syntax + 'climacs-gui::global-climacs-table + '((#\s :control :meta))) (climacs-gui::define-named-command com-postscript-print-presentation () (let ((pane (climacs-gui::current-window))) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.183 climacs/gui.lisp:1.184 --- climacs/gui.lisp:1.183 Thu Aug 25 10:43:55 2005 +++ climacs/gui.lisp Tue Aug 30 19:28:52 2005 @@ -197,12 +197,21 @@ (with-slots (overwrite-mode) (current-window) (setf overwrite-mode (not overwrite-mode)))) +(set-key 'com-toggle-overwrite-mode 'global-climacs-table + '((:insert))) + (define-named-command com-not-modified () (setf (needs-saving (buffer (current-window))) nil)) +(set-key 'com-not-modified 'global-climacs-table + '((#\~ :meta :shift))) + (define-named-command com-set-fill-column ((column 'integer :prompt "Column Number:")) (set-fill-column column)) +(set-key `(com-set-fill-column ,*numeric-argument-marker*) 'global-climacs-table + '((#\x :control) (#\f))) + (defun set-fill-column (column) (if (> column 1) (setf (auto-fill-column (current-window)) column) @@ -244,9 +253,21 @@ (define-named-command com-beginning-of-line () (beginning-of-line (point (current-window)))) +(set-key 'com-beginning-of-line 'global-climacs-table + '((:home))) + +(set-key 'com-beginning-of-line 'global-climacs-table + '((#\a :control))) + (define-named-command com-end-of-line () (end-of-line (point (current-window)))) +(set-key 'com-end-of-line 'global-climacs-table + '((#\e :control))) + +(set-key 'com-end-of-line 'global-climacs-table + '((:end))) + (define-named-command com-delete-object ((count 'integer :prompt "Number of Objects") (killp 'boolean :prompt "Kill?")) (let* ((point (point (current-window))) @@ -257,6 +278,16 @@ (region-to-sequence point mark))) (delete-region point mark))) +(set-key `(com-delete-object ,*numeric-argument-marker* + ,*numeric-argument-p*) + 'global-climacs-table + '(#\Rubout)) + +(set-key `(com-delete-object ,*numeric-argument-marker* + ,*numeric-argument-p*) + 'global-climacs-table + '((#\d :control))) + (define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects") (killp 'boolean :prompt "Kill?")) (let* ((point (point (current-window))) @@ -267,6 +298,11 @@ (region-to-sequence mark point))) (delete-region mark point))) +(set-key `(com-backward-delete-object ,*numeric-argument-marker* + ,*numeric-argument-p*) + 'global-climacs-table + '(#\Backspace)) + (define-named-command com-zap-to-object () (let* ((item (handler-case (accept 't :prompt "Zap to Object") (error () (progn (beep) @@ -293,27 +329,46 @@ (search-forward item-mark item) (delete-range current-point (- (offset item-mark) current-offset)))) -(define-named-command com-transpose-objects () - (transpose-objects (point (current-window)))) +(set-key 'com-zap-to-character 'global-climacs-table + '((#\z :meta))) (defun transpose-objects (mark) (unless (beginning-of-buffer-p mark) - (when (end-of-line-p mark) - (backward-object mark)) - (let ((object (object-after mark))) - (delete-range mark) - (backward-object mark) - (insert-object mark object) - (forward-object mark)))) + (when (end-of-line-p mark) + (backward-object mark)) + (let ((object (object-after mark))) + (delete-range mark) + (backward-object mark) + (insert-object mark object) + (forward-object mark)))) + +(define-named-command com-transpose-objects () + (transpose-objects (point (current-window)))) + +(set-key 'com-transponse-objects 'global-climacs-table + '((#\t :control))) (define-named-command com-backward-object ((count 'integer :prompt "Number of Objects")) (backward-object (point (current-window)) count)) +(set-key `(com-backward-object ,*numeric-argument-marker*) + 'global-climacs-table + '((#\b :control))) + +(set-key `(com-backward-object ,*numeric-argument-marker*) + 'global-climacs-table + '((:left))) + (define-named-command com-forward-object ((count 'integer :prompt "Number of Objects")) (forward-object (point (current-window)) count)) -(define-named-command com-transpose-words () - (transpose-words (point (current-window)))) +(set-key `(com-forward-object ,*numeric-argument-marker*) + 'global-climacs-table + '((#\f :control))) + +(set-key `(com-forward-object ,*numeric-argument-marker*) + 'global-climacs-table + '((:right))) (defun transpose-words (mark) (let (bw1 bw2 ew1 ew2) @@ -338,8 +393,11 @@ (insert-sequence mark w2) (forward-word mark)))) -(define-named-command com-transpose-lines () - (transpose-lines (point (current-window)))) +(define-named-command com-transpose-words () + (transpose-words (point (current-window)))) + +(set-key 'com-transpose-words 'global-climacs-table + '((#\t :meta))) (defun transpose-lines (mark) (beginning-of-line mark) @@ -363,6 +421,12 @@ (insert-sequence mark line) (insert-object mark #\Newline))) +(define-named-command com-transpose-lines () + (transpose-lines (point (current-window)))) + +(set-key 'com-transpose-lines 'global-climacs-table + '((#\x :control) (#\t :control))) + (define-named-command com-previous-line ((numarg 'integer :prompt "How many lines?")) (let* ((win (current-window)) (point (point win))) @@ -373,6 +437,14 @@ (previous-line point (slot-value win 'goal-column) numarg) (next-line point (slot-value win 'goal-column) (- numarg))))) +(set-key `(com-previous-line ,*numeric-argument-marker*) + 'global-climacs-table + '((#\p :control))) + +(set-key `(com-previous-line ,*numeric-argument-marker*) + 'global-climacs-table + '((:up))) + (define-named-command com-next-line ((numarg 'integer :prompt "How many lines?")) (let* ((win (current-window)) (point (point win))) @@ -383,9 +455,21 @@ (next-line point (slot-value win 'goal-column) numarg) (previous-line point (slot-value win 'goal-column) (- numarg))))) +(set-key `(com-next-line ,*numeric-argument-marker*) + 'global-climacs-table + '((#\n :control))) + +(set-key `(com-next-line ,*numeric-argument-marker*) + 'global-climacs-table + '((:down))) + (define-named-command com-open-line ((numarg 'integer :prompt "How many lines?")) (open-line (point (current-window)) numarg)) +(set-key `(com-open-line ,*numeric-argument-marker*) + 'global-climacs-table + '((#\o :control))) + (defun kill-line (mark &optional (count 1) (whole-lines-p nil) (concatenate-p nil)) (let ((start (offset mark))) (cond ((= 0 count) @@ -421,14 +505,34 @@ (concatenate-p (eq (previous-command pane) 'com-kill-line))) (kill-line point numarg numargp concatenate-p))) +(set-key `(com-kill-line ,*numeric-argument-marker* ,*numeric-argument-p*) + 'global-climacs-table + '((#\k :control))) + (define-named-command com-forward-word ((count 'integer :prompt "Number of words")) (if (plusp count) (forward-word (point (current-window)) count) (backward-word (point (current-window)) (- count)))) +(set-key `(com-forward-word ,*numeric-argument-marker*) + 'global-climacs-table + '((#\f :meta))) + +(set-key `(com-forward-word ,*numeric-argument-marker*) + 'global-climacs-table + '((:right :control))) + (define-named-command com-backward-word ((count 'integer :prompt "Number of words")) (backward-word (point (current-window)) count)) +(set-key `(com-backward-word ,*numeric-argument-marker*) + 'global-climacs-table + '((#\b :meta))) + +(set-key `(com-backward-word ,*numeric-argument-marker*) + 'global-climacs-table + '((:left :control))) + (define-named-command com-delete-word ((count 'integer :prompt "Number of words")) (delete-word (point (current-window)) count)) @@ -458,12 +562,20 @@ (concatenate-p (eq (previous-command pane) 'com-kill-word))) (kill-word point count concatenate-p))) +(set-key `(com-kill-word ,*numeric-argument-marker*) + 'global-climacs-table + '((#\d :meta))) + (define-named-command com-backward-kill-word ((count 'integer :prompt "Number of words")) (let* ((pane (current-window)) (point (point pane)) (concatenate-p (eq (previous-command pane) 'com-backward-kill-word))) (kill-word point (- count) concatenate-p))) +(set-key `(com-backward-kill-word ,*numeric-argument-marker*) + 'global-climacs-table + '((#\Backspace :meta))) + (define-named-command com-mark-word ((count 'integer :prompt "Number of words")) (let* ((pane (current-window)) (point (point pane)) @@ -474,6 +586,10 @@ (forward-word mark count) (backward-word mark (- count))))) +(set-key `(com-mark-word ,*numeric-argument-marker*) + 'global-climacs-table + '((#\@ :meta :shift))) + (define-named-command com-backward-delete-word ((count 'integer :prompt "Number of words")) (backward-delete-word (point (current-window)) count)) @@ -492,12 +608,21 @@ (define-named-command com-upcase-word () (upcase-word (point (current-window)))) +(set-key 'com-upcase-word 'global-climacs-table + '((#\u :meta))) + (define-named-command com-downcase-word () (downcase-word (point (current-window)))) +(set-key 'com-downcase-word 'global-climacs-table + '((#\l :meta))) + (define-named-command com-capitalize-word () (capitalize-word (point (current-window)))) +(set-key 'com-capitalize-word 'global-climacs-table + '((#\c :meta))) + (define-named-command com-tabify-region () (let ((pane (current-window))) (tabify-region @@ -523,15 +648,27 @@ (point (point pane))) (indent-current-line pane point))) +(set-key 'com-indent-line 'global-climacs-table + '((#\Tab))) + +(set-key 'com-indent-line 'global-climacs-table + '((#\i :control))) + (define-named-command com-newline-and-indent () (let* ((pane (current-window)) (point (point pane))) (insert-object point #\Newline) (indent-current-line pane point))) +(set-key 'com-newline-and-indent 'global-climacs-table + '((#\j :control))) + (define-named-command com-delete-indentation () (delete-indentation (point (current-window)))) +(set-key 'com-delete-indentation 'global-climacs-table + '((#\^ :shift :meta))) + (define-named-command com-auto-fill-mode () (let ((pane (current-window))) (setf (auto-fill-mode pane) (not (auto-fill-mode pane))))) @@ -556,6 +693,9 @@ (possibly-fill-line) (setf (offset point) (offset point-backup))))) +(set-key 'com-fill-paragraph 'global-climacs-table + '((#\q :meta))) + (eval-when (:compile-toplevel :load-toplevel) (define-presentation-type completable-pathname () :inherit-from 'pathname)) @@ -715,6 +855,9 @@ :prompt "Find File"))) (find-file filepath))) +(set-key 'com-find-file 'global-climacs-table + '((#\x :control) (#\f :control))) + (defun find-file-read-only (filepath) (cond ((null filepath) (display-message "No file name given.") @@ -755,10 +898,16 @@ (let ((filepath (accept 'completable-pathname :Prompt "Find file read only"))) (find-file-read-only filepath))) +(set-key 'com-find-file-read-only 'global-climacs-table + '((#\x :control) (#\r :control))) + (define-named-command com-toggle-read-only () (let ((buffer (buffer (current-window)))) (setf (read-only-p buffer) (not (read-only-p buffer))))) +(set-key 'com-toggle-read-only 'global-climacs-table + '((#\x :control) (#\q :control))) + (defun set-visited-file-name (filename buffer) (setf (filepath buffer) filename (name buffer) (filepath-filename filename) @@ -782,6 +931,9 @@ (offset (point pane)) (offset (mark pane)))) (redisplay-frame-panes *application-frame*))) +(set-key 'com-insert-file 'global-climacs-table + '((#\x :control) (#\i :control))) + (defgeneric erase-buffer (buffer)) (defmethod erase-buffer ((buffer string)) @@ -844,6 +996,9 @@ (save-buffer buffer) (display-message "No changes need to be saved from ~a" (name buffer))))) +(set-key 'com-save-buffer 'global-climacs-table + '((#\x :control) (#\s :control))) + (defmethod frame-exit :around ((frame climacs)) (loop for buffer in (buffers frame) when (and (needs-saving buffer) @@ -877,6 +1032,9 @@ (needs-saving buffer) nil) (display-message "Wrote: ~a" (filepath buffer)))))) +(set-key 'com-write-buffer 'global-climacs-table + '((#\x :control) (#\w :control))) + (define-presentation-method present (object (type buffer) stream (view textual-view) @@ -933,6 +1091,9 @@ :default-type 'buffer))) (switch-to-buffer buffer))) +(set-key 'com-switch-to-buffer 'global-climacs-table + '((#\x :control) (#\b))) + (defgeneric kill-buffer (buffer)) (defmethod kill-buffer ((buffer climacs-buffer)) @@ -964,9 +1125,15 @@ :default-type 'buffer))) (kill-buffer buffer))) +(set-key 'com-kill-buffer 'global-climacs-table + '((#\x :control) (#\k))) + (define-named-command com-full-redisplay () (full-redisplay (current-window))) +(set-key 'com-full-redisplay 'global-climacs-table + '((#\l :control))) + (defun load-file (file-name) (cond ((directory-pathname-p file-name) (display-message "~A is a directory name." file-name) @@ -983,24 +1150,54 @@ :prompt "Load File"))) (load-file filepath))) +(set-key 'com-load-file 'global-climacs-table + '((#\c :control) (#\l :control))) + (define-named-command com-beginning-of-buffer () (beginning-of-buffer (point (current-window)))) +(set-key 'com-beginning-of-buffer 'global-climacs-table + '((#\< :shift :meta))) + +(set-key 'com-beginning-of-buffer 'global-climacs-table + '((:home :control))) + (define-named-command com-page-down () (let ((pane (current-window))) (page-down pane))) +(set-key 'com-page-down 'global-climacs-table + '((#\v :control))) + +(set-key 'com-page-down 'global-climacs-table + '((:next))) + (define-named-command com-page-up () (let ((pane (current-window))) (page-up pane))) +(set-key 'com-page-up 'global-climacs-table + '((#\v :meta))) + +(set-key 'com-page-up 'global-climacs-table + '((:prior))) + (define-named-command com-end-of-buffer () (end-of-buffer (point (current-window)))) +(set-key 'com-end-of-buffer 'global-climacs-table + '((#\> :shift :meta))) + +(set-key 'com-end-of-buffer 'global-climacs-table + '((:end :control))) + (define-named-command com-mark-whole-buffer () (beginning-of-buffer (point (current-window))) (end-of-buffer (mark (current-window)))) +(set-key 'com-mark-whole-buffer 'global-climacs-table + '((#\x :control) (#\h))) + (defun back-to-indentation (mark) (beginning-of-line mark) (loop until (end-of-line-p mark) @@ -1010,6 +1207,9 @@ (define-named-command com-back-to-indentation () (back-to-indentation (point (current-window)))) +(set-key 'com-back-to-indentation 'global-climacs-table + '((#\m :meta))) + (defun delete-horizontal-space (mark &optional (backward-only-p nil)) (let ((mark2 (clone-mark mark))) (loop until (beginning-of-line-p mark) @@ -1025,6 +1225,10 @@ 'boolean :prompt "Delete backwards only?")) (delete-horizontal-space (point (current-window)) backward-only-p)) +(set-key `(com-delete-horizontal-space ,*numeric-argument-p*) + 'global-climacs-table + '((#\\ :meta))) + (defun just-one-space (mark count) (let (offset) (loop until (beginning-of-line-p mark) @@ -1042,6 +1246,10 @@ (define-named-command com-just-one-space ((count 'integer :prompt "Number of spaces")) (just-one-space (point (current-window)) count)) +(set-key `(com-just-one-space ,*numeric-argument-marker*) + 'global-climacs-table + '((#\Space :meta))) + (defun goto-position (mark pos) (setf (offset mark) pos)) @@ -1081,11 +1289,17 @@ (let ((pane (current-window))) (setf (mark pane) (clone-mark (point pane))))) +(set-key 'com-set-mark 'global-climacs-table + '((#\Space :control))) + (define-named-command com-exchange-point-and-mark () (let ((pane (current-window))) (psetf (offset (mark pane)) (offset (point pane)) (offset (point pane)) (offset (mark pane))))) +(set-key 'com-exchange-point-and-mark 'global-climacs-table + '((#\x :control) (#\x :control))) + (defgeneric set-syntax (buffer syntax)) (defmethod set-syntax ((buffer climacs-buffer) (syntax syntax)) @@ -1188,6 +1402,9 @@ (define-named-command com-split-window-vertically () (split-window-vertically)) +(set-key 'com-split-window-vertically 'global-climacs-table + '((#\x :control) (#\2))) + (defun split-window-horizontally (&optional (pane (current-window))) (with-look-and-feel-realization ((frame-manager *application-frame*) *application-frame*) @@ -1210,6 +1427,9 @@ (define-named-command com-split-window-horizontally () (split-window-horizontally)) +(set-key 'com-split-window-horizontally 'global-climacs-table + '((#\x :control) (#\3))) + (defun other-window () (setf (windows *application-frame*) (append (cdr (windows *application-frame*)) @@ -1219,6 +1439,9 @@ (define-named-command com-other-window () (other-window)) +(set-key 'com-other-window 'global-climacs-table + '((#\x :control) (#\o))) + (defun single-window () (loop until (null (cdr (windows *application-frame*))) do (rotatef (car (windows *application-frame*)) @@ -1229,16 +1452,25 @@ (define-named-command com-single-window () (single-window)) +(set-key 'com-single-window 'global-climacs-table + '((#\x :control) (#\1))) + (define-named-command com-scroll-other-window () (let ((other-window (second (windows *application-frame*)))) (when other-window (page-down other-window)))) +(set-key 'com-scroll-other-window 'global-climacs-table + '((#\v :control :meta))) + (define-named-command com-scroll-other-window-up () (let ((other-window (second (windows *application-frame*)))) (when other-window (page-up other-window)))) +(set-key 'com-scroll-other-window-up 'global-climacs-table + '((#\V :control :meta :shift))) + (defun delete-window (&optional (window (current-window))) (unless (null (cdr (windows *application-frame*))) (let* ((constellation (if *with-scrollbars* @@ -1271,6 +1503,9 @@ (define-named-command com-delete-window () (delete-window)) +(set-key 'com-delete-window 'global-climacs-table + '((#\x :control) (#\0))) + ;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands @@ -1278,6 +1513,9 @@ (define-named-command com-yank () (insert-sequence (point (current-window)) (kill-ring-yank *kill-ring*))) +(set-key 'com-yank 'global-climacs-table + '((#\y :control))) + ;; Destructively cut a given buffer region into the kill-ring (define-named-command com-kill-region () (let ((pane (current-window))) @@ -1285,11 +1523,17 @@ *kill-ring* (region-to-sequence (mark pane) (point pane))) (delete-region (mark pane) (point pane)))) +(set-key 'com-kill-region 'global-climacs-table + '((#\w :control))) + ;; Non destructively copies buffer region to the kill ring (define-named-command com-copy-region () (let ((pane (current-window))) (kill-ring-standard-push *kill-ring* (region-to-sequence (point pane) (mark pane))))) +(set-key 'com-copy-region 'global-climacs-table + '((#\w :control))) + (define-named-command com-rotate-yank () (let* ((pane (current-window)) (point (point pane)) @@ -1301,6 +1545,9 @@ (rotate-yank-position *kill-ring*))) (insert-sequence point (kill-ring-yank *kill-ring*)))) +(set-key 'com-rotate-yank 'global-climacs-table + '((#\y :meta))) + (define-named-command com-resize-kill-ring () (let ((size (handler-case (accept 'integer :prompt "New kill ring size") (error () (progn (beep) @@ -1311,6 +1558,9 @@ (define-named-command com-append-next-kill () (setf (append-next-p *kill-ring*) t)) +(set-key 'com-append-next-kill 'global-climacs-table + '((#\w :control :meta))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Incremental search @@ -1364,10 +1614,16 @@ (display-message "Isearch: ") (isearch-command-loop (current-window) t)) +(set-key 'com-isearch-forward 'global-climacs-table + '((#\s :control))) + (define-named-command com-isearch-backward () (display-message "Isearch backward: ") (isearch-command-loop (current-window) nil)) +(set-key 'com-isearch-backward 'global-climacs-table + '((#\r :control))) + (define-command (com-isearch-append-char :name t :command-table isearch-climacs-table) () (let* ((pane (current-window)) (states (isearch-states pane)) @@ -1493,6 +1749,9 @@ ((setf (query-replace-mode pane) nil)))) (display-message "Replaced ~A occurrence~:P" occurrences))) +(set-key 'com-query-replace 'global-climacs-table + '((#\% :shift :meta))) + (define-command (com-query-replace-replace :name t :command-table query-replace-climacs-table) () (declare (special string1 string2 occurrences)) (let* ((pane (current-window)) @@ -1550,11 +1809,23 @@ (no-more-undo () (beep) (display-message "No more undo"))) (full-redisplay (current-window))) +(set-key 'com-undo 'global-climacs-table + '((#\_ :shift :control))) + +(set-key 'com-undo 'global-climacs-table + '((#\x :control) (#\u))) + (define-named-command com-redo () (handler-case (redo (undo-tree (buffer (current-window)))) (no-more-undo () (beep) (display-message "No more redo"))) (full-redisplay (current-window))) +(set-key 'com-redo 'global-climacs-table + '((#\_ :shift :meta))) + +(set-key 'com-redo 'global-climacs-table + '((#\x :control) (#\r :control))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Dynamic abbrevs @@ -1596,6 +1867,8 @@ (setf (offset dabbrev-expansion-mark) offset)))) (move)))))))) +(set-key 'com-dabbrev-expand 'global-climacs-table + '((#\/ :meta))) (define-named-command com-backward-paragraph ((count 'integer :prompt "Number of paragraphs")) (let* ((pane (current-window)) @@ -1605,6 +1878,10 @@ (loop repeat count do (backward-paragraph point syntax)) (loop repeat (- count) do (forward-paragraph point syntax))))) +(set-key `(com-backward-paragraph ,*numeric-argument-marker*) + 'global-climacs-table + '((#\{ :shift :meta))) + (define-named-command com-forward-paragraph ((count 'integer :prompt "Number of paragraphs")) (let* ((pane (current-window)) (point (point pane)) @@ -1613,6 +1890,10 @@ (loop repeat count do (forward-paragraph point syntax)) (loop repeat (- count) do (backward-paragraph point syntax))))) +(set-key `(com-forward-paragraph ,*numeric-argument-marker*) + 'global-climacs-table + '((#\} :shift :meta))) + (define-named-command com-mark-paragraph ((count 'integer :prompt "Number of paragraphs")) (let* ((pane (current-window)) (point (point pane)) @@ -1627,6 +1908,10 @@ (loop repeat count do (forward-paragraph mark syntax)) (loop repeat (- count) do (backward-paragraph mark syntax))))) +(set-key `(com-mark-paragraph ,*numeric-argument-marker*) + 'global-climacs-table + '((#\h :meta))) + (define-named-command com-backward-sentence ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) @@ -1635,6 +1920,10 @@ (loop repeat count do (backward-sentence point syntax)) (loop repeat (- count) do (forward-sentence point syntax))))) +(set-key `(com-backward-sentence ,*numeric-argument-marker*) + 'global-climacs-table + '((#\a :meta))) + (define-named-command com-forward-sentence ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) @@ -1643,6 +1932,10 @@ (loop repeat count do (forward-sentence point syntax)) (loop repeat (- count) do (backward-sentence point syntax))))) +(set-key `(com-forward-sentence ,*numeric-argument-marker*) + 'global-climacs-table + '((#\e :meta))) + (define-named-command com-kill-sentence ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) @@ -1654,6 +1947,10 @@ (kill-ring-standard-push *kill-ring* (region-to-sequence point mark)) (delete-region point mark))) +(set-key `(com-kill-sentence *numeric-argument-marker*) + 'global-climacs-table + '((#\k :meta))) + (define-named-command com-backward-kill-sentence ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) @@ -1665,6 +1962,10 @@ (kill-ring-standard-push *kill-ring* (region-to-sequence point mark)) (delete-region point mark))) +(set-key `(com-backward-kill-sentence ,*numeric-argument-marker*) + 'global-climacs-table + '((#\x :control) (#\Backspace))) + (defun forward-page (mark &optional (count 1)) (loop repeat count unless (search-forward mark (coerce (list #\Newline #\Page) 'vector)) @@ -1678,6 +1979,10 @@ (forward-page point count) (backward-page point count)))) +(set-key `(com-forward-page ,*numeric-argument-marker*) + 'global-climacs-table + '((#\x :control) (#\]))) + (defun backward-page (mark &optional (count 1)) (loop repeat count when (search-backward mark (coerce (list #\Newline #\Page) 'vector)) @@ -1692,6 +1997,9 @@ (backward-page point count) (forward-page point count)))) +(set-key 'com-backward-page 'global-climacs-table + '((#\x :control) (#\[))) + (define-named-command com-mark-page ((count 'integer :prompt "Move how many pages") (numargp 'boolean :prompt "Move to another page?")) (let* ((pane (current-window)) @@ -1705,6 +2013,10 @@ (setf (offset mark) (offset point)) (forward-page mark 1))) +(set-key `(com-mark-page ,*numeric-argument-marker* ,*numeric-argument-p*) + 'global-climacs-table + '((#\x :control) (#\p :control))) + (define-named-command com-count-lines-page () (let* ((pane (current-window)) (point (point pane)) @@ -1717,6 +2029,9 @@ (after (number-of-lines-in-region point end))) (display-message "Page has ~A lines (~A + ~A)" total before after)))) +(set-key 'com-count-lines-page 'global-climacs-table + '((#\x :control) (#\l))) + (define-named-command com-count-lines-region () (let* ((pane (current-window)) (point (point pane)) @@ -1725,6 +2040,9 @@ (chars (abs (- (offset point) (offset mark))))) (display-message "Region has ~D line~:P, ~D character~:P." lines chars))) +(set-key 'com-count-lines-region 'global-climacs-table + '((#\= :meta))) + (define-named-command com-what-cursor-position () (let* ((pane (current-window)) (point (point pane)) @@ -1737,6 +2055,9 @@ char (char-code char) offset size (round (* 100 (/ offset size))) column))) +(set-key 'com-what-cursor-position 'global-climacs-table + '((#\x :control) (#\=))) + (define-named-command com-eval-expression ((insertp 'boolean :prompt "Insert?")) (let* ((*package* (find-package :climacs-gui)) (string (handler-case (accept 'string :prompt "Eval") @@ -1753,6 +2074,10 @@ (insert-sequence (point (current-window)) result) (display-message result)))) +(set-key `(com-eval-expression ,*numeric-argument-p*) + 'global-climacs-table + '((#\: :shift :meta))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Commenting @@ -1773,6 +2098,10 @@ (loop repeat count do (backward-expression point syntax)) (loop repeat (- count) do (forward-expression point syntax))))) +(set-key `(com-backward-expression ,*numeric-argument-marker*) + 'global-climacs-table + '((#\b :control :meta))) + (define-named-command com-forward-expression ((count 'integer :prompt "Number of expresssions")) (let* ((pane (current-window)) (point (point pane)) @@ -1781,6 +2110,10 @@ (loop repeat count do (forward-expression point syntax)) (loop repeat (- count) do (backward-expression point syntax))))) +(set-key `(com-forward-expression ,*numeric-argument-marker*) + 'global-climacs-table + '((#\f :control :meta))) + (define-named-command com-mark-expression ((count 'integer :prompt "Number of expressions")) (let* ((pane (current-window)) (point (point pane)) @@ -1792,6 +2125,10 @@ (loop repeat count do (forward-expression mark syntax)) (loop repeat (- count) do (backward-expression mark syntax))))) +(set-key `(com-mark-expression ,*numeric-argument-marker*) + 'global-climacs-table + '((#\@ :shift :control :meta))) + (define-named-command com-kill-expression ((count 'integer :prompt "Number of expressions")) (let* ((pane (current-window)) (point (point pane)) @@ -1803,6 +2140,10 @@ (kill-ring-standard-push *kill-ring* (region-to-sequence mark point)) (delete-region mark point))) +(set-key `(com-kill-expression ,*numeric-argument-marker*) + 'global-climacs-table + '((#\k :control :meta))) + (define-named-command com-backward-kill-expression ((count 'integer :prompt "Number of expressions")) (let* ((pane (current-window)) @@ -1815,6 +2156,10 @@ (kill-ring-standard-push *kill-ring* (region-to-sequence mark point)) (delete-region mark point))) +(set-key `(com-backward-kill-expression ,*numeric-argument-marker*) + 'global-climacs-table + '((#\Backspace :control :meta))) + (define-named-command com-forward-list ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) @@ -1823,6 +2168,10 @@ (loop repeat count do (forward-list point syntax)) (loop repeat (- count) do (backward-list point syntax))))) +(set-key `(com-forward-list ,*numeric-argument-marker*) + 'global-climacs-table + '((#\n :control :meta))) + (define-named-command com-backward-list ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) @@ -1831,6 +2180,10 @@ (loop repeat count do (backward-list point syntax)) (loop repeat (- count) do (forward-list point syntax))))) +(set-key `(com-backward-list ,*numeric-argument-marker*) + 'global-climacs-table + '((#\p :control :meta))) + (define-named-command com-down-list ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) @@ -1839,6 +2192,10 @@ (loop repeat count do (down-list point syntax)) (loop repeat (- count) do (backward-down-list point syntax))))) +(set-key `(com-down-list ,*numeric-argument-marker*) + 'global-climacs-table + '((#\d :control :meta))) + (define-named-command com-backward-down-list ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) @@ -1855,6 +2212,10 @@ (loop repeat count do (backward-up-list point syntax)) (loop repeat (- count) do (up-list point syntax))))) +(set-key `(com-backward-up-list ,*numeric-argument-marker*) + 'global-climacs-table + '((#\u :control :meta))) + (define-named-command com-up-list ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) @@ -1869,6 +2230,9 @@ (syntax (syntax (buffer pane)))) (eval-defun point syntax))) +(set-key 'com-eval-defun 'global-climacs-table + '((#\x :control :meta))) + (define-named-command com-beginning-of-definition ((count 'integer :prompt "Number of definitions")) (let* ((pane (current-window)) (point (point pane)) @@ -1877,6 +2241,10 @@ (loop repeat count do (beginning-of-definition point syntax)) (loop repeat (- count) do (end-of-definition point syntax))))) +(set-key `(com-beginning-of-definition ,*numeric-argument-marker*) + 'global-climacs-table + '((#\a :control :meta))) + (define-named-command com-end-of-definition ((count 'integer :prompt "Number of definitions")) (let* ((pane (current-window)) (point (point pane)) @@ -1885,6 +2253,10 @@ (loop repeat count do (end-of-definition point syntax)) (loop repeat (- count) do (beginning-of-definition point syntax))))) +(set-key `(com-end-of-definition ,*numeric-argument-marker*) + 'global-climacs-table + '((#\e :control :meta))) + (define-named-command com-mark-definition () (let* ((pane (current-window)) (point (point pane)) @@ -1895,6 +2267,9 @@ (setf (offset mark) (offset point))) (end-of-definition mark syntax))) +(set-key 'com-mark-definition 'global-climacs-table + '((#\h :control :meta))) + (define-named-command com-package () (let* ((pane (current-window)) (syntax (syntax (buffer pane))) @@ -1940,159 +2315,14 @@ (define-named-command com-toggle-visible-mark () (setf (mark-visible-p (current-window)) (not (mark-visible-p (current-window))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Dead-escape command tables - -(make-command-table 'dead-escape-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'global-climacs-table "dead-escape" - :menu 'dead-escape-climacs-table - :keystroke '(:escape)) - -(defun dead-escape-set-key (gesture command) - (add-command-to-command-table command 'dead-escape-climacs-table - :keystroke gesture :errorp nil)) - -(dead-escape-set-key '(#\x) 'esa::com-extended-command) - -(defun global-set-key (gesture command) - (add-command-to-command-table command 'global-climacs-table - :keystroke gesture :errorp nil) - (when (and - (listp gesture) - (find :meta gesture)) - (dead-escape-set-key (remove :meta gesture) command))) - (loop for code from (char-code #\Space) to (char-code #\~) - do (global-set-key (code-char code) `(com-self-insert ,*numeric-argument-marker*))) - -(global-set-key #\Newline `(com-self-insert ,*numeric-argument-marker*)) -(global-set-key #\Tab 'com-indent-line) -(global-set-key '(#\i :control) 'com-indent-line) -(global-set-key '(#\: :shift :meta) `(com-eval-expression ,*numeric-argument-p*)) -(global-set-key '(#\j :control) 'com-newline-and-indent) -(global-set-key '(#\f :control) `(com-forward-object ,*numeric-argument-marker*)) -(global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*)) -(global-set-key '(#\a :control) 'com-beginning-of-line) -(global-set-key '(#\e :control) 'com-end-of-line) -(global-set-key '(#\d :control) `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*)) -(global-set-key '(#\p :control) `(com-previous-line ,*numeric-argument-marker*)) -(global-set-key '(#\l :control) 'com-full-redisplay) -(global-set-key '(#\n :control) `(com-next-line ,*numeric-argument-marker*)) -(global-set-key '(#\o :control) `(com-open-line ,*numeric-argument-marker*)) -(global-set-key '(#\k :control) `(com-kill-line ,*numeric-argument-marker* ,*numeric-argument-p*)) -(global-set-key '(#\t :control) 'com-transpose-objects) -(global-set-key '(#\Space :control) 'com-set-mark) -(global-set-key '(#\y :control) 'com-yank) -(global-set-key '(#\w :control) 'com-kill-region) -(global-set-key '(#\w :control :meta) 'com-append-next-kill) -(global-set-key '(#\e :meta) `(com-forward-sentence ,*numeric-argument-marker*)) -(global-set-key '(#\a :meta) `(com-backward-sentence ,*numeric-argument-marker*)) -(global-set-key '(#\k :meta) `(com-kill-sentence ,*numeric-argument-marker*)) -(global-set-key '(#\@ :meta :control :shift) `(com-mark-expression ,*numeric-argument-marker*)) -(global-set-key '(#\f :meta) `(com-forward-word ,*numeric-argument-marker*)) -(global-set-key '(#\b :meta) `(com-backward-word ,*numeric-argument-marker*)) -(global-set-key '(#\t :meta) 'com-transpose-words) -(global-set-key '(#\u :meta) 'com-upcase-word) -(global-set-key '(#\l :meta) 'com-downcase-word) -(global-set-key '(#\c :meta) 'com-capitalize-word) -(global-set-key '(#\y :meta) 'com-rotate-yank) -(global-set-key '(#\z :meta) 'com-zap-to-character) -(global-set-key '(#\w :meta) 'com-copy-region) -(global-set-key '(#\v :control) 'com-page-down) -(global-set-key '(#\v :meta) 'com-page-up) -(global-set-key '(#\v :control :meta) 'com-scroll-other-window) -(global-set-key '(#\V :control :meta :shift) 'com-scroll-other-window-up) -(global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) -(global-set-key '(#\> :shift :meta) 'com-end-of-buffer) -(global-set-key '(#\m :meta) 'com-back-to-indentation) -(global-set-key '(#\\ :meta) `(com-delete-horizontal-space ,*numeric-argument-p*)) -(global-set-key '(#\Space :meta) `(com-just-one-space ,*numeric-argument-marker*)) -(global-set-key '(#\^ :shift :meta) 'com-delete-indentation) -(global-set-key '(#\q :meta) 'com-fill-paragraph) -(global-set-key '(#\d :meta) `(com-kill-word ,*numeric-argument-marker*)) -(global-set-key '(#\Backspace :meta) `(com-backward-kill-word ,*numeric-argument-marker*)) -(global-set-key '(#\@ :meta :shift) `(com-mark-word ,*numeric-argument-marker*)) -(global-set-key '(#\/ :meta) 'com-dabbrev-expand) -(global-set-key '(#\{ :meta :shift) `(com-backward-paragraph ,*numeric-argument-marker*)) -(global-set-key '(#\} :meta :shift) `(com-forward-paragraph ,*numeric-argument-marker*)) -(global-set-key '(#\h :meta) `(com-mark-paragraph ,*numeric-argument-marker*)) -(global-set-key '(#\s :control) 'com-isearch-forward) -(global-set-key '(#\r :control) 'com-isearch-backward) -(global-set-key '(#\_ :shift :meta) 'com-redo) -(global-set-key '(#\_ :shift :control) 'com-undo) -(global-set-key '(#\% :shift :meta) 'com-query-replace) -(global-set-key '(#\= :meta) 'com-count-lines-region) -(global-set-key '(:up) `(com-previous-line ,*numeric-argument-marker*)) -(global-set-key '(:down) `(com-next-line ,*numeric-argument-marker*)) -(global-set-key '(:left) `(com-backward-object ,*numeric-argument-marker*)) -(global-set-key '(:right) `(com-forward-object ,*numeric-argument-marker*)) -(global-set-key '(:left :control) `(com-backward-word ,*numeric-argument-marker*)) -(global-set-key '(:right :control) `(com-forward-word ,*numeric-argument-marker*)) -(global-set-key '(:home) 'com-beginning-of-line) -(global-set-key '(:end) 'com-end-of-line) -(global-set-key '(:prior) 'com-page-up) -(global-set-key '(:next) 'com-page-down) -(global-set-key '(:home :control) 'com-beginning-of-buffer) -(global-set-key '(:end :control) 'com-end-of-buffer) -(global-set-key #\Rubout `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*)) -(global-set-key #\Backspace `(com-backward-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*)) - -(global-set-key '(:insert) 'com-toggle-overwrite-mode) -(global-set-key '(#\~ :meta :shift) 'com-not-modified) - -(global-set-key '(#\b :control :meta) `(com-backward-expression ,*numeric-argument-marker*)) -(global-set-key '(#\f :control :meta) `(com-forward-expression ,*numeric-argument-marker*)) -(global-set-key '(#\Backspace :control :meta) `(com-backward-kill-expression ,*numeric-argument-marker*)) -(global-set-key '(#\k :control :meta) `(com-kill-expression ,*numeric-argument-marker*)) -(global-set-key '(#\n :control :meta) `(com-forward-list ,*numeric-argument-marker*)) -(global-set-key '(#\p :control :meta) `(com-backward-list ,*numeric-argument-marker*)) -(global-set-key '(#\d :control :meta) `(com-down-list ,*numeric-argument-marker*)) -(global-set-key '(#\u :control :meta) `(com-backward-up-list ,*numeric-argument-marker*)) -(global-set-key '(#\x :control :meta) 'com-eval-defun) -(global-set-key '(#\a :control :meta) `(com-beginning-of-definition ,*numeric-argument-marker*)) -(global-set-key '(#\e :control :meta) `(com-end-of-definition ,*numeric-argument-marker*)) -(global-set-key '(#\h :control :meta) 'com-mark-definition) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; C-x command table - -(make-command-table 'c-x-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'global-climacs-table "C-x" - :menu 'c-x-climacs-table - :keystroke '(#\x :control)) - -(defun c-x-set-key (gesture command) - (add-command-to-command-table command 'c-x-climacs-table - :keystroke gesture :errorp nil)) - -(c-x-set-key '(#\0) 'com-delete-window) -(c-x-set-key '(#\1) 'com-single-window) -(c-x-set-key '(#\2) 'com-split-window-vertically) -(c-x-set-key '(#\3) 'com-split-window-horizontally) -(c-x-set-key '(#\b) 'com-switch-to-buffer) -(c-x-set-key '(#\f :control) 'com-find-file) -(c-x-set-key '(#\r :control) 'com-find-file-read-only) -(c-x-set-key '(#\q :control) 'com-toggle-read-only) -(c-x-set-key '(#\f) `(com-set-fill-column ,*numeric-argument-marker*)) -(c-x-set-key '(#\h) 'com-mark-whole-buffer) -(c-x-set-key '(#\i) 'com-insert-file) -(c-x-set-key '(#\k) 'com-kill-buffer) -(c-x-set-key '(#\o) 'com-other-window) -(c-x-set-key '(#\r) 'com-redo) -(c-x-set-key '(#\u) 'com-undo) -(c-x-set-key '(#\]) `(com-forward-page ,*numeric-argument-marker*)) -(c-x-set-key '(#\[) `(com-backward-page ,*numeric-argument-marker*)) -(c-x-set-key '(#\p :control) `(com-mark-page ,*numeric-argument-marker* ,*numeric-argument-p*)) -(c-x-set-key '(#\l) 'com-count-lines-page) -(c-x-set-key '(#\s :control) 'com-save-buffer) -(c-x-set-key '(#\t :control) 'com-transpose-lines) -(c-x-set-key '(#\w :control) 'com-write-buffer) -(c-x-set-key '(#\x :control) 'com-exchange-point-and-mark) -(c-x-set-key '(#\=) 'com-what-cursor-position) -(c-x-set-key '(#\Backspace) `(com-backward-kill-sentence ,*numeric-argument-marker*)) + do (set-key `(com-self-insert ,*numeric-argument-marker*) + 'global-climacs-table + (list (list (code-char code))))) + +(set-key `(com-self-insert ,*numeric-argument-marker*) + 'global-climacs-table + '((#\Newline))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -2101,174 +2331,78 @@ (define-named-command com-insert-charcode ((code 'integer :prompt "Code point")) (insert-object (point (current-window)) (code-char code))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Dead-acute command table - -(make-command-table 'dead-acute-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'global-climacs-table "dead-acute" - :menu 'dead-acute-climacs-table - :keystroke '(:dead--acute)) - -(defun dead-acute-set-key (gesture command) - (add-command-to-command-table command 'dead-acute-climacs-table - :keystroke gesture :errorp nil)) - -(dead-acute-set-key '(#\A) '(com-insert-charcode 193)) -(dead-acute-set-key '(#\E) '(com-insert-charcode 201)) -(dead-acute-set-key '(#\I) '(com-insert-charcode 205)) -(dead-acute-set-key '(#\O) '(com-insert-charcode 211)) -(dead-acute-set-key '(#\U) '(com-insert-charcode 218)) -(dead-acute-set-key '(#\Y) '(com-insert-charcode 221)) -(dead-acute-set-key '(#\a) '(com-insert-charcode 225)) -(dead-acute-set-key '(#\e) '(com-insert-charcode 233)) -(dead-acute-set-key '(#\i) '(com-insert-charcode 237)) -(dead-acute-set-key '(#\o) '(com-insert-charcode 243)) -(dead-acute-set-key '(#\u) '(com-insert-charcode 250)) -(dead-acute-set-key '(#\y) '(com-insert-charcode 253)) -(dead-acute-set-key '(#\C) '(com-insert-charcode 199)) -(dead-acute-set-key '(#\c) '(com-insert-charcode 231)) -(dead-acute-set-key '(#\x) '(com-insert-charcode 215)) -(dead-acute-set-key '(#\-) '(com-insert-charcode 247)) -(dead-acute-set-key '(#\T) '(com-insert-charcode 222)) -(dead-acute-set-key '(#\t) '(com-insert-charcode 254)) -(dead-acute-set-key '(#\s) '(com-insert-charcode 223)) -(dead-acute-set-key '(#\Space) '(com-insert-charcode 39)) - -(make-command-table 'dead-acute-dead-accute-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'dead-acute-climacs-table "dead-acute-dead-accute" - :menu 'dead-acute-dead-accute-climacs-table - :keystroke '(:dead--acute)) - -(defun dead-acute-dead-accute-set-key (gesture command) - (add-command-to-command-table command 'dead-acute-dead-accute-climacs-table - :keystroke gesture :errorp nil)) - -(dead-acute-dead-accute-set-key '(#\A) '(com-insert-charcode 197)) -(dead-acute-dead-accute-set-key '(#\a) '(com-insert-charcode 229)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Dead-grave command table - -(make-command-table 'dead-grave-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'global-climacs-table "dead-grave" - :menu 'dead-grave-climacs-table - :keystroke '(:dead--grave)) - -(defun dead-grave-set-key (gesture command) - (add-command-to-command-table command 'dead-grave-climacs-table - :keystroke gesture :errorp nil)) - -(dead-grave-set-key '(#\A) '(com-insert-charcode 192)) -(dead-grave-set-key '(#\E) '(com-insert-charcode 200)) -(dead-grave-set-key '(#\I) '(com-insert-charcode 204)) -(dead-grave-set-key '(#\O) '(com-insert-charcode 210)) -(dead-grave-set-key '(#\U) '(com-insert-charcode 217)) -(dead-grave-set-key '(#\a) '(com-insert-charcode 224)) -(dead-grave-set-key '(#\e) '(com-insert-charcode 232)) -(dead-grave-set-key '(#\i) '(com-insert-charcode 236)) -(dead-grave-set-key '(#\o) '(com-insert-charcode 242)) -(dead-grave-set-key '(#\u) '(com-insert-charcode 249)) -(dead-grave-set-key '(#\Space) '(com-insert-charcode 96)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Dead-diaeresis command table - -(make-command-table 'dead-diaeresis-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'global-climacs-table "dead-diaeresis" - :menu 'dead-diaeresis-climacs-table - :keystroke '(:dead--diaeresis :shift)) - -(defun dead-diaeresis-set-key (gesture command) - (add-command-to-command-table command 'dead-diaeresis-climacs-table - :keystroke gesture :errorp nil)) - -(dead-diaeresis-set-key '(#\A) '(com-insert-charcode 196)) -(dead-diaeresis-set-key '(#\E) '(com-insert-charcode 203)) -(dead-diaeresis-set-key '(#\I) '(com-insert-charcode 207)) -(dead-diaeresis-set-key '(#\O) '(com-insert-charcode 214)) -(dead-diaeresis-set-key '(#\U) '(com-insert-charcode 220)) -(dead-diaeresis-set-key '(#\a) '(com-insert-charcode 228)) -(dead-diaeresis-set-key '(#\e) '(com-insert-charcode 235)) -(dead-diaeresis-set-key '(#\i) '(com-insert-charcode 239)) -(dead-diaeresis-set-key '(#\o) '(com-insert-charcode 246)) -(dead-diaeresis-set-key '(#\u) '(com-insert-charcode 252)) -(dead-diaeresis-set-key '(#\y) '(com-insert-charcode 255)) -(dead-diaeresis-set-key '(#\Space) '(com-insert-charcode 34)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Dead-tilde command table - -(make-command-table 'dead-tilde-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'global-climacs-table "dead-tilde" - :menu 'dead-tilde-climacs-table - :keystroke '(:dead--tilde :shift)) - -(defun dead-tilde-set-key (gesture command) - (add-command-to-command-table command 'dead-tilde-climacs-table - :keystroke gesture :errorp nil)) - -(dead-tilde-set-key '(#\A) '(com-insert-charcode 195)) -(dead-tilde-set-key '(#\N) '(com-insert-charcode 209)) -(dead-tilde-set-key '(#\a) '(com-insert-charcode 227)) -(dead-tilde-set-key '(#\n) '(com-insert-charcode 241)) -(dead-tilde-set-key '(#\E) '(com-insert-charcode 198)) -(dead-tilde-set-key '(#\e) '(com-insert-charcode 230)) -(dead-tilde-set-key '(#\D) '(com-insert-charcode 208)) -(dead-tilde-set-key '(#\d) '(com-insert-charcode 240)) -(dead-tilde-set-key '(#\O) '(com-insert-charcode 216)) -(dead-tilde-set-key '(#\o) '(com-insert-charcode 248)) -(dead-tilde-set-key '(#\Space) '(com-insert-charcode 126)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Dead-circumflex command table - -(make-command-table 'dead-circumflex-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'global-climacs-table "dead-circumflex" - :menu 'dead-circumflex-climacs-table - :keystroke '(:dead--circumflex :shift)) - -(defun dead-circumflex-set-key (gesture command) - (add-command-to-command-table command 'dead-circumflex-climacs-table - :keystroke gesture :errorp nil)) - -(dead-circumflex-set-key '(#\A) '(com-insert-charcode 194)) -(dead-circumflex-set-key '(#\E) '(com-insert-charcode 202)) -(dead-circumflex-set-key '(#\I) '(com-insert-charcode 206)) -(dead-circumflex-set-key '(#\O) '(com-insert-charcode 212)) -(dead-circumflex-set-key '(#\U) '(com-insert-charcode 219)) -(dead-circumflex-set-key '(#\a) '(com-insert-charcode 226)) -(dead-circumflex-set-key '(#\e) '(com-insert-charcode 234)) -(dead-circumflex-set-key '(#\i) '(com-insert-charcode 238)) -(dead-circumflex-set-key '(#\o) '(com-insert-charcode 244)) -(dead-circumflex-set-key '(#\u) '(com-insert-charcode 251)) -(dead-circumflex-set-key '(#\Space) '(com-insert-charcode 94)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; C-c command table - -(make-command-table 'c-c-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'global-climacs-table "C-c" - :menu 'c-c-climacs-table - :keystroke '(#\c :control)) - -(defun c-c-set-key (gesture command) - (add-command-to-command-table command 'c-c-climacs-table - :keystroke gesture :errorp nil)) - -(c-c-set-key '(#\l :control) 'com-load-file) +(set-key '(com-insert-charcode 193) 'global-climacs-table '((:dead--acute)(#\A))) +(set-key '(com-insert-charcode 201) 'global-climacs-table '((:dead--acute)(#\E))) +(set-key '(com-insert-charcode 205) 'global-climacs-table '((:dead--acute)(#\I))) +(set-key '(com-insert-charcode 211) 'global-climacs-table '((:dead--acute)(#\O))) +(set-key '(com-insert-charcode 218) 'global-climacs-table '((:dead--acute)(#\U))) +(set-key '(com-insert-charcode 221) 'global-climacs-table '((:dead--acute)(#\Y))) +(set-key '(com-insert-charcode 225) 'global-climacs-table '((:dead--acute)(#\a))) +(set-key '(com-insert-charcode 233) 'global-climacs-table '((:dead--acute)(#\e))) +(set-key '(com-insert-charcode 237) 'global-climacs-table '((:dead--acute)(#\i))) +(set-key '(com-insert-charcode 243) 'global-climacs-table '((:dead--acute)(#\o))) +(set-key '(com-insert-charcode 250) 'global-climacs-table '((:dead--acute)(#\u))) +(set-key '(com-insert-charcode 253) 'global-climacs-table '((:dead--acute)(#\y))) +(set-key '(com-insert-charcode 199) 'global-climacs-table '((:dead--acute)(#\C))) +(set-key '(com-insert-charcode 231) 'global-climacs-table '((:dead--acute)(#\c))) +(set-key '(com-insert-charcode 215) 'global-climacs-table '((:dead--acute)(#\x))) +(set-key '(com-insert-charcode 247) 'global-climacs-table '((:dead--acute)(#\-))) +(set-key '(com-insert-charcode 222) 'global-climacs-table '((:dead--acute)(#\T))) +(set-key '(com-insert-charcode 254) 'global-climacs-table '((:dead--acute)(#\t))) +(set-key '(com-insert-charcode 223) 'global-climacs-table '((:dead--acute)(#\s))) +(set-key '(com-insert-charcode 39) 'global-climacs-table '((:dead--acute)(#\Space))) + +(set-key '(com-insert-charcode 197) 'global-climacs-table '((:dead--acute)(:dead--acute)(#\A))) +(set-key '(com-insert-charcode 229) 'global-climacs-table '((:dead--acute)(:dead--acute)(#\a))) + +(set-key '(com-insert-charcode 192) 'global-climacs-table '((:dead--grave)(#\A))) +(set-key '(com-insert-charcode 200) 'global-climacs-table '((:dead--grave)(#\E))) +(set-key '(com-insert-charcode 204) 'global-climacs-table '((:dead--grave)(#\I))) +(set-key '(com-insert-charcode 210) 'global-climacs-table '((:dead--grave)(#\O))) +(set-key '(com-insert-charcode 217) 'global-climacs-table '((:dead--grave)(#\U))) +(set-key '(com-insert-charcode 224) 'global-climacs-table '((:dead--grave)(#\a))) +(set-key '(com-insert-charcode 232) 'global-climacs-table '((:dead--grave)(#\e))) +(set-key '(com-insert-charcode 236) 'global-climacs-table '((:dead--grave)(#\i))) +(set-key '(com-insert-charcode 242) 'global-climacs-table '((:dead--grave)(#\o))) +(set-key '(com-insert-charcode 249) 'global-climacs-table '((:dead--grave)(#\u))) +(set-key '(com-insert-charcode 96) 'global-climacs-table '((:dead--grave)(#\Space))) + +(set-key '(com-insert-charcode 196) 'global-climacs-table '((:dead--diaeresis :shift)(#\A))) +(set-key '(com-insert-charcode 203) 'global-climacs-table '((:dead--diaeresis :shift)(#\E))) +(set-key '(com-insert-charcode 207) 'global-climacs-table '((:dead--diaeresis :shift)(#\I))) +(set-key '(com-insert-charcode 214) 'global-climacs-table '((:dead--diaeresis :shift)(#\O))) +(set-key '(com-insert-charcode 220) 'global-climacs-table '((:dead--diaeresis :shift)(#\U))) +(set-key '(com-insert-charcode 228) 'global-climacs-table '((:dead--diaeresis :shift)(#\a))) +(set-key '(com-insert-charcode 235) 'global-climacs-table '((:dead--diaeresis :shift)(#\e))) +(set-key '(com-insert-charcode 239) 'global-climacs-table '((:dead--diaeresis :shift)(#\i))) +(set-key '(com-insert-charcode 246) 'global-climacs-table '((:dead--diaeresis :shift)(#\o))) +(set-key '(com-insert-charcode 252) 'global-climacs-table '((:dead--diaeresis :shift)(#\u))) +(set-key '(com-insert-charcode 255) 'global-climacs-table '((:dead--diaeresis :shift)(#\y))) +(set-key '(com-insert-charcode 34) 'global-climacs-table '((:dead--diaeresis :shift)(#\Space))) + +(set-key '(com-insert-charcode 195) 'global-climacs-table '((:dead--tilde :shift)(#\A))) +(set-key '(com-insert-charcode 209) 'global-climacs-table '((:dead--tilde :shift)(#\N))) +(set-key '(com-insert-charcode 227) 'global-climacs-table '((:dead--tilde :shift)(#\a))) +(set-key '(com-insert-charcode 241) 'global-climacs-table '((:dead--tilde :shift)(#\n))) +(set-key '(com-insert-charcode 198) 'global-climacs-table '((:dead--tilde :shift)(#\E))) +(set-key '(com-insert-charcode 230) 'global-climacs-table '((:dead--tilde :shift)(#\e))) +(set-key '(com-insert-charcode 208) 'global-climacs-table '((:dead--tilde :shift)(#\D))) +(set-key '(com-insert-charcode 240) 'global-climacs-table '((:dead--tilde :shift)(#\d))) +(set-key '(com-insert-charcode 216) 'global-climacs-table '((:dead--tilde :shift)(#\O))) +(set-key '(com-insert-charcode 248) 'global-climacs-table '((:dead--tilde :shift)(#\o))) +(set-key '(com-insert-charcode 126) 'global-climacs-table '((:dead--tilde :shift)(#\Space))) + +(set-key '(com-insert-charcode 194) 'global-climacs-table '((:dead--circumflex :shift)(#\A))) +(set-key '(com-insert-charcode 202) 'global-climacs-table '((:dead--circumflex :shift)(#\E))) +(set-key '(com-insert-charcode 206) 'global-climacs-table '((:dead--circumflex :shift)(#\I))) +(set-key '(com-insert-charcode 212) 'global-climacs-table '((:dead--circumflex :shift)(#\O))) +(set-key '(com-insert-charcode 219) 'global-climacs-table '((:dead--circumflex :shift)(#\U))) +(set-key '(com-insert-charcode 226) 'global-climacs-table '((:dead--circumflex :shift)(#\a))) +(set-key '(com-insert-charcode 234) 'global-climacs-table '((:dead--circumflex :shift)(#\e))) +(set-key '(com-insert-charcode 238) 'global-climacs-table '((:dead--circumflex :shift)(#\i))) +(set-key '(com-insert-charcode 244) 'global-climacs-table '((:dead--circumflex :shift)(#\o))) +(set-key '(com-insert-charcode 251) 'global-climacs-table '((:dead--circumflex :shift)(#\u))) +(set-key '(com-insert-charcode 94) 'global-climacs-table '((:dead--circumflex :shift)(#\Space))) (define-named-command com-regex-search-forward () (let ((string (accept 'string :prompt "RE search" Index: climacs/esa.lisp diff -u climacs/esa.lisp:1.13 climacs/esa.lisp:1.14 --- climacs/esa.lisp:1.13 Sat Aug 6 22:51:20 2005 +++ climacs/esa.lisp Tue Aug 30 19:28:52 2005 @@ -301,7 +301,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; comand table manipulation +;;; command table manipulation (defun ensure-subtable (table gesture) (let* ((event (make-instance @@ -319,15 +319,18 @@ (command-menu-item-value (find-keystroke-item event table :errorp nil)))) - (defun set-key (command table gestures) - (if (null (cdr gestures)) - (add-command-to-command-table - command table :keystroke (car gestures) :errorp nil) - (set-key command - (ensure-subtable table (car gestures)) - (cdr gestures)))) - + (let ((gesture (car gestures))) + (cond ((null (cdr gestures)) + (add-command-to-command-table + command table :keystroke gesture :errorp nil) + (when (and (listp gesture) + (find :meta gesture)) + (set-key command table (list (list :escape) (remove :meta gesture))))) + (t (set-key command + (ensure-subtable table gesture) + (cdr gestures)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; standard key bindings

1 0

[climacs-cvs] CVS update: climacs/pane.lisp
by dmurray＠common-lisp.net 28 Aug '05

28 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv9146 Modified Files: pane.lisp Log Message: Fixed off-by-one error in mark-display drawing. Date: Sun Aug 28 15:57:34 2005 Author: dmurray Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.30 climacs/pane.lisp:1.31 --- climacs/pane.lisp:1.30 Fri Aug 19 11:12:48 2005 +++ climacs/pane.lisp Sun Aug 28 15:57:33 2005 @@ -571,7 +571,7 @@ (defmethod display-mark ((pane climacs-pane) (syntax basic-syntax)) (with-slots (top bot) pane (let ((mark (mark pane))) - (when (< (offset top) (offset mark) (offset bot)) + (when (<= (offset top) (offset mark) (offset bot)) (let* ((mark-line (number-of-lines-in-region top mark)) (style (medium-text-style pane)) (ascent (text-style-ascent style pane))

1 0

[climacs-cvs] CVS update: climacs/base-test.lisp climacs/base.lisp
by abakic＠common-lisp.net 27 Aug '05

27 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv10228 Modified Files: base-test.lisp base.lisp Log Message: A few more com-re-search* related bug fixes. Date: Sun Aug 28 00:07:48 2005 Author: abakic Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.15 climacs/base-test.lisp:1.16 --- climacs/base-test.lisp:1.15 Fri Aug 5 00:07:44 2005 +++ climacs/base-test.lisp Sun Aug 28 00:07:45 2005 @@ -1108,30 +1108,38 @@ (a1 (automaton::determinize (regexp-automaton (string-regexp "i[mac]+s")))) (a2 (automaton::determinize - (regexp-automaton (string-regexp "[^aeiou][aeiou]"))))) + (regexp-automaton (string-regexp "[^aeiou][aeiou]")))) + (a3 (regexp-automaton (string-regexp "imacs")))) (insert-buffer-sequence buffer 0 " climacs") - (values - (buffer-re-search-forward a1 buffer 0) - (buffer-re-search-forward a2 buffer 1) - (buffer-re-search-forward a1 buffer 4) - (buffer-re-search-forward a2 buffer 6))) - 3 2 nil nil) + (multiple-value-call + #'list + (buffer-re-search-forward a1 buffer 0) + (buffer-re-search-forward a2 buffer 1) + (buffer-re-search-forward a3 buffer 1) + (buffer-re-search-forward a1 buffer 4) + (buffer-re-search-forward a2 buffer 6) + (buffer-re-search-forward a3 buffer 6))) + (3 8 2 4 3 8 nil nil nil)) (defmultitest buffer-re-search-backward.test-1 (let ((buffer (make-instance %%buffer)) (a1 (climacs-base::reversed-deterministic-automaton (regexp-automaton (string-regexp "i[ma]+c")))) (a2 (climacs-base::reversed-deterministic-automaton - (regexp-automaton (string-regexp "[^aeiou][aeiou]"))))) + (regexp-automaton (string-regexp "[^aeiou][aeiou]")))) + (a3 (regexp-automaton (string-regexp "cami")))) (insert-buffer-sequence buffer 0 " climacs") - (values - (buffer-re-search-backward a1 buffer 7) - (buffer-re-search-backward a2 buffer 7) - (buffer-re-search-backward a1 buffer 5) - (buffer-re-search-backward a2 buffer 2))) - 3 4 nil nil) + (multiple-value-call + #'list + (buffer-re-search-backward a1 buffer 7) + (buffer-re-search-backward a2 buffer 7) + (buffer-re-search-backward a3 buffer 7) + (buffer-re-search-backward a1 buffer 5) + (buffer-re-search-backward a2 buffer 2) + (buffer-re-search-backward a3 buffer 5))) + (3 7 4 6 3 7 nil nil nil)) (defmultitest search-forward.test-1 (let ((buffer (make-instance %%buffer))) Index: climacs/base.lisp diff -u climacs/base.lisp:1.44 climacs/base.lisp:1.45 --- climacs/base.lisp:1.44 Sat Aug 27 22:29:08 2005 +++ climacs/base.lisp Sun Aug 28 00:07:45 2005 @@ -624,13 +624,14 @@ returns nil. If the first value is non-nil, the second value is the offset after the matched contents." (if (automaton::singleton a) - (let ((result (buffer-search-forward buffer offset (automaton::singleton a)))) + (let ((result (buffer-search-forward + buffer offset (automaton::singleton a)))) (when result (values result (+ result (length (automaton::singleton a)))))) (loop for i from offset below (size buffer) do (let ((j (non-greedy-match-forward a buffer i))) (when j (return (values i j)))) - finally (return nil)))) + finally (return nil)))) (defun reversed-deterministic-automaton (a) "Reverses and determinizes A, then returns it." @@ -659,13 +660,14 @@ otherwise, returns nil. If the first value is non-nil, the second value is the offset after the matched contents." (if (automaton::singleton a) - (let ((result (buffer-search-backward buffer offset - (nreverse (automaton::singleton a))))) - (values result result)) + (let ((result (buffer-search-backward + buffer offset (nreverse (automaton::singleton a))))) + (when result + (values result (+ result (length (automaton::singleton a)))))) (loop for i downfrom (min offset (1- (size buffer))) to 0 do (let ((j (non-greedy-match-backward a buffer i))) - (when j (return (values j i)))) - finally (return nil)))) + (when j (return (values j (1+ i))))) + finally (return nil)))) (defun search-forward (mark vector &key (test #'eql)) "move MARK forward after the first occurence of VECTOR after MARK" @@ -699,7 +701,7 @@ (automaton::regexp-automaton (automaton::string-regexp re))))) (multiple-value-bind (i j) - (buffer-re-search-backward a (buffer mark) (offset mark)) + (buffer-re-search-backward a (buffer mark) (1- (offset mark))) (declare (ignorable j)) (when i (setf (offset mark) i)))))

1 0

[climacs-cvs] CVS update: climacs/base.lisp
by abakic＠common-lisp.net 27 Aug '05

27 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3005 Modified Files: base.lisp Log Message: A minor bug fix. Date: Sat Aug 27 22:29:09 2005 Author: abakic Index: climacs/base.lisp diff -u climacs/base.lisp:1.43 climacs/base.lisp:1.44 --- climacs/base.lisp:1.43 Thu Aug 25 09:48:13 2005 +++ climacs/base.lisp Sat Aug 27 22:29:08 2005 @@ -625,7 +625,8 @@ offset after the matched contents." (if (automaton::singleton a) (let ((result (buffer-search-forward buffer offset (automaton::singleton a)))) - (values result (+ result (length (automaton::singleton a))))) + (when result + (values result (+ result (length (automaton::singleton a)))))) (loop for i from offset below (size buffer) do (let ((j (non-greedy-match-forward a buffer i))) (when j (return (values i j))))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by dmurray＠common-lisp.net 25 Aug '05

25 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv9849 Modified Files: gui.lisp Log Message: Removed debugging message. Date: Thu Aug 25 10:43:55 2005 Author: dmurray Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.182 climacs/gui.lisp:1.183 --- climacs/gui.lisp:1.182 Thu Aug 25 09:48:13 2005 +++ climacs/gui.lisp Thu Aug 25 10:43:55 2005 @@ -962,9 +962,7 @@ :prompt "Kill buffer" :default (buffer (current-window)) :default-type 'buffer))) - (format *trace-output* "Here: ~a~%" buffer) (finish-output *trace-output*) (kill-buffer buffer))) - (define-named-command com-full-redisplay () (full-redisplay (current-window)))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/delegating-buffer.lisp climacs/base.lisp
by dmurray＠common-lisp.net 25 Aug '05

25 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv6818 Modified Files: gui.lisp delegating-buffer.lisp base.lisp Log Message: Added dead-escape #\x back to global-climacs-table. Added com-regex-search and com-regex-search-forward to let people experiment with the cl-automaton regex facility. Date: Thu Aug 25 09:48:13 2005 Author: dmurray Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.181 climacs/gui.lisp:1.182 --- climacs/gui.lisp:1.181 Sat Aug 20 21:44:08 2005 +++ climacs/gui.lisp Thu Aug 25 09:48:13 2005 @@ -1956,6 +1956,8 @@ (add-command-to-command-table command 'dead-escape-climacs-table :keystroke gesture :errorp nil)) +(dead-escape-set-key '(#\x) 'esa::com-extended-command) + (defun global-set-key (gesture command) (add-command-to-command-table command 'global-climacs-table :keystroke gesture :errorp nil) @@ -2270,3 +2272,16 @@ (c-c-set-key '(#\l :control) 'com-load-file) +(define-named-command com-regex-search-forward () + (let ((string (accept 'string :prompt "RE search" + :delimiter-gestures nil + :activation-gestures + '(:newline :return)))) + (re-search-forward (point (current-window)) string))) + +(define-named-command com-regex-search-backward () + (let ((string (accept 'string :prompt "RE search backward" + :delimiter-gestures nil + :activation-gestures + '(:newline :return)))) + (re-search-backward (point (current-window)) string))) Index: climacs/delegating-buffer.lisp diff -u climacs/delegating-buffer.lisp:1.4 climacs/delegating-buffer.lisp:1.5 --- climacs/delegating-buffer.lisp:1.4 Sun Feb 27 22:21:51 2005 +++ climacs/delegating-buffer.lisp Thu Aug 25 09:48:13 2005 @@ -69,4 +69,4 @@ (buffer-line-number (implementation buffer) offset)) (defmethod buffer-column-number ((buffer delegating-buffer) offset) - (buffer-column-number (implementation buffer) offset)) \ No newline at end of file + (buffer-column-number (implementation buffer) offset)) Index: climacs/base.lisp diff -u climacs/base.lisp:1.42 climacs/base.lisp:1.43 --- climacs/base.lisp:1.42 Tue Aug 9 17:18:25 2005 +++ climacs/base.lisp Thu Aug 25 09:48:13 2005 @@ -624,11 +624,12 @@ returns nil. If the first value is non-nil, the second value is the offset after the matched contents." (if (automaton::singleton a) - (buffer-search-forward buffer offset (automaton::singleton a)) + (let ((result (buffer-search-forward buffer offset (automaton::singleton a)))) + (values result (+ result (length (automaton::singleton a))))) (loop for i from offset below (size buffer) do - (let ((j (non-greedy-match-forward a buffer i))) - (when j (return (values i j)))) - finally (return nil)))) + (let ((j (non-greedy-match-forward a buffer i))) + (when j (return (values i j)))) + finally (return nil)))) (defun reversed-deterministic-automaton (a) "Reverses and determinizes A, then returns it." @@ -657,11 +658,13 @@ otherwise, returns nil. If the first value is non-nil, the second value is the offset after the matched contents." (if (automaton::singleton a) - (buffer-search-backward buffer offset (automaton::singleton a)) + (let ((result (buffer-search-backward buffer offset + (nreverse (automaton::singleton a))))) + (values result result)) (loop for i downfrom (min offset (1- (size buffer))) to 0 do - (let ((j (non-greedy-match-backward a buffer i))) - (when j (return (values j i)))) - finally (return nil)))) + (let ((j (non-greedy-match-backward a buffer i))) + (when j (return (values j i)))) + finally (return nil)))) (defun search-forward (mark vector &key (test #'eql)) "move MARK forward after the first occurence of VECTOR after MARK"

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by dmurray＠common-lisp.net 20 Aug '05

20 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22657 Modified Files: gui.lisp Log Message: Fix isearch bug (introduced earlier), futzed with modeline format string, added default to Kill Buffer. Date: Sat Aug 20 21:44:09 2005 Author: dmurray Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.180 climacs/gui.lisp:1.181 --- climacs/gui.lisp:1.180 Fri Aug 19 11:12:48 2005 +++ climacs/gui.lisp Sat Aug 20 21:44:08 2005 @@ -111,8 +111,18 @@ (size (size buf)) (top (top master-pane)) (bot (bot master-pane)) - (name-info (format nil " ~a ~a~:[~30t~a~;~*~] ~:[(~;Syntax: ~]~a~a~a~a~:[)~;~] ~a" - (cond ((needs-saving buf) "**") + (name-info (format nil "~3T~A~ + ~3@T~A~ + ~:[~30T~A~;~*~]~ + ~3@T~:[(~;Syntax: ~]~ + ~A~ + ~{~:[~*~; ~A~]~}~ + ~:[)~;~]~ + ~3@T~A" + (cond ((and (needs-saving buf) + (read-only-p buf) + "%*")) + ((needs-saving buf) "**") ((read-only-p buf) "%%") (t "--")) (name buf) @@ -129,15 +139,13 @@ size)))))) *with-scrollbars* (name (syntax buf)) - (if (slot-value master-pane 'overwrite-mode) - " Ovwrt" - "") - (if (auto-fill-mode master-pane) - " Fill" - "") - (if (isearch-mode master-pane) - " Isearch" - "") + (list + (slot-value master-pane 'overwrite-mode) + "Ovwrt" + (auto-fill-mode master-pane) + "Fill" + (isearch-mode master-pane) + "Isearch") *with-scrollbars* (if (recordingp *application-frame*) "Def" @@ -620,15 +628,25 @@ collect (list (subseq (namestring name) length nil) name)))))))) +(define-presentation-method present (object (type completable-pathname) + stream (view textual-view) + &key acceptably for-context-type) + (declare (ignore acceptably for-context-type)) + (princ (namestring object) stream)) + (define-presentation-method accept - ((type completable-pathname) stream (view textual-view) &key) + ((type completable-pathname) stream (view textual-view) &key (default nil defaultp) + (default-type type)) (multiple-value-bind (pathname success string) (complete-input stream #'filename-completer :allow-any-input t) - (if success - (values pathname 'completable-pathname) - (values string 'string)))) + (cond (success + (values pathname type)) + ((and (zerop (length string)) + defaultp) + (values default default-type)) + (t (values string 'string))))) (defun filepath-filename (pathname) (if (null (pathname-type pathname)) @@ -661,7 +679,10 @@ buffer)) (defun find-file (filepath) - (cond ((directory-pathname-p filepath) + (cond ((null filepath) + (display-message "No file name given.") + (beep)) + ((directory-pathname-p filepath) (display-message "~A is a directory name." filepath) (beep)) (t @@ -690,17 +711,20 @@ buffer)))))) (define-named-command com-find-file () - (let ((filepath (accept 'completable-pathname - :prompt "Find File"))) + (let* ((filepath (accept 'completable-pathname + :prompt "Find File"))) (find-file filepath))) (defun find-file-read-only (filepath) - (cond ((directory-pathname-p filepath) + (cond ((null filepath) + (display-message "No file name given.") + (beep)) + ((directory-pathname-p filepath) (display-message "~A is a directory name." filepath) (beep)) (t (let ((existing-buffer (find filepath (buffers *application-frame*) - :key #'filepath :test #'equal))) + :key #'filepath :test #'equal))) (if (and existing-buffer (read-only-p existing-buffer)) (switch-to-buffer existing-buffer) (if (probe-file filepath) @@ -853,8 +877,16 @@ (needs-saving buffer) nil) (display-message "Wrote: ~a" (filepath buffer)))))) +(define-presentation-method present (object (type buffer) + stream + (view textual-view) + &key acceptably for-context-type) + (declare (ignore acceptably for-context-type)) + (princ (name object) stream)) + (define-presentation-method accept - ((type buffer) stream (view textual-view) &key) + ((type buffer) stream (view textual-view) &key (default nil defaultp) + (default-type type)) (multiple-value-bind (object success string) (complete-input stream (lambda (so-far action) @@ -864,8 +896,11 @@ :value-key #'identity)) :partial-completers '(#\Space) :allow-any-input t) - (declare (ignore success)) - (or object string))) + (cond (success + (values object type)) + ((and (zerop (length string)) defaultp) + (values default default-type)) + (t (values string 'string))))) (defgeneric switch-to-buffer (buffer)) @@ -893,7 +928,9 @@ (define-named-command com-switch-to-buffer () (let ((buffer (accept 'buffer - :prompt "Switch to buffer"))) + :prompt "Switch to buffer" + :default (second (buffers *application-frame*)) + :default-type 'buffer))) (switch-to-buffer buffer))) (defgeneric kill-buffer (buffer)) @@ -921,7 +958,13 @@ (kill-buffer (buffer (current-window)))) (define-named-command com-kill-buffer () - (kill-buffer (buffer (current-window)))) + (let ((buffer (accept 'buffer + :prompt "Kill buffer" + :default (buffer (current-window)) + :default-type 'buffer))) + (format *trace-output* "Here: ~a~%" buffer) (finish-output *trace-output*) + (kill-buffer buffer))) + (define-named-command com-full-redisplay () (full-redisplay (current-window))) @@ -1388,7 +1431,7 @@ :keystroke gesture :errorp nil)) (loop for code from (char-code #\Space) to (char-code #\~) - do (isearch-set-key (code-char code) 'com-append-char)) + do (isearch-set-key (code-char code) 'com-isearch-append-char)) (isearch-set-key '(#\Newline) 'com-isearch-exit) (isearch-set-key '(#\Backspace) 'com-isearch-delete-char)

1 0

[climacs-cvs] CVS update: climacs/pane.lisp climacs/packages.lisp climacs/gui.lisp
by dmurray＠common-lisp.net 19 Aug '05

19 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv14566 Modified Files: pane.lisp packages.lisp gui.lisp Log Message: Added read-only buffers, com-find-file-read-only (C-x C-r), com-toggle-read-only (C-x C-q) and "%%" display in mode line. Date: Fri Aug 19 11:12:49 2005 Author: dmurray Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.29 climacs/pane.lisp:1.30 --- climacs/pane.lisp:1.29 Tue Aug 16 01:31:22 2005 +++ climacs/pane.lisp Fri Aug 19 11:12:48 2005 @@ -176,6 +176,47 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Readonly + +(defclass read-only-mixin () + ((read-only-p :initform nil :accessor read-only-p))) + +(define-condition buffer-read-only (simple-error) + ((buffer :reader condition-buffer :initarg :buffer)) + (:report (lambda (condition stream) + (format stream "Attempt to change read only buffer: ~a" + (condition-buffer condition)))) + (:documentation "This condition is signalled whenever an attempt +is made to alter a buffer which has been set read only.")) + +(defmethod insert-buffer-object ((buffer read-only-mixin) offset object) + (if (read-only-p buffer) + (error 'buffer-read-only :buffer buffer) + (call-next-method))) + +(defmethod insert-buffer-sequence ((buffer read-only-mixin) offset sequence) + (if (read-only-p buffer) + (error 'buffer-read-only :buffer buffer) + (call-next-method))) + +(defmethod delete-buffer-range ((buffer read-only-mixin) offset n) + (if (read-only-p buffer) + (error 'buffer-read-only :buffer buffer) + (call-next-method))) + +(defmethod (setf buffer-object) (object (buffer read-only-mixin) offset) + (if (read-only-p buffer) + (error 'buffer-read-only :buffer buffer) + (call-next-method))) + +(defmethod read-only-p ((buffer delegating-buffer)) + (read-only-p (implementation buffer))) + +(defmethod (setf read-only-p) (flag (buffer delegating-buffer)) + (setf (read-only-p (implementation buffer)) flag)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; View (defclass climacs-textual-view (textual-view tabify-mixin) @@ -186,10 +227,10 @@ ;(defgeneric indent-tabs-mode (climacs-buffer)) -(defclass extended-standard-buffer (standard-buffer undo-mixin abbrev-mixin) () +(defclass extended-standard-buffer (read-only-mixin standard-buffer undo-mixin abbrev-mixin) () (:documentation "Extensions accessible via marks.")) -(defclass extended-binseq2-buffer (binseq2-buffer p-undo-mixin abbrev-mixin) () +(defclass extended-binseq2-buffer (read-only-mixin binseq2-buffer p-undo-mixin abbrev-mixin) () (:documentation "Extensions accessible via marks.")) (defclass climacs-buffer (delegating-buffer filepath-mixin name-mixin) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.78 climacs/packages.lisp:1.79 --- climacs/packages.lisp:1.78 Wed Aug 17 01:10:29 2005 +++ climacs/packages.lisp Fri Aug 19 11:12:48 2005 @@ -140,6 +140,7 @@ (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax :flexichain :undo) (:export #:climacs-buffer #:needs-saving #:filepath + #:read-only-p #:buffer-read-only #:climacs-pane #:point #:mark #:redisplay-pane #:full-redisplay #:display-cursor Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.179 climacs/gui.lisp:1.180 --- climacs/gui.lisp:1.179 Thu Aug 18 22:44:48 2005 +++ climacs/gui.lisp Fri Aug 19 11:12:48 2005 @@ -112,7 +112,9 @@ (top (top master-pane)) (bot (bot master-pane)) (name-info (format nil " ~a ~a~:[~30t~a~;~*~] ~:[(~;Syntax: ~]~a~a~a~a~:[)~;~] ~a" - (if (needs-saving buf) "**" "--") + (cond ((needs-saving buf) "**") + ((read-only-p buf) "%%") + (t "--")) (name buf) *with-scrollbars* (cond ((and (mark= size bot) @@ -168,7 +170,9 @@ (no-expression () (beep) (display-message "No expression around point")) (no-such-operation () - (beep) (display-message "Operation unavailable for syntax")))) + (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) @@ -656,31 +660,80 @@ (push buffer (buffers *application-frame*)) buffer)) +(defun find-file (filepath) + (cond ((directory-pathname-p filepath) + (display-message "~A is a directory name." filepath) + (beep)) + (t + (let ((existing-buffer (find filepath (buffers *application-frame*) + :key #'filepath :test #'equal))) + (if existing-buffer + (switch-to-buffer existing-buffer) + (let ((buffer (make-buffer)) + (pane (current-window))) + (setf (offset (point (buffer pane))) (offset (point pane))) + (setf (buffer (current-window)) buffer) + (setf (syntax buffer) + (make-instance (syntax-class-name-for-filepath filepath) + :buffer (buffer (point pane)))) + ;; Don't want to create the file if it doesn't exist. + (when (probe-file filepath) + (with-open-file (stream filepath :direction :input) + (input-from-stream stream buffer 0))) + (setf (filepath buffer) filepath + (name buffer) (filepath-filename filepath) + (needs-saving buffer) nil) + (beginning-of-buffer (point pane)) + ;; this one is needed so that the buffer modification protocol + ;; resets the low and high marks after redisplay + (redisplay-frame-panes *application-frame*) + buffer)))))) + (define-named-command com-find-file () (let ((filepath (accept 'completable-pathname :prompt "Find File"))) - (cond ((directory-pathname-p filepath) - (display-message "~A is a directory name." filepath) - (beep)) - (t - (let ((buffer (make-buffer)) - (pane (current-window))) - (setf (offset (point (buffer pane))) (offset (point pane))) - (setf (buffer (current-window)) buffer) - (setf (syntax buffer) - (make-instance (syntax-class-name-for-filepath filepath) - :buffer (buffer (point pane)))) - ;; Don't want to create the file if it doesn't exist. - (when (probe-file filepath) - (with-open-file (stream filepath :direction :input) - (input-from-stream stream buffer 0))) - (setf (filepath buffer) filepath - (name buffer) (filepath-filename filepath) - (needs-saving buffer) nil) - (beginning-of-buffer (point pane)) - ;; this one is needed so that the buffer modification protocol - ;; resets the low and high marks after redisplay - (redisplay-frame-panes *application-frame*)))))) + (find-file filepath))) + +(defun find-file-read-only (filepath) + (cond ((directory-pathname-p filepath) + (display-message "~A is a directory name." filepath) + (beep)) + (t + (let ((existing-buffer (find filepath (buffers *application-frame*) + :key #'filepath :test #'equal))) + (if (and existing-buffer (read-only-p existing-buffer)) + (switch-to-buffer existing-buffer) + (if (probe-file filepath) + (let ((buffer (make-buffer)) + (pane (current-window))) + (setf (offset (point (buffer pane))) (offset (point pane))) + (setf (buffer (current-window)) buffer) + (setf (syntax buffer) + (make-instance (syntax-class-name-for-filepath filepath) + :buffer (buffer (point pane)))) + (with-open-file (stream filepath :direction :input) + (input-from-stream stream buffer 0)) + (setf (filepath buffer) filepath + (name buffer) (filepath-filename filepath) + (needs-saving buffer) nil + (read-only-p buffer) t) + (beginning-of-buffer (point pane)) + ;; this one is needed so that the buffer modification protocol + ;; resets the low and high marks after redisplay + (redisplay-frame-panes *application-frame*) + buffer) + (progn + (display-message "No such file: ~A" filepath) + (beep) + nil))))))) + +(define-named-command com-find-file-read-only () + (let ((filepath (accept 'completable-pathname :Prompt "Find file read only"))) + (find-file-read-only filepath))) + +(define-named-command com-toggle-read-only () + (let ((buffer (buffer (current-window)))) + (setf (read-only-p buffer) (not (read-only-p buffer))))) (defun set-visited-file-name (filename buffer) (setf (filepath buffer) filename @@ -825,7 +878,8 @@ (push buffer (buffers *application-frame*))) (setf (offset (point (buffer pane))) (offset (point pane))) (setf (buffer pane) buffer) - (full-redisplay pane))) + (full-redisplay pane) + buffer)) (defmethod switch-to-buffer ((name string)) (let ((buffer (find name (buffers *application-frame*) @@ -1977,6 +2031,8 @@ (c-x-set-key '(#\3) 'com-split-window-horizontally) (c-x-set-key '(#\b) 'com-switch-to-buffer) (c-x-set-key '(#\f :control) 'com-find-file) +(c-x-set-key '(#\r :control) 'com-find-file-read-only) +(c-x-set-key '(#\q :control) 'com-toggle-read-only) (c-x-set-key '(#\f) `(com-set-fill-column ,*numeric-argument-marker*)) (c-x-set-key '(#\h) 'com-mark-whole-buffer) (c-x-set-key '(#\i) 'com-insert-file)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by dmurray＠common-lisp.net 18 Aug '05

18 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29204 Modified Files: gui.lisp Log Message: Add com-set-visited-file-name, com-revert-buffer, backups ("file.foo~") when saving existing files, some more file/directory checks. Also fixed some problems I introduced last time. (erase-buffer is v. slow.) Date: Thu Aug 18 22:44:48 2005 Author: dmurray Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.178 climacs/gui.lisp:1.179 --- climacs/gui.lisp:1.178 Wed Aug 17 01:10:29 2005 +++ climacs/gui.lisp Thu Aug 18 22:44:48 2005 @@ -622,12 +622,9 @@ (complete-input stream #'filename-completer :allow-any-input t) -; (declare (ignore success)) -; (or pathname string))) (if success - (values pathname 'pathname) + (values pathname 'completable-pathname) (values string 'string)))) - (defun filepath-filename (pathname) (if (null (pathname-type pathname)) @@ -653,6 +650,12 @@ (and (or (null name) (eql name :unspecific)) (or (null type) (eql type :unspecific))))) +(defun make-buffer (&optional name) + (let ((buffer (make-instance 'climacs-buffer))) + (when name (setf (name buffer) name)) + (push buffer (buffers *application-frame*)) + buffer)) + (define-named-command com-find-file () (let ((filepath (accept 'completable-pathname :prompt "Find File"))) @@ -660,10 +663,9 @@ (display-message "~A is a directory name." filepath) (beep)) (t - (let ((buffer (make-instance 'climacs-buffer)) + (let ((buffer (make-buffer)) (pane (current-window))) (setf (offset (point (buffer pane))) (offset (point pane))) - (push buffer (buffers *application-frame*)) (setf (buffer (current-window)) buffer) (setf (syntax buffer) (make-instance (syntax-class-name-for-filepath filepath) @@ -680,6 +682,15 @@ ;; resets the low and high marks after redisplay (redisplay-frame-panes *application-frame*)))))) +(defun set-visited-file-name (filename buffer) + (setf (filepath buffer) filename + (name buffer) (filepath-filename filename) + (needs-saving buffer) t)) + +(define-named-command com-set-visited-file-name () + (let ((filename (accept 'completable-pathname :prompt "New file name"))) + (set-visited-file-name filename (buffer (current-window))))) + (define-named-command com-insert-file () (let ((filename (accept 'completable-pathname :prompt "Insert File")) @@ -694,6 +705,40 @@ (offset (point pane)) (offset (mark pane)))) (redisplay-frame-panes *application-frame*))) +(defgeneric erase-buffer (buffer)) + +(defmethod erase-buffer ((buffer string)) + (let ((b (find buffer (buffers *application-frame*) + :key #'name :test #'string=))) + (when b (erase-buffer b)))) + +(defmethod erase-buffer ((buffer climacs-buffer)) + (let* ((point (point buffer)) + (mark (clone-mark point))) + (beginning-of-buffer mark) + (end-of-buffer point) + (delete-region mark point))) + +(define-named-command com-revert-buffer () + (let* ((pane (current-window)) + (buffer (buffer pane)) + (filepath (filepath buffer)) + (save (offset (point pane)))) + (when (accept 'boolean :prompt (format nil "Revert buffer from file ~A?" + (filepath buffer))) + (cond ((directory-pathname-p filepath) + (display-message "~A is a directory name." filepath) + (beep)) + ((probe-file filepath) + (erase-buffer buffer) + (with-open-file (stream filepath :direction :input) + (input-from-stream stream buffer 0)) + (setf (offset (point pane)) + (min (size buffer) save))) + (t + (display-message "No file ~A" filepath) + (beep)))))) + (defun save-buffer (buffer) (let ((filepath (or (filepath buffer) (accept 'completable-pathname @@ -703,6 +748,11 @@ (display-message "~A is a directory." filepath) (beep)) (t + (when (probe-file filepath) + (let ((backup-name (pathname-name filepath)) + (backup-type (concatenate 'string (pathname-type filepath) "~"))) + (rename-file filepath (make-pathname :name backup-name + :type backup-type)))) (with-open-file (stream filepath :direction :output :if-exists :supersede) (output-to-stream stream buffer 0 (size buffer))) (setf (filepath buffer) filepath @@ -772,7 +822,7 @@ (pane (current-window))) (if position (rotatef (car buffers) (nth position buffers)) - (push buffer buffers)) + (push buffer (buffers *application-frame*))) (setf (offset (point (buffer pane))) (offset (point pane))) (setf (buffer pane) buffer) (full-redisplay pane))) @@ -781,7 +831,7 @@ (let ((buffer (find name (buffers *application-frame*) :key #'name :test #'string=))) (switch-to-buffer (or buffer - (make-instance 'climacs-buffer :name name))))) + (make-buffer name))))) ;;placeholder (defmethod switch-to-buffer ((symbol (eql 'nil))) @@ -805,8 +855,7 @@ (setf buffers (remove buffer buffers)) ;; Always need one buffer. (when (null buffers) - (push (make-instance 'climacs-buffer :name "*scratch*") - buffers)) + (make-buffer "*scratch*")) (setf (buffer (current-window)) (car buffers)))) (defmethod kill-buffer ((name string)) @@ -1224,7 +1273,7 @@ (display-message "Isearch backward: ") (isearch-command-loop (current-window) nil)) -(define-command (com-append-char :name t :command-table isearch-climacs-table) () +(define-command (com-isearch-append-char :name t :command-table isearch-climacs-table) () (let* ((pane (current-window)) (states (isearch-states pane)) (string (concatenate 'string @@ -1236,7 +1285,7 @@ (incf (offset mark))) (isearch-from-mark pane mark string forwardp))) -(define-command (com-delete-char :name t :command-table isearch-climacs-table) () +(define-command (com-isearch-delete-char :name t :command-table isearch-climacs-table) () (let* ((pane (current-window))) (cond ((null (second (isearch-states pane))) (display-message "Isearch: ") @@ -1257,7 +1306,7 @@ (search-forward-p state) (search-string state))))))) -(define-command (com-forward :name t :command-table isearch-climacs-table) () +(define-command (com-isearch-search-forward :name t :command-table isearch-climacs-table) () (let* ((pane (current-window)) (point (point pane)) (states (isearch-states pane)) @@ -1267,7 +1316,7 @@ (mark (clone-mark point))) (isearch-from-mark pane mark string t))) -(define-command (com-backward :name t :command-table isearch-climacs-table) () +(define-command (com-isearch-search-backward :name t :command-table isearch-climacs-table) () (let* ((pane (current-window)) (point (point pane)) (states (isearch-states pane)) @@ -1277,7 +1326,7 @@ (mark (clone-mark point))) (isearch-from-mark pane mark string nil))) -(define-command (com-exit :name t :command-table isearch-climacs-table) () +(define-command (com-isearch-exit :name t :command-table isearch-climacs-table) () (setf (isearch-mode (current-window)) nil)) (defun isearch-set-key (gesture command) @@ -1287,10 +1336,10 @@ (loop for code from (char-code #\Space) to (char-code #\~) do (isearch-set-key (code-char code) 'com-append-char)) -(isearch-set-key '(#\Newline) 'com-exit) -(isearch-set-key '(#\Backspace) 'com-delete-char) -(isearch-set-key '(#\s :control) 'com-forward) -(isearch-set-key '(#\r :control) 'com-backward) +(isearch-set-key '(#\Newline) 'com-isearch-exit) +(isearch-set-key '(#\Backspace) 'com-isearch-delete-char) +(isearch-set-key '(#\s :control) 'com-isearch-search-forward) +(isearch-set-key '(#\r :control) 'com-isearch-search-backward) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -1349,7 +1398,7 @@ ((setf (query-replace-mode pane) nil)))) (display-message "Replaced ~A occurrence~:P" occurrences))) -(define-command (com-replace :name t :command-table query-replace-climacs-table) () +(define-command (com-query-replace-replace :name t :command-table query-replace-climacs-table) () (declare (special string1 string2 occurrences)) (let* ((pane (current-window)) (point (point pane)) @@ -1373,7 +1422,7 @@ string1 string2) (setf (query-replace-mode pane) nil)))) -(define-command (com-skip :name t :command-table query-replace-climacs-table) () +(define-command (com-query-replace-skip :name t :command-table query-replace-climacs-table) () (declare (special string1 string2)) (let* ((pane (current-window)) (point (point pane))) @@ -1382,20 +1431,20 @@ string1 string2) (setf (query-replace-mode pane) nil)))) -(define-command (com-exit :name t :command-table query-replace-climacs-table) () +(define-command (com-query-replace-exit :name t :command-table query-replace-climacs-table) () (setf (query-replace-mode (current-window)) nil)) (defun query-replace-set-key (gesture command) (add-command-to-command-table command 'query-replace-climacs-table :keystroke gesture :errorp nil)) -(query-replace-set-key '(#\Newline) 'com-exit) -(query-replace-set-key '(#\Space) 'com-replace) -(query-replace-set-key '(#\Backspace) 'com-skip) -(query-replace-set-key '(#\Rubout) 'com-skip) -(query-replace-set-key '(#\q) 'com-exit) -(query-replace-set-key '(#\y) 'com-replace) -(query-replace-set-key '(#\n) 'com-skip) +(query-replace-set-key '(#\Newline) 'com-query-replace-exit) +(query-replace-set-key '(#\Space) 'com-query-replace-replace) +(query-replace-set-key '(#\Backspace) 'com-query-replace-skip) +(query-replace-set-key '(#\Rubout) 'com-query-replace-skip) +(query-replace-set-key '(#\q) 'com-query-replace-exit) +(query-replace-set-key '(#\y) 'com-query-replace-replace) +(query-replace-set-key '(#\n) 'com-query-replace-skip) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -2121,3 +2170,4 @@ :keystroke gesture :errorp nil)) (c-c-set-key '(#\l :control) 'com-load-file) +

1 0

[climacs-cvs] CVS update: climacs/lisp-syntax.lisp
by dmurray＠common-lisp.net 18 Aug '05

18 Aug '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv26118 Modified Files: lisp-syntax.lisp Log Message: Fixed small bug in reparsing algorithm. Date: Thu Aug 18 21:49:02 2005 Author: dmurray Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.32 climacs/lisp-syntax.lisp:1.33 --- climacs/lisp-syntax.lisp:1.32 Tue Aug 16 01:31:22 2005 +++ climacs/lisp-syntax.lisp Thu Aug 18 21:49:01 2005 @@ -979,9 +979,9 @@ (find-first-potentially-valid-lexeme (cdr parse-trees) offset)) ((not (typep (car parse-trees) 'lexeme)) (find-first-potentially-valid-lexeme (children (car parse-trees)) offset)) - ((< (start-offset (car parse-trees)) offset) + ((<= (start-offset (car parse-trees)) offset) (loop with tree = (next-tree (car parse-trees)) - until (or (null tree) (>= (start-offset tree) offset)) + until (or (null tree) (> (start-offset tree) offset)) do (setf tree (next-tree tree)) finally (return tree))) (t (car parse-trees)))) @@ -990,7 +990,7 @@ (and (eq (class-of tree1) (class-of tree2)) (eq (parser-state tree1) (parser-state tree2)) (= (end-offset tree1) (end-offset tree2)))) - + (defmethod print-object ((mark mark) stream) (print-unreadable-object (mark stream :type t :identity t) (format stream "~s" (offset mark))))

1 0