climacs-cvs
Threads by month
- ----- 2025 -----
- February
- January
- ----- 2024 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2023 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2022 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2021 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2020 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2019 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2018 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2017 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2016 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2015 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2014 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2013 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2012 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2011 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2010 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2009 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2008 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2007 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2006 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2005 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2004 -----
- December
- 847 discussions
01 Sep '05
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv4017
Modified Files:
esa.lisp gui.lisp
Log Message:
Manually substituted all occasions of the following abbreviations:
int -> minibuffer (sic! See below)
win -> window
buf -> buffer
This is no assembler, right? We have more than three letters for symbols.
> Robert Strandh wrote:
> > Max-Gerd Retzlaff writes:
> > Okay, that's all. Only one question left: Why is the variable in the
> > DEFINE-APPLICATION-FRAME form that holds the minibuffer-pane called
> > "int"? What is the meaning of "int"? I don't get it.
>
> *blush* it used to be for "interactor". Feel free to rename it.
Date: Thu Sep 1 03:05:51 2005
Author: mretzlaff
Index: climacs/esa.lisp
diff -u climacs/esa.lisp:1.14 climacs/esa.lisp:1.15
--- climacs/esa.lisp:1.14 Tue Aug 30 19:28:52 2005
+++ climacs/esa.lisp Thu Sep 1 03:05:51 2005
@@ -423,7 +423,7 @@
esa-frame-mixin)
()
(:panes
- (win (let* ((my-pane
+ (window (let* ((my-pane
(make-pane 'example-pane
:width 900 :height 400
:display-function 'display-my-pane
@@ -437,12 +437,12 @@
(scrolling ()
my-pane)
my-info-pane)))
- (int (make-pane 'example-minibuffer-pane :width 900)))
+ (minibuffer (make-pane 'example-minibuffer-pane :width 900)))
(:layouts
(default
(vertically (:scroll-bars nil)
- win
- int)))
+ window
+ minibuffer)))
(:top-level (esa-top-level)))
(defun display-my-pane (frame pane)
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.185 climacs/gui.lisp:1.186
--- climacs/gui.lisp:1.185 Thu Sep 1 02:21:08 2005
+++ climacs/gui.lisp Thu Sep 1 03:05:51 2005
@@ -59,12 +59,12 @@
(:command-table (global-climacs-table :inherit-from (global-esa-table)))
(:menu-bar nil)
(:panes
- (win (let* ((extended-pane
+ (window (let* ((extended-pane
(make-pane 'extended-pane
:width 900 :height 400
:end-of-line-action :scroll
:incremental-redisplay t
- :display-function 'display-win
+ :display-function 'display-window
:command-table 'global-climacs-table))
(info-pane
(make-pane 'climacs-info-pane
@@ -79,12 +79,12 @@
extended-pane)
extended-pane)
info-pane)))
- (int (make-pane 'climacs-minibuffer-pane :width 900)))
+ (minibuffer (make-pane 'climacs-minibuffer-pane :width 900)))
(:layouts
(default
(vertically (:scroll-bars nil)
- win
- int)))
+ window
+ minibuffer)))
(:top-level (esa-top-level)))
(defun current-window ()
@@ -112,8 +112,8 @@
(defun display-info (frame pane)
(declare (ignore frame))
(let* ((master-pane (master-pane pane))
- (buf (buffer master-pane))
- (size (size buf))
+ (buffer (buffer master-pane))
+ (size (size buffer))
(top (top master-pane))
(bot (bot master-pane))
(name-info (format nil "~3T~A~
@@ -124,13 +124,13 @@
~{~:[~*~; ~A~]~}~
~:[)~;~]~
~3@T~A"
- (cond ((and (needs-saving buf)
- (read-only-p buf)
+ (cond ((and (needs-saving buffer)
+ (read-only-p buffer)
"%*"))
- ((needs-saving buf) "**")
- ((read-only-p buf) "%%")
+ ((needs-saving buffer) "**")
+ ((read-only-p buffer) "%%")
(t "--"))
- (name buf)
+ (name buffer)
*with-scrollbars*
(cond ((and (mark= size bot)
(mark= 0 top))
@@ -143,7 +143,7 @@
(round (* 100 (/ (offset top)
size))))))
*with-scrollbars*
- (name (syntax buf))
+ (name (syntax buffer))
(list
(slot-value master-pane 'overwrite-mode)
"Ovwrt"
@@ -157,7 +157,7 @@
""))))
(princ name-info pane)))
-(defun display-win (frame pane)
+(defun display-window (frame pane)
"The display function used by the climacs application frame."
(declare (ignore frame))
(redisplay-pane pane (eq pane (current-window))))
@@ -240,13 +240,13 @@
tab-width))))))
(defun insert-character (char)
- (let* ((win (current-window))
- (point (point win)))
+ (let* ((window (current-window))
+ (point (point window)))
(unless (constituentp char)
(possibly-expand-abbrev point))
(when (whitespacep char)
(possibly-fill-line))
- (if (and (slot-value win 'overwrite-mode) (not (end-of-line-p point)))
+ (if (and (slot-value window 'overwrite-mode) (not (end-of-line-p point)))
(progn
(delete-range point)
(insert-object point char))
@@ -433,14 +433,14 @@
'((#\x :control) (#\t :control)))
(define-named-command com-previous-line ((numarg 'integer :prompt "How many lines?"))
- (let* ((win (current-window))
- (point (point win)))
- (unless (or (eq (previous-command win) 'com-previous-line)
- (eq (previous-command win) 'com-next-line))
- (setf (slot-value win 'goal-column) (column-number point)))
+ (let* ((window (current-window))
+ (point (point window)))
+ (unless (or (eq (previous-command window) 'com-previous-line)
+ (eq (previous-command window) 'com-next-line))
+ (setf (slot-value window 'goal-column) (column-number point)))
(if (plusp numarg)
- (previous-line point (slot-value win 'goal-column) numarg)
- (next-line point (slot-value win 'goal-column) (- numarg)))))
+ (previous-line point (slot-value window 'goal-column) numarg)
+ (next-line point (slot-value window 'goal-column) (- numarg)))))
(set-key `(com-previous-line ,*numeric-argument-marker*)
'global-climacs-table
@@ -451,14 +451,14 @@
'((:up)))
(define-named-command com-next-line ((numarg 'integer :prompt "How many lines?"))
- (let* ((win (current-window))
- (point (point win)))
- (unless (or (eq (previous-command win) 'com-previous-line)
- (eq (previous-command win) 'com-next-line))
- (setf (slot-value win 'goal-column) (column-number point)))
+ (let* ((window (current-window))
+ (point (point window)))
+ (unless (or (eq (previous-command window) 'com-previous-line)
+ (eq (previous-command window) 'com-next-line))
+ (setf (slot-value window 'goal-column) (column-number point)))
(if (plusp numarg)
- (next-line point (slot-value win 'goal-column) numarg)
- (previous-line point (slot-value win 'goal-column) (- numarg)))))
+ (next-line point (slot-value window 'goal-column) numarg)
+ (previous-line point (slot-value window 'goal-column) (- numarg)))))
(set-key `(com-next-line ,*numeric-argument-marker*)
'global-climacs-table
@@ -1357,10 +1357,10 @@
(let* ((extended-pane
(make-pane 'extended-pane
:width 900 :height 400
- :name 'win
+ :name 'window
:end-of-line-action :scroll
:incremental-redisplay t
- :display-function 'display-win
+ :display-function 'display-window
:command-table 'global-climacs-table))
(vbox
(vertically ()
@@ -1824,9 +1824,9 @@
;;; Dynamic abbrevs
(define-named-command com-dabbrev-expand ()
- (let* ((win (current-window))
- (point (point win)))
- (with-slots (original-prefix prefix-start-offset dabbrev-expansion-mark) win
+ (let* ((window (current-window))
+ (point (point window)))
+ (with-slots (original-prefix prefix-start-offset dabbrev-expansion-mark) window
(flet ((move () (cond ((beginning-of-buffer-p dabbrev-expansion-mark)
(setf (offset dabbrev-expansion-mark)
(offset point))
@@ -1836,7 +1836,7 @@
(t (forward-object dabbrev-expansion-mark)))))
(unless (or (beginning-of-buffer-p point)
(not (constituentp (object-before point))))
- (unless (and (eq (previous-command win) 'com-dabbrev-expand)
+ (unless (and (eq (previous-command window) 'com-dabbrev-expand)
(not (null prefix-start-offset)))
(setf dabbrev-expansion-mark (clone-mark point))
(backward-word dabbrev-expansion-mark)
1
0
[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/pane.lisp climacs/slidemacs-gui.lisp
by mretzlaff＠common-lisp.net 01 Sep '05
by mretzlaff＠common-lisp.net 01 Sep '05
01 Sep '05
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv963
Modified Files:
gui.lisp packages.lisp pane.lisp slidemacs-gui.lisp
Log Message:
The COMPLETABLE-PATHNAME class
This patch mainly removes the class COMPLETABLE-PATHNAME. There is
nothing special about those pathnames that make them completable. They
are just ordinary pathnames (no offence meant). Instead, the ACCEPT
and PRESENT method that formerly specialized on that presentation
type, specialize now on the ordinary PATHNAME class *and* on climacs'
custom view class CLIMACS-TEXTUAL-VIEW, that was already defined in
pane.lisp but was not yet used anywhere. (Robert Strandh accedes:
"I think it must have been meant for this kind of situation.")
The variable climacs-pane:+climacs-textual-view+ has been added, it
hold an instance of the class climacs-pane:climacs-textual-view, just
as there are such variables for the standard view classes (see clim
spec 23.6). Both symbols, #:climacs-textual-view and
#:+climacs-textual-view+, of the package CLIMACS-PANE are exported.
+climacs-textual-view+ is the :DEFAULT-VIEW for the class
CLIMACS-GUI::CLIMACS-MINIBUFFER-PANE now (set via the
:DEFAULT-INITARGS parameter of the class definition) so that the
aforementioned ACCEPT and PRESENT methods for pathnames are used in
the minibuffer. (See at the beginning of gui.lisp.)
The :DEFAULT-VIEW for the class CLIMACS-PANE:CLIMACS-PANE was not
specified in the same way, but in the :AFTER method of
(initialize-instance (pane climacs-pane)) via the line:
(setf (stream-default-view pane) (make-instance 'climacs-textual-view))
This is changed to be specified in the appropriate DEFCLASS form, as
well.
As the :DEFAULT-VIEW of the minibuffer is now changed, all the calls to
(accept 'completable-pathname :prompt "..")
are now substituted by just
(accept 'pathname :prompt "..")
without the need for explicit specification by use of the :VIEW
keyword. All these calls are changed, even the one in
slidemacs-gui.lisp.
(If we feel the need for a special view class for the info-pane
we can always subclass CLIMACS-MINIBUFFER-PANE later. Only the
:DEFAULT-VIEW inside the :DEFAULT-INITARGS argument has to be
changed then, if we do things correctly.)
The function CLIMACS-GUI:CLIMACS
I added the keywords NEW-PROCESS and PROCESS-NAME to the lambda-list
and the correspondent construct. You can now do
(climacs-gui:climacs :new-process t)
Just as it is possible with Clouseau and the Climacs-Listener.
CLIMACS-GUI:CLIMACS is also exported now. Why wasn't it before?
Some further comments, in case this message is not long enough for you,
can be found in the original mail in which I published my patch:
http://article.gmane.org/gmane.lisp.climacs.devel/264
Date: Thu Sep 1 02:21:09 2005
Author: mretzlaff
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.184 climacs/gui.lisp:1.185
--- climacs/gui.lisp:1.184 Tue Aug 30 19:28:52 2005
+++ climacs/gui.lisp Thu Sep 1 02:21:08 2005
@@ -47,7 +47,8 @@
(defclass climacs-minibuffer-pane (minibuffer-pane)
()
(:default-initargs
- :height 20 :max-height 20 :min-height 20))
+ :height 20 :max-height 20 :min-height 20
+ :default-view +climacs-textual-view+))
(defparameter *with-scrollbars* t
"If T, classic look and feel. If NIL, stripped-down look (:")
@@ -98,11 +99,15 @@
(loop for buffer in buffers
do (clear-modify buffer))))
-(defun climacs (&key (width 900) (height 400))
+(defun climacs (&key new-process (process-name "Climacs")
+ (width 900) (height 400))
"Starts up a climacs session"
- (let ((frame (make-application-frame
- 'climacs :width width :height height)))
- (run-frame-top-level frame)))
+ (let ((frame (make-application-frame 'climacs :width width :height height)))
+ (flet ((run ()
+ (run-frame-top-level frame)))
+ (if new-process
+ (clim-sys:make-process #'run :name process-name)
+ (run)))))
(defun display-info (frame pane)
(declare (ignore frame))
@@ -696,10 +701,6 @@
(set-key 'com-fill-paragraph 'global-climacs-table
'((#\q :meta)))
-(eval-when (:compile-toplevel :load-toplevel)
- (define-presentation-type completable-pathname ()
- :inherit-from 'pathname))
-
(defun filename-completer (so-far mode)
(flet ((remove-trail (s)
(subseq s 0 (let ((pos (position #\/ s :from-end t)))
@@ -768,15 +769,12 @@
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))
+(define-presentation-method present (object (type pathname)
+ stream (view climacs-textual-view) &key)
(princ (namestring object) stream))
-(define-presentation-method accept
- ((type completable-pathname) stream (view textual-view) &key (default nil defaultp)
- (default-type type))
+(define-presentation-method accept ((type pathname) stream (view climacs-textual-view)
+ &key (default nil defaultp) (default-type type))
(multiple-value-bind (pathname success string)
(complete-input stream
#'filename-completer
@@ -851,8 +849,7 @@
buffer))))))
(define-named-command com-find-file ()
- (let* ((filepath (accept 'completable-pathname
- :prompt "Find File")))
+ (let* ((filepath (accept 'pathname :prompt "Find File")))
(find-file filepath)))
(set-key 'com-find-file 'global-climacs-table
@@ -895,7 +892,7 @@
nil)))))))
(define-named-command com-find-file-read-only ()
- (let ((filepath (accept 'completable-pathname :Prompt "Find file read only")))
+ (let ((filepath (accept 'pathname :Prompt "Find file read only")))
(find-file-read-only filepath)))
(set-key 'com-find-file-read-only 'global-climacs-table
@@ -914,12 +911,11 @@
(needs-saving buffer) t))
(define-named-command com-set-visited-file-name ()
- (let ((filename (accept 'completable-pathname :prompt "New file name")))
+ (let ((filename (accept '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"))
+ (let ((filename (accept 'pathname :prompt "Insert File"))
(pane (current-window)))
(when (probe-file filename)
(setf (mark pane) (clone-mark (point pane) :left))
@@ -970,8 +966,7 @@
(defun save-buffer (buffer)
(let ((filepath (or (filepath buffer)
- (accept 'completable-pathname
- :prompt "Save Buffer to File"))))
+ (accept 'pathname :prompt "Save Buffer to File"))))
(cond
((directory-pathname-p filepath)
(display-message "~A is a directory." filepath)
@@ -1018,8 +1013,7 @@
(call-next-method)))
(define-named-command com-write-buffer ()
- (let ((filepath (accept 'completable-pathname
- :prompt "Write Buffer to File"))
+ (let ((filepath (accept 'pathname :prompt "Write Buffer to File"))
(buffer (buffer (current-window))))
(cond
((directory-pathname-p filepath)
@@ -1146,8 +1140,7 @@
(beep))))))
(define-named-command com-load-file ()
- (let ((filepath (accept 'completable-pathname
- :prompt "Load File")))
+ (let ((filepath (accept 'pathname :prompt "Load File")))
(load-file filepath)))
(set-key 'com-load-file 'global-climacs-table
Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.79 climacs/packages.lisp:1.80
--- climacs/packages.lisp:1.79 Fri Aug 19 11:12:48 2005
+++ climacs/packages.lisp Thu Sep 1 02:21:08 2005
@@ -157,7 +157,8 @@
#:query-replace-mode
#:mark-visible-p
#:with-undo
- #:url))
+ #:url
+ #:climacs-textual-view #:+climacs-textual-view+))
(defpackage :climacs-fundamental-syntax
(:use :clim-lisp :clim :climacs-buffer :climacs-base
@@ -197,5 +198,5 @@
(defpackage :climacs-gui
(:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax
:climacs-kill-ring :climacs-pane :clim-extensions :undo :esa)
- (:import-from :climacs-lisp-syntax :lisp-string))
-
+ (:import-from :climacs-lisp-syntax :lisp-string)
+ (:export :climacs))
Index: climacs/pane.lisp
diff -u climacs/pane.lisp:1.31 climacs/pane.lisp:1.32
--- climacs/pane.lisp:1.31 Sun Aug 28 15:57:33 2005
+++ climacs/pane.lisp Thu Sep 1 02:21:08 2005
@@ -222,6 +222,8 @@
(defclass climacs-textual-view (textual-view tabify-mixin)
())
+(defparameter +climacs-textual-view+ (make-instance 'climacs-textual-view))
+
(defclass filepath-mixin ()
((filepath :initform nil :accessor filepath)))
@@ -276,7 +278,10 @@
(full-redisplay-p :initform nil :accessor full-redisplay-p)
(cache :initform (let ((cache (make-instance 'standard-flexichain)))
(insert* cache 0 nil)
- cache))))
+ cache)))
+ (:default-initargs
+ :default-view +climacs-textual-view+))
+
(defmethod tab-width ((pane climacs-pane))
(tab-width (stream-default-view pane)))
@@ -295,7 +300,6 @@
(with-slots (buffer top bot scan) pane
(setf top (clone-mark (low-mark buffer) :left)
bot (clone-mark (high-mark buffer) :right)))
- (setf (stream-default-view pane) (make-instance 'climacs-textual-view))
(with-slots (space-width tab-width) (stream-default-view pane)
(let* ((medium (sheet-medium pane))
(style (medium-text-style medium)))
Index: climacs/slidemacs-gui.lisp
diff -u climacs/slidemacs-gui.lisp:1.17 climacs/slidemacs-gui.lisp:1.18
--- climacs/slidemacs-gui.lisp:1.17 Tue Aug 30 19:28:52 2005
+++ climacs/slidemacs-gui.lisp Thu Sep 1 02:21:08 2005
@@ -570,5 +570,5 @@
(if (not (and (typep pane 'climacs-pane)
(typep (syntax (buffer pane)) 'slidemacs-gui-syntax)))
(beep)
- (let ((file (accept 'climacs-gui::completable-pathname :prompt "Output to")))
- (postscript-print-pane pane file)))))
\ No newline at end of file
+ (let ((file (accept 'pathname :prompt "Output to")))
+ (postscript-print-pane pane file)))))
1
0
[climacs-cvs] CVS update: climacs/slidemacs-gui.lisp climacs/gui.lisp climacs/esa.lisp
by dmurray＠common-lisp.net 30 Aug '05
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
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
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
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
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
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
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
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