From mretzlaff at common-lisp.net Thu Sep 1 00:21:10 2005 From: mretzlaff at common-lisp.net (Max-Gerd Retzlaff) Date: Thu, 1 Sep 2005 02:21:10 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/pane.lisp climacs/slidemacs-gui.lisp Message-ID: <20050901002110.9C48B8802E@common-lisp.net> 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))))) From mretzlaff at common-lisp.net Thu Sep 1 01:05:52 2005 From: mretzlaff at common-lisp.net (Max-Gerd Retzlaff) Date: Thu, 1 Sep 2005 03:05:52 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/esa.lisp climacs/gui.lisp Message-ID: <20050901010552.5DA788802E@common-lisp.net> 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 at 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) From dmurray at common-lisp.net Mon Sep 5 07:06:34 2005 From: dmurray at common-lisp.net (Dave Murray) Date: Mon, 5 Sep 2005 09:06:34 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/esa.lisp Message-ID: <20050905070634.ECDA588542@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7633 Modified Files: esa.lisp Log Message: Added command Describe Key C-h k (which just displays the command name for the key in the minibuffer, for now). Date: Mon Sep 5 09:06:34 2005 Author: dmurray Index: climacs/esa.lisp diff -u climacs/esa.lisp:1.15 climacs/esa.lisp:1.16 --- climacs/esa.lisp:1.15 Thu Sep 1 03:05:51 2005 +++ climacs/esa.lisp Mon Sep 5 09:06:33 2005 @@ -234,6 +234,49 @@ (t nil))))) do (redisplay-frame-panes frame))) +(defun read-gestures-for-help (command-table) + (loop for gestures = (list (esa-read-gesture)) + then (nconc gestures (list (esa-read-gesture))) + for item = (find-gestures-with-inheritance gestures command-table) + unless item + do (return (values nil gestures)) + when (eq (command-menu-item-type item) :command) + do (return (values (command-menu-item-value item) + gestures)))) + +(defun describe-key (pane) + (let ((command-table (command-table pane))) + (multiple-value-bind (command gestures) + (read-gestures-for-help command-table) + (when (consp command) + (setf command (car command))) + (display-message "~{~A ~}~:[is not bound~;runs the command ~:*~A~]" + (mapcar #'gesture-name gestures) + (or (command-line-name-for-command + command command-table :errorp nil) + command))))) + +(defgeneric gesture-name (gesture)) + +(defmethod gesture-name ((char character)) + (or (char-name char) + char)) + +(defmethod gesture-name ((ev keyboard-event)) + (let ((key-name (keyboard-event-key-name ev)) + (modifiers (event-modifier-state ev))) + (with-output-to-string (s) + (loop for (modifier name) on (list + ;(+alt-key+ "A-") + +hyper-key+ "H-" + +super-key+ "s-" + +meta-key+ "M-" + +control-key+ "C-") + by #'cddr + when (plusp (logand modifier modifiers)) + do (princ name s)) + (princ key-name s)))) + (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p) (declare (ignore force-p)) (when (null (remaining-keys *application-frame*)) @@ -359,6 +402,13 @@ (execute-frame-command *application-frame* item))) (set-key 'com-extended-command 'global-esa-table '((#\x :meta))) + +(define-command (com-describe-key :name t :command-table global-esa-table) () + (display-message "Describe key:") + (redisplay-frame-panes *application-frame*) + (describe-key (car (windows *application-frame*)))) + +(set-key 'com-describe-key 'global-esa-table '((#\h :control) (#\k))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; From dmurray at common-lisp.net Mon Sep 5 07:07:29 2005 From: dmurray at common-lisp.net (Dave Murray) Date: Mon, 5 Sep 2005 09:07:29 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/lisp-syntax.lisp Message-ID: <20050905070729.7867288542@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7705 Modified Files: lisp-syntax.lisp Log Message: Made parse slightly more forgiving e.g. extraneous close paren is marked in red and skipped over. Date: Mon Sep 5 09:07:28 2005 Author: dmurray Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.33 climacs/lisp-syntax.lisp:1.34 --- climacs/lisp-syntax.lisp:1.33 Thu Aug 18 21:49:01 2005 +++ climacs/lisp-syntax.lisp Mon Sep 5 09:07:28 2005 @@ -199,6 +199,8 @@ (defclass complete-token-lexeme (token-mixin form-lexeme) ()) (defclass multiple-escape-start-lexeme (lisp-lexeme) ()) (defclass multiple-escape-end-lexeme (lisp-lexeme) ()) +(defclass incomplete-lexeme (lisp-lexeme) ()) +(defclass unmatched-right-parenthesis-lexeme (lisp-lexeme) ()) (defmethod skip-inter ((syntax lisp-syntax) state scan) (macrolet ((fo () `(forward-object scan))) @@ -224,7 +226,7 @@ (let ((object (object-after scan))) (case object (#\( (fo) (make-instance 'left-parenthesis-lexeme)) - ;#\) is an error + (#\) (fo) (make-instance 'unmatched-right-parenthesis-lexeme)) (#\' (fo) (make-instance 'quote-lexeme)) (#\; (fo) (loop until (or (end-of-buffer-p scan) @@ -236,7 +238,7 @@ (#\` (fo) (make-instance 'backquote-lexeme)) (#\, (fo) (cond ((end-of-buffer-p scan) - (make-instance 'error-lexeme)) + (make-instance 'incomplete-lexeme)) (t (case (object-after scan) (#\@ (fo) (make-instance 'comma-at-lexeme)) @@ -244,13 +246,13 @@ (t (make-instance 'comma-lexeme)))))) (#\# (fo) (cond ((end-of-buffer-p scan) - (make-instance 'error-lexeme)) + (make-instance 'incomplete-lexeme)) (t (loop until (end-of-buffer-p scan) while (digit-char-p (object-after scan)) do (fo)) (if (end-of-buffer-p scan) - (make-instance 'error-lexeme) + (make-instance 'incomplete-lexeme) (case (object-after scan) ((#\Backspace #\Tab #\Newline #\Linefeed #\Page #\Return #\Space #\)) @@ -258,7 +260,7 @@ (make-instance 'error-lexeme)) (#\\ (fo) (cond ((end-of-buffer-p scan) - (make-instance 'error-lexeme)) + (make-instance 'incomplete-lexeme)) ((not (constituentp (object-after scan))) (fo) (make-instance 'character-lexeme)) (t (loop until (end-of-buffer-p scan) @@ -294,6 +296,8 @@ (eql (object-after scan) #\()) (fo) (make-instance 'structure-start-lexeme)) + ((end-of-buffer-p scan) + (make-instance 'incomplete-lexeme)) (t (make-instance 'error-lexeme)))) ((#\P #\p) (fo) (make-instance 'pathname-start-lexeme)) @@ -391,7 +395,7 @@ (when (eql (object-after scan) #\\) (fo) (when (end-of-buffer-p scan) - (return-from lex-token (make-instance 'error-lexeme))) + (return-from lex-token (make-instance 'incomplete-lexeme))) (fo) (go start)) (when (eql (object-after scan) #\|) @@ -409,7 +413,7 @@ (when (eql (object-after scan) #\\) (fo) (when (end-of-buffer-p scan) - (return-from lex (make-instance 'error-lexeme))) + (return-from lex (make-instance 'incomplete-lexeme))) (fo) (go start)) (when (eql (object-after scan) #\|) @@ -547,6 +551,8 @@ (define-new-lisp-state (|initial-state | form) |initial-state |) (define-new-lisp-state (|initial-state | comment) |initial-state |) +;; skip over unmatched right parentheses +(define-new-lisp-state (|initial-state | unmatched-right-parenthesis-lexeme) |initial-state |) (define-lisp-action (|initial-state | (eql nil)) (reduce-all form*)) @@ -1198,6 +1204,11 @@ (with-face (:error) (call-next-method))) +(defmethod display-parse-tree ((parse-symbol unmatched-right-parenthesis-lexeme) + (syntax lisp-syntax) pane) + (with-face (:error) + (call-next-method))) + (define-presentation-type unknown-symbol () :inherit-from 'symbol :description "unknown symbol") @@ -1365,7 +1376,6 @@ do (display-parse-tree child syntax pane)))) (defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax lisp-syntax) current-p) - (declare (ignore current-p)) (with-slots (top bot) pane (setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot))) *current-line* 0 From dmurray at common-lisp.net Tue Sep 6 21:30:35 2005 From: dmurray at common-lisp.net (Dave Murray) Date: Tue, 6 Sep 2005 23:30:35 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/packages.lisp climacs/gui.lisp climacs/esa.lisp Message-ID: <20050906213035.1BD058815C@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv5074 Modified Files: packages.lisp gui.lisp esa.lisp Log Message: Initial implementation of Where Is (C-h w) and Describe Bindings (C-h b); renamed Describe Key (C-h k) to Describe Key Briefly (C-h c) and added new help-table to ESA. Also, changed set-key to not clobber defined commands in command tables, fixed some minor errors in gui.lisp, and included keyboard-macro-table and help-table in global-climacs-table's inheritance list. Date: Tue Sep 6 23:30:34 2005 Author: dmurray Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.80 climacs/packages.lisp:1.81 --- climacs/packages.lisp:1.80 Thu Sep 1 02:21:08 2005 +++ climacs/packages.lisp Tue Sep 6 23:30:33 2005 @@ -193,6 +193,7 @@ #:*numeric-argument-p* #:*current-gesture* #:esa-top-level #:simple-command-loop #:global-esa-table #:keyboard-macro-table + #:help-table #:set-key)) (defpackage :climacs-gui Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.186 climacs/gui.lisp:1.187 --- climacs/gui.lisp:1.186 Thu Sep 1 03:05:51 2005 +++ climacs/gui.lisp Tue Sep 6 23:30:33 2005 @@ -56,7 +56,8 @@ (define-application-frame climacs (standard-application-frame esa-frame-mixin) ((buffers :initform '() :accessor buffers)) - (:command-table (global-climacs-table :inherit-from (global-esa-table))) + (:command-table (global-climacs-table :inherit-from (global-esa-table keyboard-macro-table + help-table))) (:menu-bar nil) (:panes (window (let* ((extended-pane @@ -350,7 +351,7 @@ (define-named-command com-transpose-objects () (transpose-objects (point (current-window)))) -(set-key 'com-transponse-objects 'global-climacs-table +(set-key 'com-transpose-objects 'global-climacs-table '((#\t :control))) (define-named-command com-backward-object ((count 'integer :prompt "Number of Objects")) @@ -1276,7 +1277,9 @@ (define-named-command com-browse-url () (let ((url (accept 'url :prompt "Browse URL"))) #+ (and sbcl darwin) - (sb-ext:run-program "/usr/bin/open" `(,url) :wait nil))) + (sb-ext:run-program "/usr/bin/open" `(,url) :wait nil) + #+ (and openmcl darwin) + (ccl:run-program "/usr/bin/open" `(,url) :wait nil))) (define-named-command com-set-mark () (let ((pane (current-window))) @@ -1525,7 +1528,7 @@ (kill-ring-standard-push *kill-ring* (region-to-sequence (point pane) (mark pane))))) (set-key 'com-copy-region 'global-climacs-table - '((#\w :control))) + '((#\w :meta))) (define-named-command com-rotate-yank () (let* ((pane (current-window)) @@ -1940,7 +1943,7 @@ (kill-ring-standard-push *kill-ring* (region-to-sequence point mark)) (delete-region point mark))) -(set-key `(com-kill-sentence *numeric-argument-marker*) +(set-key `(com-kill-sentence ,*numeric-argument-marker*) 'global-climacs-table '((#\k :meta))) @@ -1990,7 +1993,7 @@ (backward-page point count) (forward-page point count)))) -(set-key 'com-backward-page 'global-climacs-table +(set-key `(com-backward-page ,*numeric-argument-marker*) 'global-climacs-table '((#\x :control) (#\[))) (define-named-command com-mark-page ((count 'integer :prompt "Move how many pages") Index: climacs/esa.lisp diff -u climacs/esa.lisp:1.16 climacs/esa.lisp:1.17 --- climacs/esa.lisp:1.16 Mon Sep 5 09:06:33 2005 +++ climacs/esa.lisp Tue Sep 6 23:30:34 2005 @@ -234,49 +234,6 @@ (t nil))))) do (redisplay-frame-panes frame))) -(defun read-gestures-for-help (command-table) - (loop for gestures = (list (esa-read-gesture)) - then (nconc gestures (list (esa-read-gesture))) - for item = (find-gestures-with-inheritance gestures command-table) - unless item - do (return (values nil gestures)) - when (eq (command-menu-item-type item) :command) - do (return (values (command-menu-item-value item) - gestures)))) - -(defun describe-key (pane) - (let ((command-table (command-table pane))) - (multiple-value-bind (command gestures) - (read-gestures-for-help command-table) - (when (consp command) - (setf command (car command))) - (display-message "~{~A ~}~:[is not bound~;runs the command ~:*~A~]" - (mapcar #'gesture-name gestures) - (or (command-line-name-for-command - command command-table :errorp nil) - command))))) - -(defgeneric gesture-name (gesture)) - -(defmethod gesture-name ((char character)) - (or (char-name char) - char)) - -(defmethod gesture-name ((ev keyboard-event)) - (let ((key-name (keyboard-event-key-name ev)) - (modifiers (event-modifier-state ev))) - (with-output-to-string (s) - (loop for (modifier name) on (list - ;(+alt-key+ "A-") - +hyper-key+ "H-" - +super-key+ "s-" - +meta-key+ "M-" - +control-key+ "C-") - by #'cddr - when (plusp (logand modifier modifiers)) - do (princ name s)) - (princ key-name s)))) - (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p) (declare (ignore force-p)) (when (null (remaining-keys *application-frame*)) @@ -363,6 +320,8 @@ (find-keystroke-item event table :errorp nil)))) (defun set-key (command table gestures) + (unless (consp command) + (setf command (list command))) (let ((gesture (car gestures))) (cond ((null (cdr gestures)) (add-command-to-command-table @@ -403,12 +362,196 @@ (set-key 'com-extended-command 'global-esa-table '((#\x :meta))) -(define-command (com-describe-key :name t :command-table global-esa-table) () - (display-message "Describe key:") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Help + +(defun read-gestures-for-help (command-table) + (loop for gestures = (list (esa-read-gesture)) + then (nconc gestures (list (esa-read-gesture))) + for item = (find-gestures-with-inheritance gestures command-table) + unless item + do (return (values nil gestures)) + when (eq (command-menu-item-type item) :command) + do (return (values (command-menu-item-value item) + gestures)))) + +(defun describe-key-briefly (pane) + (let ((command-table (command-table pane))) + (multiple-value-bind (command gestures) + (read-gestures-for-help command-table) + (when (consp command) + (setf command (car command))) + (display-message "~{~A ~}~:[is not bound~;runs the command ~:*~A~]" + (mapcar #'gesture-name gestures) + (or (command-line-name-for-command + command command-table :errorp nil) + command))))) + +(defgeneric gesture-name (gesture)) + +(defmethod gesture-name ((char character)) + (or (char-name char) + char)) + +(defun translate-name-and-modifiers (key-name modifiers) + (with-output-to-string (s) + (loop for (modifier name) on (list + ;(+alt-key+ "A-") + +hyper-key+ "H-" + +super-key+ "s-" + +meta-key+ "M-" + +control-key+ "C-") + by #'cddr + when (plusp (logand modifier modifiers)) + do (princ name s)) + (princ (if (typep key-name 'character) + (or (char-name key-name) + key-name) + key-name) s))) + +(defmethod gesture-name ((ev keyboard-event)) + (let ((key-name (keyboard-event-key-name ev)) + (modifiers (event-modifier-state ev))) + (translate-name-and-modifiers key-name modifiers))) + +(defmethod gesture-name ((gesture list)) + (cond ((eq (car gesture) :keyboard) + (translate-name-and-modifiers (second gesture) (third gesture))) + ;; punt on this for now + (t nil))) + +(defun find-keystrokes-for-command (command command-table) + (let ((keystrokes '())) + (labels ((helper (command command-table prefix) + (map-over-command-table-keystrokes + #'(lambda (menu-name keystroke item) + (declare (ignore menu-name)) + (cond ((and (eq (command-menu-item-type item) :command) + (eq (car (command-menu-item-value item)) command)) + (push (cons keystroke prefix) keystrokes)) + ((eq (command-menu-item-type item) :menu) + (helper command (command-menu-item-value item) (cons keystroke prefix))) + (t nil))) + command-table))) + (helper command command-table nil) + keystrokes))) + +(defun find-keystrokes-for-command-with-inheritance (command start-table) + (let ((keystrokes '())) + (labels ((helper (table) + (let ((keys (find-keystrokes-for-command command table))) + (when keys (push keys keystrokes)) + (dolist (subtable (command-table-inherit-from + (find-command-table table))) + (helper subtable))))) + (helper start-table)) + keystrokes)) + +(defun find-all-keystrokes-and-commands (command-table) + (let ((results '())) + (labels ((helper (command-table prefix) + (map-over-command-table-keystrokes + #'(lambda (menu-name keystroke item) + (declare (ignore menu-name)) + (cond ((eq (command-menu-item-type item) :command) + (push (cons (cons keystroke prefix) + (command-menu-item-value item)) + results)) + ((eq (command-menu-item-type item) :menu) + (helper (command-menu-item-value item) (cons keystroke prefix))) + (t nil))) + command-table))) + (helper command-table nil) + results))) + +(defun sort-by-name (list) + (sort list #'string< :key (lambda (item) (symbol-name (second item))))) + +(defun sort-by-keystrokes (list) + (sort list (lambda (a b) + (cond ((and (characterp a) + (characterp b)) + (char< a b)) + ((characterp a) + t) + ((characterp b) + nil) + (t (string< (symbol-name a) + (symbol-name b))))) + :key (lambda (item) (second (first (first item)))))) + +(defun describe-bindings (stream command-table + &optional (sort-function #'sort-by-name)) + (formatting-table (stream) + (loop for (keys command) + in (funcall sort-function (find-all-keystrokes-and-commands + command-table)) + do (formatting-row (stream) + (formatting-cell (stream :align-x :right) + (with-text-style (stream '(:sans-serif nil nil)) + (format stream "~A" + (or (command-line-name-for-command command + command-table + :errorp nil) + command)))) + (formatting-cell (stream) + (with-drawing-options (stream :ink +dark-blue+ + :text-style '(:fix nil nil)) + (format stream "~&~{~A~^ ~}" + (mapcar #'gesture-name (reverse keys)))))) + count command into length + finally (change-space-requirements stream + :height (* length (stream-line-height stream))) + (scroll-extent stream 0 0)))) + +;;; help commands + +(define-command-table help-table) + +(define-command (com-describe-key-briefly :name t :command-table help-table) () + (display-message "Describe key briefly:") (redisplay-frame-panes *application-frame*) - (describe-key (car (windows *application-frame*)))) + (describe-key-briefly (car (windows *application-frame*)))) + +(set-key 'com-describe-key-briefly 'help-table '((#\h :control) (#\c))) + +(define-command (com-where-is :name t :command-table help-table) () + (let* ((command-table (command-table (car (windows *application-frame*)))) + (command + (handler-case + (accept + `(command-name :command-table + ,command-table) + :prompt "Where is command") + (error () (progn (beep) + (display-message "No such command") + (return-from com-where-is nil))))) + (keystrokes (find-keystrokes-for-command-with-inheritance command command-table))) + (display-message "~A is ~:[not on any key~;~:*on ~{~A~^, ~}~]" + (command-line-name-for-command command command-table) + (mapcar (lambda (keys) + (format nil "~{~A~^ ~}" + (mapcar #'gesture-name (reverse keys)))) + (car keystrokes))))) + +(set-key 'com-where-is 'help-table '((#\h :control) (#\w))) + +(define-command (com-describe-bindings :name t :command-table help-table) + ((sort-by-keystrokes 'boolean :prompt "Sort by keystrokes?")) + (let* ((window (car (windows *application-frame*))) + (stream (open-window-stream + :label (format nil "Help: Describe Bindings") + :input-buffer (climi::frame-event-queue *application-frame*) + :width 400)) + (command-table (command-table window))) + (describe-bindings stream command-table + (if sort-by-keystrokes + #'sort-by-keystrokes + #'sort-by-name)))) -(set-key 'com-describe-key 'global-esa-table '((#\h :control) (#\k))) +(set-key `(com-describe-bindings ,*numeric-argument-p*) 'help-table '((#\h :control) (#\b))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; From rstrandh at common-lisp.net Mon Sep 12 02:55:35 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Mon, 12 Sep 2005 04:55:35 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/Doc/climacs-user.texi Message-ID: <20050912025535.CE3D58855A@common-lisp.net> Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv27861 Added Files: climacs-user.texi Log Message: Embryonic user manual Date: Mon Sep 12 04:55:34 2005 Author: rstrandh From rstrandh at common-lisp.net Mon Sep 12 22:43:55 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 13 Sep 2005 00:43:55 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/Doc/climacs-user.texi Message-ID: <20050912224355.28EAF8855C@common-lisp.net> Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv15260 Modified Files: climacs-user.texi Log Message: moving by words, editing files. Date: Tue Sep 13 00:43:54 2005 Author: rstrandh Index: climacs/Doc/climacs-user.texi diff -u climacs/Doc/climacs-user.texi:1.1 climacs/Doc/climacs-user.texi:1.2 --- climacs/Doc/climacs-user.texi:1.1 Mon Sep 12 04:55:34 2005 +++ climacs/Doc/climacs-user.texi Tue Sep 13 00:43:54 2005 @@ -181,6 +181,7 @@ * Entering and deleting text:: * Moving around:: * Extended commands:: +* Editing the contents of a file:: @end menu @node Entering and exiting @climacs{} @@ -285,7 +286,8 @@ It is also possible to delete larger chunks of buffer contents. The order @kbd{M-d} @kindex M-d -(@command{Kill Word}) is used to delete the word +(@command{Kill Word}) is used to delete the @emph{word} + at cindex word @emph{following} point. If point is not at the beginning of a word, then the part of the word that follows point is deleted. The order @kbd{M- at key{Backspace}} @@ -349,6 +351,27 @@ @node Moving by words @subsection Moving by words + at climacs{} will allow you to move around by larger unites than +objects. + +The order @kbd{M-f} + at kindex M-f +(@command{Forward Word}) lets you move forward over the @emph{word} + at cindex word +following point. With a numeric argument, this command moves point +forward that many words. + +The order @kbd{M-b} + at kindex M-b +(@command{Backward Word}) lets you move backward over the @emph{word} + at cindex word +preceding point. With a numeric argument, this command moves point +backward that many words. + +Notice the analogy between the commands for moving by objects +(@kbd{C-f}, @kbd{C-b}) and those for moving by words (@kbd{M-f}, + at kbd{M-b}). + @node Moving by lines @subsection Moving by lines @@ -397,6 +420,64 @@ @command{Extended Command}. The reason for this is that key sequences are a precious resource, and for rarely-used commands, it is better not to waste a key sequence. + + at node Editing the contents of a file + at section Editing the contents of a file + +Transfering the contents of a text file into a @climacs{} buffer is +referred to as @emph{finding} the file. + at cindex finding a file + +There are two ways of transfering the contents of a buffer to a file. +One is to @emph{save} the buffer, which means to transfer the contents +to the file that is already associated with the buffer. The other is +to @emph{write} the buffer, which means to transfer the contents to a +different file than that associated with the buffer, or to write the +contents of a buffer that has no associated file to some file. + + at menu +* Finding a file:: Moving text from a file to a @climacs{} buffer +* Saving a buffer:: Moving text from a buffer to the associated file +* Writing a buffer:: Moving text from a buffer to a different file + at end menu + + at node Finding a file + at subsection Finding a file + +To find a file, use the order @kbd{C-x C-f} + at kindex C-x C-f +(@command{Find File}). + + at climacs{} will prompt for the name of a file. For typing the file +name, you can use @emph{completion} (using the @key{TAB} key), or you +can use the right mouse button to get a list of all the files that +match the prefix you typed. + +The result of finding a file is that a @emph{buffer} will be created +that has the name of the file, and the file will be associated with +that buffer when the contents is saved. + + at node Saving a buffer + at subsection Saving a buffer + +To save a buffer, use the order @kbd{C-x C-s} + at kindex C-x C-s +(@command{Save Buffer}). +The contents of the buffer will be transfered to the file associated +with the buffer if there is one. If the buffer has no file name +associated with it, then this command behaves just like @command{Write +Buffer} (@pxref{write-buffer}). + + at node Writing a buffer + at subsection Writing a buffer + at anchor{write-buffer} + +To write a buffer to a file, use the order @kbd{C-x C-w} + at kindex C-x C-w +(@command{Write Buffer}). @climacs{} will prompt for the name of a +file to save the buffer contents in. Completion (by using the + at key{TAB} key, or by using the right mouse button) can be used if the +name is that of an existing file. @node Different editing modes @chapter Different editing modes From rstrandh at common-lisp.net Mon Sep 12 23:35:56 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Tue, 13 Sep 2005 01:35:56 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/Doc/climacs-user.texi Message-ID: <20050912233556.B24718855C@common-lisp.net> Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv21069 Modified Files: climacs-user.texi Log Message: Keyboard macros Date: Tue Sep 13 01:35:55 2005 Author: rstrandh Index: climacs/Doc/climacs-user.texi diff -u climacs/Doc/climacs-user.texi:1.2 climacs/Doc/climacs-user.texi:1.3 --- climacs/Doc/climacs-user.texi:1.2 Tue Sep 13 00:43:54 2005 +++ climacs/Doc/climacs-user.texi Tue Sep 13 01:35:55 2005 @@ -42,6 +42,7 @@ * Basic editing commands:: * Different editing modes:: * Kill ring:: +* Advanced editing commands:: * Key Index:: * Concept Index:: @end menu @@ -511,6 +512,46 @@ objects on a global @emph{kill ring}. @cindex kill ring + at node Advanced editing commands + at chapter Advanced editing commands + + at menu +* Keyboard macros:: +* Searching and replacing:: + at end menu + + at node Keyboard macros + at section Keyboard macros + +Sometimes, it is useful to be able to repeat a sequence of keystrokes +several times. @climacs{} allows you to do this through a features +called @emph{keyboard macros}. + at cindex keyboard macro + at climacs{} does this by @emph{recording} whatever the user types on +the keyboard, and then making it possibly to @emph{replaying} the +recorded sequence. + +To start recording a sequence of keystrokes, use the order @kbd{C-x (} + at kindex C-x ( +(@command{Start Kbd Macro}). You will see the word @samp{Def} +appearing on the mode line, indicating that a keyboard macro is being +defined. As long as recording is in effect, every keystroke will be +saved for later use. + +To stop recording a sequence of keystrokes, use the order @kbd{C-x )} + at kindex C-x ) +(@command{End Kbd Macro}). The word @samp{Def} will disappear from +the mode line, indicating that keystrokes are no longer being +recorded. + +To replay a previously recorded sequence of keystrokes, use the order + at kbd{C-x e} + at kindex C-x e +(@command{Call Last Kbd Macro}). When used with a numeric argument, +this command will repeat the sequence of keystrokes that many times. + + at node Searching and replacing + at section Searching and replacing @node Key Index @unnumbered Key Index From dmurray at common-lisp.net Tue Sep 13 19:38:03 2005 From: dmurray at common-lisp.net (Dave Murray) Date: Tue, 13 Sep 2005 21:38:03 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/gui.lisp Message-ID: <20050913193803.97F96880DE@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv8462 Modified Files: gui.lisp Log Message: Quick close-paren fix. Date: Tue Sep 13 21:38:03 2005 Author: dmurray Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.188 climacs/gui.lisp:1.189 --- climacs/gui.lisp:1.188 Tue Sep 13 21:23:59 2005 +++ climacs/gui.lisp Tue Sep 13 21:38:02 2005 @@ -217,12 +217,12 @@ (princ (if (recordingp *application-frame*) "Def" "") - pane)))))) + 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))))) +(defun display-window (frame pane) + "The display function used by the climacs application frame." + (declare (ignore frame)) + (redisplay-pane pane (eq pane (current-window)))) (defmethod handle-repaint :before ((pane extended-pane) region) (declare (ignore region)) From dmurray at common-lisp.net Tue Sep 13 19:24:03 2005 From: dmurray at common-lisp.net (Dave Murray) Date: Tue, 13 Sep 2005 21:24:03 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/syntax.lisp climacs/slidemacs-gui.lisp climacs/pane.lisp climacs/packages.lisp climacs/lisp-syntax.lisp climacs/gui.lisp climacs/esa.lisp Message-ID: <20050913192403.47C81880DE@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7426 Modified Files: syntax.lisp slidemacs-gui.lisp pane.lisp packages.lisp lisp-syntax.lisp gui.lisp esa.lisp Log Message: Two major groups of changes, as steps towards supporting the multi-pane paradigm: (a) changes to support non-buffer- containing panes (a typeout pane is the first example - try C-h b); (b) distributed commands among a plethora of little command tables, as threatened on the mailing list. Also: changed info-pane (again) - now includes call to name-for-info-pane (specialised on syntax) - try a lisp file where climacs can work out the package name; got rid of 'Toggle' names (didn't add anything); mouse-clicks now change window and position the cursor; now command Insert Parentheses (M-() that almost works. Slidemacs temporarily broken... Date: Tue Sep 13 21:24:00 2005 Author: dmurray Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.57 climacs/syntax.lisp:1.58 --- climacs/syntax.lisp:1.57 Wed Aug 17 01:10:29 2005 +++ climacs/syntax.lisp Tue Sep 13 21:23:59 2005 @@ -148,6 +148,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Name for info-pane + +(defgeneric name-for-info-pane (syntax)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Syntax completion (defparameter *syntaxes* '()) @@ -240,6 +246,9 @@ (defmethod update-syntax-for-display (buffer (syntax basic-syntax) from to) (declare (ignore buffer from to)) nil) + +(defmethod name-for-info-pane ((syntax basic-syntax)) + (name syntax)) (defmethod syntax-line-indentation (mark tab-width (syntax basic-syntax)) (declare (ignore mark tab-width)) Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.18 climacs/slidemacs-gui.lisp:1.19 --- climacs/slidemacs-gui.lisp:1.18 Thu Sep 1 02:21:08 2005 +++ climacs/slidemacs-gui.lisp Tue Sep 13 21:23:59 2005 @@ -35,6 +35,8 @@ (defvar *current-slideset*) (defvar *did-display-a-slide*) +(make-command-table 'slidemacs-table) + (defun slidemacs-entity-string (entity) (coerce (buffer-sequence (buffer entity) (1+ (start-offset entity)) @@ -357,7 +359,7 @@ (- y2 y1))))))) (define-command (com-reveal-text :name "Reveal Text In Window" - :command-table global-command-table + :command-table slidemacs-table :menu t :provide-output-destination-keyword t) ((text 'string :prompt "text")) @@ -366,7 +368,7 @@ (write-string text stream)))) (define-presentation-to-command-translator reveal-text-translator - (reveal-button com-reveal-text global-command-table + (reveal-button com-reveal-text slidemacs-table :gesture :select :documentation "Reveal Text In Window" :pointer-documentation "Reveal Text In Window") @@ -478,7 +480,7 @@ (or (word-is lexeme "info") (word-is lexeme "graph"))))) -(climacs-gui::define-named-command com-next-talking-point () +(define-command (com-next-talking-point :name t :command-table slidemacs-table) () (let* ((pane (climacs-gui::current-window)) (buffer (buffer pane)) (syntax (syntax buffer))) @@ -493,7 +495,7 @@ (return (setf (offset point) (start-offset lexeme))))) (full-redisplay pane)))))) -(climacs-gui::define-named-command com-previous-talking-point () +(define-command (com-previous-talking-point :name t :command-table slidemacs-table) () (let* ((pane (climacs-gui::current-window)) (buffer (buffer pane)) (syntax (syntax buffer))) @@ -516,23 +518,23 @@ collect thing else collect (if decrease-p (- thing 8) (+ thing 8))))) -(climacs-gui::define-named-command com-decrease-presentation-font-sizes () +(define-command (com-decrease-presentation-font-sizes :name t :command-table slidemacs-table) () (adjust-font-sizes t) (full-redisplay (climacs-gui::current-window))) -(climacs-gui::define-named-command com-increase-presentation-font-sizes () +(define-command (com-increase-presentation-font-sizes :name t :command-table slidemacs-table) () (adjust-font-sizes nil) (full-redisplay (climacs-gui::current-window))) -(climacs-gui::define-named-command com-first-talking-point () +(define-command (com-first-talking-point :name t :command-table slidemacs-table) () (climacs-gui::com-beginning-of-buffer) (com-next-talking-point)) -(climacs-gui::define-named-command com-last-talking-point () +(define-command (com-last-talking-point :name t :command-table slidemacs-table) () (climacs-gui::com-end-of-buffer) (com-previous-talking-point)) -(climacs-gui::define-named-command com-flip-slidemacs-syntax () +(define-command (com-flip-slidemacs-syntax :name t :command-table slidemacs-table) () (let* ((buffer (buffer (climacs-gui::current-window))) (syntax (syntax buffer))) (typecase syntax @@ -544,28 +546,28 @@ :buffer buffer)))))) (esa:set-key 'com-next-talking-point - 'climacs-gui::global-climacs-table + 'slidemacs-table '((#\= :control))) (esa:set-key 'com-previous-talking-point - 'climacs-gui::global-climacs-table + 'slidemacs-table '((#\- :control))) (esa:set-key 'com-increase-presentation-font-sizes - 'climacs-gui::global-climacs-table + 'slidemacs-table '((#\= :meta))) (esa:set-key 'com-decrease-presentation-font-sizes - 'climacs-gui::global-climacs-table + 'slidemacs-table '((#\- :meta))) (esa:set-key 'com-last-talking-point - 'climacs-gui::global-climacs-table + 'slidemacs-table '((#\= :control :meta))) (esa:set-key 'com-first-talking-point - 'climacs-gui::global-climacs-table + 'slidemacs-table '((#\- :control :meta))) (esa:set-key 'com-flip-slidemacs-syntax - 'climacs-gui::global-climacs-table + 'slidemacs-table '((#\s :control :meta))) -(climacs-gui::define-named-command com-postscript-print-presentation () +(define-command (com-postscript-print-presentation :name t :command-table slidemacs-table) () (let ((pane (climacs-gui::current-window))) (if (not (and (typep pane 'climacs-pane) (typep (syntax (buffer pane)) 'slidemacs-gui-syntax))) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.32 climacs/pane.lisp:1.33 --- climacs/pane.lisp:1.32 Thu Sep 1 02:21:08 2005 +++ climacs/pane.lisp Tue Sep 13 21:23:59 2005 @@ -267,7 +267,7 @@ (cursor-y :initform 2) (space-width :initform nil) (tab-width :initform nil) - (auto-fill-mode :initform t :accessor auto-fill-mode) + (auto-fill-mode :initform nil :accessor auto-fill-mode) (auto-fill-column :initform 70 :accessor auto-fill-column) (isearch-mode :initform nil :accessor isearch-mode) (isearch-states :initform '() :accessor isearch-states) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.81 climacs/packages.lisp:1.82 --- climacs/packages.lisp:1.81 Tue Sep 6 23:30:33 2005 +++ climacs/packages.lisp Tue Sep 13 21:23:59 2005 @@ -107,6 +107,7 @@ #:parse-stack-next #:parse-stack-symbol #:parse-stack-parse-trees #:map-over-parse-trees #:no-such-operation #:no-expression + #:name-for-info-pane #:syntax-line-indentation #:forward-expression #:backward-expression #:eval-defun Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.34 climacs/lisp-syntax.lisp:1.35 --- climacs/lisp-syntax.lisp:1.34 Mon Sep 5 09:07:28 2005 +++ climacs/lisp-syntax.lisp Tue Sep 13 21:23:59 2005 @@ -43,6 +43,11 @@ (with-slots (buffer scan) syntax (setf scan (clone-mark (low-mark buffer) :left)))) +(defmethod name-for-info-pane ((syntax lisp-syntax)) + (format nil "Lisp~@[:~(~A~)~]" + (when (slot-value syntax 'package) + (package-name (slot-value syntax 'package))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; lexer @@ -1571,6 +1576,31 @@ (mark< mark (end-offset form))) do (setf (offset mark) (end-offset form)) (loop-finish)))) + +(defun in-type-p-in-children (children offset type) + (loop for child in children + do (cond ((< (start-offset child) offset (end-offset child)) + (return (if (typep child type) + child + (in-type-p-in-children (children child) offset type)))) + ((<= offset (start-offset child)) + (return nil)) + (t nil)))) + +(defun in-type-p (mark syntax type) + (let ((offset (offset mark))) + (with-slots (stack-top) syntax + (if (or (null (start-offset stack-top)) + (>= offset (end-offset stack-top)) + (<= offset (start-offset stack-top))) + nil) + (in-type-p-in-children (children stack-top) offset type)))) + +(defun in-string-p (mark syntax) + (in-type-p mark syntax 'string-form)) + +(defun in-comment-p (mark syntax) + (in-type-p mark syntax 'comment)) ;;; shamelessly replacing SWANK code ;; We first work through the string removing the characters and noting Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.187 climacs/gui.lisp:1.188 --- climacs/gui.lisp:1.187 Tue Sep 6 23:30:33 2005 +++ climacs/gui.lisp Tue Sep 13 21:23:59 2005 @@ -53,38 +53,93 @@ (defparameter *with-scrollbars* t "If T, classic look and feel. If NIL, stripped-down look (:") +;;; Basic functionality +(make-command-table 'base-table) +;;; buffers +(make-command-table 'buffer-table) +;;; case +(make-command-table 'case-table) +;;; comments +(make-command-table 'comment-table) +;;; deleting +(make-command-table 'deletion-table) +;;; commands used for climacs development +(make-command-table 'development-table) +;;; editing - making changes to a buffer +(make-command-table 'editing-table) +;;; filling +(make-command-table 'fill-table) +;;; indentation +(make-command-table 'indent-table) +;;; information about the buffer +(make-command-table 'info-table) +;;; lisp-related commands +(make-command-table 'lisp-table) +;;; marking things +(make-command-table 'marking-table) +;;; moving around +(make-command-table 'movement-table) +;;; panes +(make-command-table 'pane-table) +;;; searching +(make-command-table 'search-table) +;;; self-insertion +(make-command-table 'self-insert-table) +;;; windows +(make-command-table 'window-table) + (define-application-frame climacs (standard-application-frame esa-frame-mixin) ((buffers :initform '() :accessor buffers)) - (:command-table (global-climacs-table :inherit-from (global-esa-table keyboard-macro-table - help-table))) + (:command-table (global-climacs-table + :inherit-from (global-esa-table + keyboard-macro-table + help-table + base-table + buffer-table + case-table + comment-table + deletion-table + development-table + editing-table + fill-table + indent-table + info-table + lisp-table + marking-table + movement-table + pane-table + search-table + self-insert-table + window-table))) (:menu-bar nil) (:panes - (window (let* ((extended-pane - (make-pane 'extended-pane - :width 900 :height 400 - :end-of-line-action :scroll - :incremental-redisplay t - :display-function 'display-window - :command-table 'global-climacs-table)) - (info-pane - (make-pane 'climacs-info-pane - :master-pane extended-pane - :width 900))) - (setf (windows *application-frame*) (list extended-pane) - (buffers *application-frame*) (list (buffer extended-pane))) + (climacs-window + (let* ((extended-pane + (make-pane 'extended-pane + :width 900 :height 400 + :end-of-line-action :scroll + :incremental-redisplay t + :display-function 'display-window + :command-table 'global-climacs-table)) + (info-pane + (make-pane 'climacs-info-pane + :master-pane extended-pane + :width 900))) + (setf (windows *application-frame*) (list extended-pane) + (buffers *application-frame*) (list (buffer extended-pane))) - (vertically () - (if *with-scrollbars* - (scrolling () - extended-pane) - extended-pane) - info-pane))) + (vertically () + (if *with-scrollbars* + (scrolling () + extended-pane) + extended-pane) + info-pane))) (minibuffer (make-pane 'climacs-minibuffer-pane :width 900))) (:layouts (default (vertically (:scroll-bars nil) - window + climacs-window minibuffer))) (:top-level (esa-top-level))) @@ -93,7 +148,9 @@ (defmethod redisplay-frame-panes :around ((frame climacs) &rest args) (declare (ignore args)) - (let ((buffers (remove-duplicates (mapcar #'buffer (windows frame))))) + (let ((buffers (remove-duplicates (loop for pane in (windows frame) + when (typep pane 'extended-pane) + collect (buffer pane))))) (loop for buffer in buffers do (update-syntax buffer (syntax buffer))) (call-next-method) @@ -116,52 +173,56 @@ (buffer (buffer master-pane)) (size (size buffer)) (top (top master-pane)) - (bot (bot master-pane)) - (name-info (format nil "~3T~A~ - ~3 at T~A~ - ~:[~30T~A~;~*~]~ - ~3 at T~:[(~;Syntax: ~]~ - ~A~ - ~{~:[~*~; ~A~]~}~ - ~:[)~;~]~ - ~3 at T~A" - (cond ((and (needs-saving buffer) - (read-only-p buffer) - "%*")) - ((needs-saving buffer) "**") - ((read-only-p buffer) "%%") - (t "--")) - (name buffer) - *with-scrollbars* - (cond ((and (mark= size bot) - (mark= 0 top)) - "") - ((mark= size bot) - "Bot") - ((mark= 0 top) - "Top") - (t (format nil "~a%" - (round (* 100 (/ (offset top) - size)))))) - *with-scrollbars* - (name (syntax buffer)) - (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" - "")))) - (princ name-info 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)))) + (bot (bot master-pane))) + (formatting-table (pane) + (formatting-row (pane) + (formatting-cell (pane :align-x :right :min-width '(5 :character)) + (princ (cond ((and (needs-saving buffer) + (read-only-p buffer) + "%*")) + ((needs-saving buffer) "**") + ((read-only-p buffer) "%%") + (t "--")) + pane)) + (formatting-cell (pane :min-width '(25 :character)) + (princ " " pane) + (with-text-face (pane :bold) + (princ (name buffer) pane))) + (formatting-cell (pane :min-width '(5 :character)) + (princ (cond ((and (mark= size bot) + (mark= 0 top)) + "") + ((mark= size bot) + "Bot") + ((mark= 0 top) + "Top") + (t (format nil "~a%" + (round (* 100 (/ (offset top) + size)))))) + pane)) + (formatting-cell (pane) + (with-text-family (pane :sans-serif) + (princ #\( pane) + (princ (name-for-info-pane (syntax buffer)) pane) + (format pane "~{~:[~*~; ~A~]~}" (list + (slot-value master-pane 'overwrite-mode) + "Ovwrt" + (auto-fill-mode master-pane) + "Fill" + (isearch-mode master-pane) + "Isearch")) + (princ #\) pane))) + (formatting-cell (pane) + (with-text-family (pane :sans-serif) + (princ (if (recordingp *application-frame*) + "Def" + "") + pane)))))) + + (defun display-window (frame pane) + "The display function used by the climacs application frame." + (declare (ignore frame)) + (redisplay-pane pane (eq pane (current-window))))) (defmethod handle-repaint :before ((pane extended-pane) region) (declare (ignore region)) @@ -171,8 +232,10 @@ (defmethod execute-frame-command :around ((frame climacs) command) (handler-case - (with-undo ((buffer (current-window))) - (call-next-method)) + (if (typep (current-window) 'extended-pane) + (with-undo ((buffer (current-window))) + (call-next-method)) + (call-next-method)) (offset-before-beginning () (beep) (display-message "Beginning of buffer")) (offset-after-end () @@ -193,29 +256,27 @@ do (when (modified-p buffer) (setf (needs-saving buffer) t)))) -(defmacro define-named-command (command-name args &body body) - `(define-command ,(if (listp command-name) - `(, at command-name :name t :command-table global-climacs-table) - `(,command-name :name t :command-table global-climacs-table)) - ,args , at body)) - -(define-named-command com-toggle-overwrite-mode () +(define-command (com-overwrite-mode :name t :command-table editing-table) () (with-slots (overwrite-mode) (current-window) (setf overwrite-mode (not overwrite-mode)))) -(set-key 'com-toggle-overwrite-mode 'global-climacs-table +(set-key 'com-overwrite-mode + 'editing-table '((:insert))) -(define-named-command com-not-modified () +(define-command (com-not-modified :name t :command-table buffer-table) () (setf (needs-saving (buffer (current-window))) nil)) -(set-key 'com-not-modified 'global-climacs-table +(set-key 'com-not-modified + 'buffer-table '((#\~ :meta :shift))) -(define-named-command com-set-fill-column ((column 'integer :prompt "Column Number:")) +(define-command (com-set-fill-column :name t :command-table fill-table) + ((column 'integer :prompt "Column Number:")) (set-fill-column column)) -(set-key `(com-set-fill-column ,*numeric-argument-marker*) 'global-climacs-table +(set-key `(com-set-fill-column ,*numeric-argument-marker*) + 'fill-table '((#\x :control) (#\f))) (defun set-fill-column (column) @@ -256,26 +317,31 @@ (define-command com-self-insert ((count 'integer)) (loop repeat count do (insert-character *current-gesture*))) -(define-named-command com-beginning-of-line () +(define-command (com-beginning-of-line :name t :command-table movement-table) () (beginning-of-line (point (current-window)))) -(set-key 'com-beginning-of-line 'global-climacs-table +(set-key 'com-beginning-of-line + 'movement-table '((:home))) -(set-key 'com-beginning-of-line 'global-climacs-table +(set-key 'com-beginning-of-line + 'movement-table '((#\a :control))) -(define-named-command com-end-of-line () +(define-command (com-end-of-line :name t :command-table movement-table) () (end-of-line (point (current-window)))) -(set-key 'com-end-of-line 'global-climacs-table +(set-key 'com-end-of-line + 'movement-table '((#\e :control))) -(set-key 'com-end-of-line 'global-climacs-table +(set-key 'com-end-of-line + 'movement-table '((:end))) -(define-named-command com-delete-object ((count 'integer :prompt "Number of Objects") - (killp 'boolean :prompt "Kill?")) +(define-command (com-delete-object :name t :command-table deletion-table) + ((count 'integer :prompt "Number of Objects") + (killp 'boolean :prompt "Kill?")) (let* ((point (point (current-window))) (mark (clone-mark point))) (forward-object mark count) @@ -286,16 +352,17 @@ (set-key `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*) - 'global-climacs-table + 'deletion-table '(#\Rubout)) (set-key `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*) - 'global-climacs-table + 'deletion-table '((#\d :control))) -(define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects") - (killp 'boolean :prompt "Kill?")) +(define-command (com-backward-delete-object :name t :command-table deletion-table) + ((count 'integer :prompt "Number of Objects") + (killp 'boolean :prompt "Kill?")) (let* ((point (point (current-window))) (mark (clone-mark point))) (backward-object mark count) @@ -306,10 +373,10 @@ (set-key `(com-backward-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*) - 'global-climacs-table + 'deletion-table '(#\Backspace)) -(define-named-command com-zap-to-object () +(define-command (com-zap-to-object :name t :command-table deletion-table) () (let* ((item (handler-case (accept 't :prompt "Zap to Object") (error () (progn (beep) (display-message "Not a valid object") @@ -320,7 +387,7 @@ (search-forward item-mark (vector item)) (delete-range current-point (- (offset item-mark) current-offset)))) -(define-named-command com-zap-to-character () +(define-command (com-zap-to-character :name t :command-table deletion-table) () (let* ((item-string (handler-case (accept 'string :prompt "Zap to Character") ; Figure out how to get #\d and d. (or 'string 'character)? (error () (progn (beep) (display-message "Not a valid string. ") @@ -335,7 +402,8 @@ (search-forward item-mark item) (delete-range current-point (- (offset item-mark) current-offset)))) -(set-key 'com-zap-to-character 'global-climacs-table +(set-key 'com-zap-to-character + 'deletion-table '((#\z :meta))) (defun transpose-objects (mark) @@ -348,32 +416,35 @@ (insert-object mark object) (forward-object mark)))) -(define-named-command com-transpose-objects () +(define-command (com-transpose-objects :name t :command-table editing-table) () (transpose-objects (point (current-window)))) -(set-key 'com-transpose-objects 'global-climacs-table +(set-key 'com-transpose-objects + 'editing-table '((#\t :control))) -(define-named-command com-backward-object ((count 'integer :prompt "Number of Objects")) +(define-command (com-backward-object :name t :command-table movement-table) + ((count 'integer :prompt "Number of Objects")) (backward-object (point (current-window)) count)) (set-key `(com-backward-object ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\b :control))) (set-key `(com-backward-object ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((:left))) -(define-named-command com-forward-object ((count 'integer :prompt "Number of Objects")) +(define-command (com-forward-object :name t :command-table movement-table) + ((count 'integer :prompt "Number of Objects")) (forward-object (point (current-window)) count)) (set-key `(com-forward-object ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\f :control))) (set-key `(com-forward-object ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((:right))) (defun transpose-words (mark) @@ -399,10 +470,11 @@ (insert-sequence mark w2) (forward-word mark)))) -(define-named-command com-transpose-words () +(define-command (com-transpose-words :name t :command-table editing-table) () (transpose-words (point (current-window)))) -(set-key 'com-transpose-words 'global-climacs-table +(set-key 'com-transpose-words + 'editing-table '((#\t :meta))) (defun transpose-lines (mark) @@ -427,13 +499,15 @@ (insert-sequence mark line) (insert-object mark #\Newline))) -(define-named-command com-transpose-lines () +(define-command (com-transpose-lines :name t :command-table editing-table) () (transpose-lines (point (current-window)))) -(set-key 'com-transpose-lines 'global-climacs-table +(set-key 'com-transpose-lines + 'editing-table '((#\x :control) (#\t :control))) -(define-named-command com-previous-line ((numarg 'integer :prompt "How many lines?")) +(define-command (com-previous-line :name t :command-table movement-table) + ((numarg 'integer :prompt "How many lines?")) (let* ((window (current-window)) (point (point window))) (unless (or (eq (previous-command window) 'com-previous-line) @@ -444,14 +518,15 @@ (next-line point (slot-value window 'goal-column) (- numarg))))) (set-key `(com-previous-line ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\p :control))) (set-key `(com-previous-line ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((:up))) -(define-named-command com-next-line ((numarg 'integer :prompt "How many lines?")) +(define-command (com-next-line :name t :command-table movement-table) + ((numarg 'integer :prompt "How many lines?")) (let* ((window (current-window)) (point (point window))) (unless (or (eq (previous-command window) 'com-previous-line) @@ -462,18 +537,19 @@ (previous-line point (slot-value window 'goal-column) (- numarg))))) (set-key `(com-next-line ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\n :control))) (set-key `(com-next-line ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((:down))) -(define-named-command com-open-line ((numarg 'integer :prompt "How many lines?")) +(define-command (com-open-line :name t :command-table editing-table) + ((numarg 'integer :prompt "How many lines?")) (open-line (point (current-window)) numarg)) (set-key `(com-open-line ,*numeric-argument-marker*) - 'global-climacs-table + 'editing-table '((#\o :control))) (defun kill-line (mark &optional (count 1) (whole-lines-p nil) (concatenate-p nil)) @@ -504,42 +580,45 @@ (region-to-sequence start mark))) (delete-region start mark)))) -(define-named-command com-kill-line ((numarg 'integer :prompt "Kill how many lines?") - (numargp 'boolean :prompt "Kill entire lines?")) +(define-command (com-kill-line :name t :command-table deletion-table) + ((numarg 'integer :prompt "Kill how many lines?") + (numargp 'boolean :prompt "Kill entire lines?")) (let* ((pane (current-window)) (point (point pane)) (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 + 'deletion-table '((#\k :control))) -(define-named-command com-forward-word ((count 'integer :prompt "Number of words")) +(define-command (com-forward-word :name t :command-table movement-table) + ((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 + 'movement-table '((#\f :meta))) (set-key `(com-forward-word ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((:right :control))) -(define-named-command com-backward-word ((count 'integer :prompt "Number of words")) +(define-command (com-backward-word :name t :command-table movement-table) + ((count 'integer :prompt "Number of words")) (backward-word (point (current-window)) count)) (set-key `(com-backward-word ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\b :meta))) (set-key `(com-backward-word ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((:left :control))) -(define-named-command com-delete-word ((count 'integer :prompt "Number of words")) +(define-command (com-delete-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words")) (delete-word (point (current-window)) count)) (defun kill-word (mark &optional (count 1) (concatenate-p nil)) @@ -562,27 +641,30 @@ (region-to-sequence start mark))) (delete-region start mark)))) -(define-named-command com-kill-word ((count 'integer :prompt "Number of words")) +(define-command (com-kill-word :name t :command-table deletion-table) + ((count 'integer :prompt "Number of words")) (let* ((pane (current-window)) (point (point pane)) (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 + 'deletion-table '((#\d :meta))) -(define-named-command com-backward-kill-word ((count 'integer :prompt "Number of words")) +(define-command (com-backward-kill-word :name t :command-table deletion-table) + ((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 + 'deletion-table '((#\Backspace :meta))) -(define-named-command com-mark-word ((count 'integer :prompt "Number of words")) +(define-command (com-mark-word :name t :command-table marking-table) + ((count 'integer :prompt "Number of words")) (let* ((pane (current-window)) (point (point pane)) (mark (mark pane))) @@ -593,48 +675,52 @@ (backward-word mark (- count))))) (set-key `(com-mark-word ,*numeric-argument-marker*) - 'global-climacs-table + 'marking-table '((#\@ :meta :shift))) -(define-named-command com-backward-delete-word ((count 'integer :prompt "Number of words")) +(define-command (com-backward-delete-word :name t :command-table deletion-table) + ((count 'integer :prompt "Number of words")) (backward-delete-word (point (current-window)) count)) -(define-named-command com-upcase-region () +(define-command (com-upcase-region :name t :command-table case-table) () (let ((cw (current-window))) (upcase-region (mark cw) (point cw)))) -(define-named-command com-downcase-region () +(define-command (com-downcase-region :name t :command-table case-table) () (let ((cw (current-window))) (downcase-region (mark cw) (point cw)))) -(define-named-command com-capitalize-region () +(define-command (com-capitalize-region :name t :command-table case-table) () (let ((cw (current-window))) (capitalize-region (mark cw) (point cw)))) -(define-named-command com-upcase-word () +(define-command (com-upcase-word :name t :command-table case-table) () (upcase-word (point (current-window)))) -(set-key 'com-upcase-word 'global-climacs-table +(set-key 'com-upcase-word + 'case-table '((#\u :meta))) -(define-named-command com-downcase-word () +(define-command (com-downcase-word :name t :command-table case-table) () (downcase-word (point (current-window)))) -(set-key 'com-downcase-word 'global-climacs-table +(set-key 'com-downcase-word + 'case-table '((#\l :meta))) -(define-named-command com-capitalize-word () +(define-command (com-capitalize-word :name t :command-table case-table) () (capitalize-word (point (current-window)))) -(set-key 'com-capitalize-word 'global-climacs-table +(set-key 'com-capitalize-word + 'case-table '((#\c :meta))) -(define-named-command com-tabify-region () +(define-command (com-tabify-region :name t :command-table editing-table) () (let ((pane (current-window))) (tabify-region (mark pane) (point pane) (tab-space-count (stream-default-view pane))))) -(define-named-command com-untabify-region () +(define-command (com-untabify-region :name t :command-table editing-table) () (let ((pane (current-window))) (untabify-region (mark pane) (point pane) (tab-space-count (stream-default-view pane))))) @@ -649,37 +735,41 @@ (indent-line point indentation (and (indent-tabs-mode buffer) tab-space-count)))) -(define-named-command com-indent-line () +(define-command (com-indent-line :name t :command-table indent-table) () (let* ((pane (current-window)) (point (point pane))) (indent-current-line pane point))) -(set-key 'com-indent-line 'global-climacs-table +(set-key 'com-indent-line + 'indent-table '((#\Tab))) -(set-key 'com-indent-line 'global-climacs-table +(set-key 'com-indent-line + 'indent-table '((#\i :control))) -(define-named-command com-newline-and-indent () +(define-command (com-newline-and-indent :name t :command-table indent-table) () (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 +(set-key 'com-newline-and-indent + 'indent-table '((#\j :control))) -(define-named-command com-delete-indentation () +(define-command (com-delete-indentation :name t :command-table indent-table) () (delete-indentation (point (current-window)))) -(set-key 'com-delete-indentation 'global-climacs-table +(set-key 'com-delete-indentation + 'indent-table '((#\^ :shift :meta))) -(define-named-command com-auto-fill-mode () +(define-command (com-auto-fill-mode :name t :command-table fill-table) () (let ((pane (current-window))) (setf (auto-fill-mode pane) (not (auto-fill-mode pane))))) -(define-named-command com-fill-paragraph () +(define-command (com-fill-paragraph :name t :command-table fill-table) () (let* ((pane (current-window)) (buffer (buffer pane)) (syntax (syntax buffer)) @@ -699,7 +789,8 @@ (possibly-fill-line) (setf (offset point) (offset point-backup))))) -(set-key 'com-fill-paragraph 'global-climacs-table +(set-key 'com-fill-paragraph + 'fill-table '((#\q :meta))) (defun filename-completer (so-far mode) @@ -849,11 +940,12 @@ (redisplay-frame-panes *application-frame*) buffer)))))) -(define-named-command com-find-file () +(define-command (com-find-file :name t :command-table buffer-table) () (let* ((filepath (accept 'pathname :prompt "Find File"))) (find-file filepath))) -(set-key 'com-find-file 'global-climacs-table +(set-key 'com-find-file + 'buffer-table '((#\x :control) (#\f :control))) (defun find-file-read-only (filepath) @@ -892,18 +984,20 @@ (beep) nil))))))) -(define-named-command com-find-file-read-only () +(define-command (com-find-file-read-only :name t :command-table buffer-table) () (let ((filepath (accept 'pathname :Prompt "Find file read only"))) (find-file-read-only filepath))) -(set-key 'com-find-file-read-only 'global-climacs-table +(set-key 'com-find-file-read-only + 'buffer-table '((#\x :control) (#\r :control))) -(define-named-command com-toggle-read-only () +(define-command (com-read-only :name t :command-table buffer-table) () (let ((buffer (buffer (current-window)))) (setf (read-only-p buffer) (not (read-only-p buffer))))) -(set-key 'com-toggle-read-only 'global-climacs-table +(set-key 'com-read-only + 'buffer-table '((#\x :control) (#\q :control))) (defun set-visited-file-name (filename buffer) @@ -911,11 +1005,11 @@ (name buffer) (filepath-filename filename) (needs-saving buffer) t)) -(define-named-command com-set-visited-file-name () +(define-command (com-set-visited-file-name :name t :command-table buffer-table) () (let ((filename (accept 'pathname :prompt "New file name"))) (set-visited-file-name filename (buffer (current-window))))) -(define-named-command com-insert-file () +(define-command (com-insert-file :name t :command-table buffer-table) () (let ((filename (accept 'pathname :prompt "Insert File")) (pane (current-window))) (when (probe-file filename) @@ -928,7 +1022,8 @@ (offset (point pane)) (offset (mark pane)))) (redisplay-frame-panes *application-frame*))) -(set-key 'com-insert-file 'global-climacs-table +(set-key 'com-insert-file + 'buffer-table '((#\x :control) (#\i :control))) (defgeneric erase-buffer (buffer)) @@ -945,7 +1040,7 @@ (end-of-buffer point) (delete-region mark point))) -(define-named-command com-revert-buffer () +(define-command (com-revert-buffer :name t :command-table buffer-table) () (let* ((pane (current-window)) (buffer (buffer pane)) (filepath (filepath buffer)) @@ -985,14 +1080,15 @@ (display-message "Wrote: ~a" (filepath buffer)) (setf (needs-saving buffer) nil))))) -(define-named-command com-save-buffer () +(define-command (com-save-buffer :name t :command-table buffer-table) () (let ((buffer (buffer (current-window)))) (if (or (null (filepath buffer)) (needs-saving buffer)) (save-buffer buffer) (display-message "No changes need to be saved from ~a" (name buffer))))) -(set-key 'com-save-buffer 'global-climacs-table +(set-key 'com-save-buffer + 'buffer-table '((#\x :control) (#\s :control))) (defmethod frame-exit :around ((frame climacs)) @@ -1013,7 +1109,7 @@ (return-from frame-exit nil))))) (call-next-method))) -(define-named-command com-write-buffer () +(define-command (com-write-buffer :name t :command-table buffer-table) () (let ((filepath (accept 'pathname :prompt "Write Buffer to File")) (buffer (buffer (current-window)))) (cond @@ -1027,7 +1123,8 @@ (needs-saving buffer) nil) (display-message "Wrote: ~a" (filepath buffer)))))) -(set-key 'com-write-buffer 'global-climacs-table +(set-key 'com-write-buffer + 'buffer-table '((#\x :control) (#\w :control))) (define-presentation-method present (object (type buffer) @@ -1079,14 +1176,15 @@ (defmethod switch-to-buffer ((symbol (eql 'nil))) (switch-to-buffer (second (buffers *application-frame*)))) -(define-named-command com-switch-to-buffer () +(define-command (com-switch-to-buffer :name t :command-table pane-table) () (let ((buffer (accept 'buffer :prompt "Switch to buffer" :default (second (buffers *application-frame*)) :default-type 'buffer))) (switch-to-buffer buffer))) -(set-key 'com-switch-to-buffer 'global-climacs-table +(set-key 'com-switch-to-buffer + 'pane-table '((#\x :control) (#\b))) (defgeneric kill-buffer (buffer)) @@ -1113,20 +1211,22 @@ (defmethod kill-buffer ((symbol (eql 'nil))) (kill-buffer (buffer (current-window)))) -(define-named-command com-kill-buffer () +(define-command (com-kill-buffer :name t :command-table pane-table) () (let ((buffer (accept 'buffer :prompt "Kill buffer" :default (buffer (current-window)) :default-type 'buffer))) (kill-buffer buffer))) -(set-key 'com-kill-buffer 'global-climacs-table +(set-key 'com-kill-buffer + 'pane-table '((#\x :control) (#\k))) -(define-named-command com-full-redisplay () +(define-command (com-full-redisplay :name t :command-table base-table) () (full-redisplay (current-window))) -(set-key 'com-full-redisplay 'global-climacs-table +(set-key 'com-full-redisplay + 'base-table '((#\l :control))) (defun load-file (file-name) @@ -1140,56 +1240,66 @@ (display-message "No such file: ~A" file-name) (beep)))))) -(define-named-command com-load-file () +(define-command (com-load-file :name t :command-table base-table) () (let ((filepath (accept 'pathname :prompt "Load File"))) (load-file filepath))) -(set-key 'com-load-file 'global-climacs-table +(set-key 'com-load-file + 'base-table '((#\c :control) (#\l :control))) -(define-named-command com-beginning-of-buffer () +(define-command (com-beginning-of-buffer :name t :command-table movement-table) () (beginning-of-buffer (point (current-window)))) -(set-key 'com-beginning-of-buffer 'global-climacs-table +(set-key 'com-beginning-of-buffer + 'movement-table '((#\< :shift :meta))) -(set-key 'com-beginning-of-buffer 'global-climacs-table +(set-key 'com-beginning-of-buffer + 'movement-table '((:home :control))) -(define-named-command com-page-down () +(define-command (com-page-down :name t :command-table movement-table) () (let ((pane (current-window))) (page-down pane))) -(set-key 'com-page-down 'global-climacs-table +(set-key 'com-page-down + 'movement-table '((#\v :control))) -(set-key 'com-page-down 'global-climacs-table +(set-key 'com-page-down + 'movement-table '((:next))) -(define-named-command com-page-up () +(define-command (com-page-up :name t :command-table movement-table) () (let ((pane (current-window))) (page-up pane))) -(set-key 'com-page-up 'global-climacs-table +(set-key 'com-page-up + 'movement-table '((#\v :meta))) -(set-key 'com-page-up 'global-climacs-table +(set-key 'com-page-up + 'movement-table '((:prior))) -(define-named-command com-end-of-buffer () +(define-command (com-end-of-buffer :name t :command-table movement-table) () (end-of-buffer (point (current-window)))) -(set-key 'com-end-of-buffer 'global-climacs-table +(set-key 'com-end-of-buffer + 'movement-table '((#\> :shift :meta))) -(set-key 'com-end-of-buffer 'global-climacs-table +(set-key 'com-end-of-buffer + 'movement-table '((:end :control))) -(define-named-command com-mark-whole-buffer () +(define-command (com-mark-whole-buffer :name t :command-table marking-table) () (beginning-of-buffer (point (current-window))) (end-of-buffer (mark (current-window)))) -(set-key 'com-mark-whole-buffer 'global-climacs-table +(set-key 'com-mark-whole-buffer + 'marking-table '((#\x :control) (#\h))) (defun back-to-indentation (mark) @@ -1198,10 +1308,11 @@ while (whitespacep (object-after mark)) do (forward-object mark))) -(define-named-command com-back-to-indentation () +(define-command (com-back-to-indentation :name t :command-table movement-table) () (back-to-indentation (point (current-window)))) -(set-key 'com-back-to-indentation 'global-climacs-table +(set-key 'com-back-to-indentation + 'movement-table '((#\m :meta))) (defun delete-horizontal-space (mark &optional (backward-only-p nil)) @@ -1215,12 +1326,13 @@ do (forward-object mark2))) (delete-region mark mark2))) -(define-named-command com-delete-horizontal-space ((backward-only-p - 'boolean :prompt "Delete backwards only?")) +(define-command (com-delete-horizontal-space :name t :command-table deletion-table) + ((backward-only-p + '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 + 'deletion-table '((#\\ :meta))) (defun just-one-space (mark count) @@ -1237,17 +1349,18 @@ do (forward-object mark)) (delete-region offset mark))) -(define-named-command com-just-one-space ((count 'integer :prompt "Number of spaces")) +(define-command (com-just-one-space :name t :command-table deletion-table) + ((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 + 'deletion-table '((#\Space :meta))) (defun goto-position (mark pos) (setf (offset mark) pos)) -(define-named-command com-goto-position () +(define-command (com-goto-position :name t :command-table movement-table) () (goto-position (point (current-window)) (handler-case (accept 'integer :prompt "Goto Position") @@ -1267,33 +1380,35 @@ finally (beginning-of-line m) (setf (offset mark) (offset m)))) -(define-named-command com-goto-line () +(define-command (com-goto-line :name t :command-table movement-table) () (goto-line (point (current-window)) (handler-case (accept 'integer :prompt "Goto Line") (error () (progn (beep) (display-message "Not a valid line number") (return-from com-goto-line nil)))))) -(define-named-command com-browse-url () +(define-command (com-browse-url :name t :command-table base-table) () (let ((url (accept 'url :prompt "Browse URL"))) #+ (and sbcl darwin) (sb-ext:run-program "/usr/bin/open" `(,url) :wait nil) #+ (and openmcl darwin) (ccl:run-program "/usr/bin/open" `(,url) :wait nil))) -(define-named-command com-set-mark () +(define-command (com-set-mark :name t :command-table marking-table) () (let ((pane (current-window))) (setf (mark pane) (clone-mark (point pane))))) -(set-key 'com-set-mark 'global-climacs-table +(set-key 'com-set-mark + 'marking-table '((#\Space :control))) -(define-named-command com-exchange-point-and-mark () +(define-command (com-exchange-point-and-mark :name t :command-table marking-table) () (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 +(set-key 'com-exchange-point-and-mark + 'marking-table '((#\x :control) (#\x :control))) (defgeneric set-syntax (buffer syntax)) @@ -1314,7 +1429,7 @@ (beep) (display-message "No such syntax: ~A." syntax))))) -(define-named-command com-set-syntax () +(define-command (com-set-syntax :name t :command-table buffer-table) () (let* ((pane (current-window)) (buffer (buffer pane))) (set-syntax buffer (accept 'syntax :prompt "Set Syntax")))) @@ -1334,9 +1449,9 @@ (sheet-disown-child parent constellation) (let ((new (if vertical-p (vertically () - (1/2 constellation) adjust (1/2 additional-constellation)) + constellation adjust additional-constellation) (horizontally () - (1/2 constellation) adjust (1/2 additional-constellation))))) + constellation adjust additional-constellation)))) (sheet-adopt-child parent new) (reorder-sheets parent (if (eq constellation first) @@ -1347,16 +1462,56 @@ (list first second new) (list first new))))))) -(defun parent3 (sheet) - (sheet-parent (sheet-parent (sheet-parent sheet)))) +(defun find-parent (sheet) + (loop for parent = (sheet-parent sheet) + then (sheet-parent parent) + until (typep parent 'vrack-pane) + finally (return parent))) + +(defclass typeout-pane (application-pane esa-pane-mixin) ()) + +(defun make-typeout-constellation (&optional label) + (let* ((typeout-pane + (make-pane 'typeout-pane :width 900 :height 400 :display-time nil)) + (label + (make-pane 'label-pane :label label)) + (vbox + (vertically () + (scrolling (:scroll-bar :vertical) typeout-pane) label))) + (values vbox typeout-pane))) + +(defun typeout-window (&optional (label "Typeout") (pane (current-window))) + (with-look-and-feel-realization + ((frame-manager *application-frame*) *application-frame*) + (multiple-value-bind (vbox new-pane) (make-typeout-constellation label) + (let* ((current-window pane) + (constellation-root (find-parent current-window))) + (push new-pane (windows *application-frame*)) + (other-window) + (replace-constellation constellation-root vbox t) + (full-redisplay current-window) + new-pane)))) -(defun make-pane-constellation () +(define-command (com-describe-bindings :name t :command-table help-table) + ((sort-by-keystrokes 'boolean :prompt "Sort by keystrokes?")) + (let* ((window (current-window)) + (buffer (buffer (current-window))) + (stream (typeout-window + (format nil "~10THelp: Describe Bindings for ~A" (name buffer)))) + (command-table (command-table window))) + (esa::describe-bindings stream command-table + (if sort-by-keystrokes + #'esa::sort-by-keystrokes + #'esa::sort-by-name)))) + +(set-key `(com-describe-bindings ,*numeric-argument-p*) 'help-table '((#\h :control) (#\b))) + +(defun make-pane-constellation (&optional (with-scrollbars *with-scrollbars*)) "make a vbox containing a scroller pane as its first child and an info pane as its second child. The scroller pane contains a viewport which contains an extended pane. Return the vbox and the extended pane as two values. -If *with-scrollbars* nil, omit the scroller." - +If with-scrollbars nil, omit the scroller." (let* ((extended-pane (make-pane 'extended-pane :width 900 :height 400 @@ -1367,7 +1522,7 @@ :command-table 'global-climacs-table)) (vbox (vertically () - (if *with-scrollbars* + (if with-scrollbars (scrolling () extended-pane) extended-pane) @@ -1376,68 +1531,79 @@ :width 900)))) (values vbox extended-pane))) -(defun split-window-vertically (&optional (pane (current-window))) +(defun split-window (&optional (vertically-p nil) (pane (current-window))) (with-look-and-feel-realization ((frame-manager *application-frame*) *application-frame*) (multiple-value-bind (vbox new-pane) (make-pane-constellation) (let* ((current-window pane) - (constellation-root (if *with-scrollbars* - (parent3 current-window) - (sheet-parent current-window)))) + (constellation-root (find-parent current-window))) (setf (offset (point (buffer current-window))) (offset (point current-window)) (buffer new-pane) (buffer current-window) (auto-fill-mode new-pane) (auto-fill-mode current-window) (auto-fill-column new-pane) (auto-fill-column current-window)) (push new-pane (windows *application-frame*)) (setf *standard-output* new-pane) - (replace-constellation constellation-root vbox t) + (replace-constellation constellation-root vbox vertically-p) (full-redisplay current-window) (full-redisplay new-pane) new-pane)))) -(define-named-command com-split-window-vertically () - (split-window-vertically)) +(define-command (com-split-window-vertically :name t :command-table window-table) () + (split-window t)) -(set-key 'com-split-window-vertically 'global-climacs-table +(set-key 'com-split-window-vertically + 'window-table '((#\x :control) (#\2))) -(defun split-window-horizontally (&optional (pane (current-window))) - (with-look-and-feel-realization - ((frame-manager *application-frame*) *application-frame*) - (multiple-value-bind (vbox new-pane) (make-pane-constellation) - (let* ((current-window pane) - (constellation-root (if *with-scrollbars* - (parent3 current-window) - (sheet-parent current-window)))) - (setf (offset (point (buffer current-window))) (offset (point current-window)) - (buffer new-pane) (buffer current-window) - (auto-fill-mode new-pane) (auto-fill-mode current-window) - (auto-fill-column new-pane) (auto-fill-column current-window)) - (push new-pane (windows *application-frame*)) - (setf *standard-output* new-pane) - (replace-constellation constellation-root vbox nil) - (full-redisplay current-window) - (full-redisplay new-pane) - new-pane)))) - -(define-named-command com-split-window-horizontally () - (split-window-horizontally)) +(define-command (com-split-window-horizontally :name t :command-table window-table) () + (split-window)) -(set-key 'com-split-window-horizontally 'global-climacs-table +(set-key 'com-split-window-horizontally + 'window-table '((#\x :control) (#\3))) -(defun other-window () - (setf (windows *application-frame*) - (append (cdr (windows *application-frame*)) - (list (car (windows *application-frame*))))) +(defun other-window (&optional pane) + (if (and pane (find pane (windows *application-frame*))) + (setf (windows *application-frame*) + (append (list pane) + (remove pane (windows *application-frame*)))) + (setf (windows *application-frame*) + (append (cdr (windows *application-frame*)) + (list (car (windows *application-frame*)))))) (setf *standard-output* (car (windows *application-frame*)))) - -(define-named-command com-other-window () + +(define-command (com-other-window :name t :command-table window-table) () (other-window)) -(set-key 'com-other-window 'global-climacs-table +(set-key 'com-other-window + 'window-table '((#\x :control) (#\o))) +(define-command (com-switch-to-this-window :name nil :command-table window-table) + ((window 'pane) (x 'integer) (y 'integer)) + (other-window window) + (with-slots (top bot) window + (let ((new-x (floor x (stream-character-width window #\m))) + (new-y (floor y (stream-line-height window))) + (buffer (buffer window))) + (loop for scan from (offset top) + with lines = 0 + until (= scan (offset bot)) + until (= lines new-y) + when (eql (buffer-object buffer scan) #\Newline) + do (incf lines) + finally (loop for columns from 0 + until (= scan (offset bot)) + until (eql (buffer-object buffer scan) #\Newline) + until (= columns new-x) + do (incf scan)) + (setf (offset (point window)) scan))))) + +(define-presentation-to-command-translator blank-area-to-switch-to-this-window + (blank-area com-switch-to-this-window window-table :echo nil) + (object window x y) + (list window x y)) + (defun single-window () (loop until (null (cdr (windows *application-frame*))) do (rotatef (car (windows *application-frame*)) @@ -1445,33 +1611,34 @@ (com-delete-window)) (setf *standard-output* (car (windows *application-frame*)))) -(define-named-command com-single-window () +(define-command (com-single-window :name t :command-table window-table) () (single-window)) -(set-key 'com-single-window 'global-climacs-table +(set-key 'com-single-window + 'window-table '((#\x :control) (#\1))) -(define-named-command com-scroll-other-window () +(define-command (com-scroll-other-window :name t :command-table window-table) () (let ((other-window (second (windows *application-frame*)))) (when other-window (page-down other-window)))) -(set-key 'com-scroll-other-window 'global-climacs-table +(set-key 'com-scroll-other-window + 'window-table '((#\v :control :meta))) -(define-named-command com-scroll-other-window-up () +(define-command (com-scroll-other-window-up :name t :command-table window-table) () (let ((other-window (second (windows *application-frame*)))) (when other-window (page-up other-window)))) -(set-key 'com-scroll-other-window-up 'global-climacs-table +(set-key 'com-scroll-other-window-up + 'window-table '((#\V :control :meta :shift))) (defun delete-window (&optional (window (current-window))) (unless (null (cdr (windows *application-frame*))) - (let* ((constellation (if *with-scrollbars* - (parent3 window) - (sheet-parent window))) + (let* ((constellation (find-parent window)) (box (sheet-parent constellation)) (box-children (sheet-children box)) (other (if (eq constellation (first box-children)) @@ -1496,41 +1663,45 @@ (list first second other) (list first other))))))) -(define-named-command com-delete-window () +(define-command (com-delete-window :name t :command-table window-table) () (delete-window)) -(set-key 'com-delete-window 'global-climacs-table +(set-key 'com-delete-window + 'window-table '((#\x :control) (#\0))) ;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands ;; Copies an element from a kill-ring to a buffer at the given offset -(define-named-command com-yank () +(define-command (com-yank :name t :command-table editing-table) () (insert-sequence (point (current-window)) (kill-ring-yank *kill-ring*))) -(set-key 'com-yank 'global-climacs-table +(set-key 'com-yank + 'editing-table '((#\y :control))) ;; Destructively cut a given buffer region into the kill-ring -(define-named-command com-kill-region () +(define-command (com-kill-region :name t :command-table editing-table) () (let ((pane (current-window))) (kill-ring-standard-push *kill-ring* (region-to-sequence (mark pane) (point pane))) (delete-region (mark pane) (point pane)))) -(set-key 'com-kill-region 'global-climacs-table +(set-key 'com-kill-region + 'editing-table '((#\w :control))) ;; Non destructively copies buffer region to the kill ring -(define-named-command com-copy-region () +(define-command (com-copy-region :name t :command-table marking-table) () (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 +(set-key 'com-copy-region + 'marking-table '((#\w :meta))) -(define-named-command com-rotate-yank () +(define-command (com-rotate-yank :name t :command-table editing-table) () (let* ((pane (current-window)) (point (point pane)) (last-yank (kill-ring-yank *kill-ring*))) @@ -1541,20 +1712,22 @@ (rotate-yank-position *kill-ring*))) (insert-sequence point (kill-ring-yank *kill-ring*)))) -(set-key 'com-rotate-yank 'global-climacs-table +(set-key 'com-rotate-yank + 'editing-table '((#\y :meta))) -(define-named-command com-resize-kill-ring () +(define-command (com-resize-kill-ring :name t :command-table editing-table) () (let ((size (handler-case (accept 'integer :prompt "New kill ring size") (error () (progn (beep) (display-message "Not a valid kill ring size") (return-from com-resize-kill-ring nil)))))) (setf (kill-ring-max-size *kill-ring*) size))) -(define-named-command com-append-next-kill () +(define-command (com-append-next-kill :name t :command-table editing-table) () (setf (append-next-p *kill-ring*) t)) -(set-key 'com-append-next-kill 'global-climacs-table +(set-key 'com-append-next-kill + 'editing-table '((#\w :control :meta))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1606,18 +1779,20 @@ (unless success (beep))))) -(define-named-command com-isearch-forward () +(define-command (com-isearch-forward :name t :command-table search-table) () (display-message "Isearch: ") (isearch-command-loop (current-window) t)) -(set-key 'com-isearch-forward 'global-climacs-table +(set-key 'com-isearch-forward + 'search-table '((#\s :control))) -(define-named-command com-isearch-backward () +(define-command (com-isearch-backward :name t :command-table search-table) () (display-message "Isearch backward: ") (isearch-command-loop (current-window) nil)) -(set-key 'com-isearch-backward 'global-climacs-table +(set-key 'com-isearch-backward + 'search-table '((#\r :control))) (define-command (com-isearch-append-char :name t :command-table isearch-climacs-table) () @@ -1703,7 +1878,7 @@ (search-forward mark string :test #'object-equal) (/= (offset mark) offset-before)))) -(define-named-command com-query-replace () +(define-command (com-query-replace :name t :command-table search-table) () (let* ((pane (current-window)) (old-state (query-replace-state pane)) (old-string1 (when old-state (string1 old-state))) @@ -1745,7 +1920,8 @@ ((setf (query-replace-mode pane) nil)))) (display-message "Replaced ~A occurrence~:P" occurrences))) -(set-key 'com-query-replace 'global-climacs-table +(set-key 'com-query-replace + 'search-table '((#\% :shift :meta))) (define-command (com-query-replace-replace :name t :command-table query-replace-climacs-table) () @@ -1800,33 +1976,37 @@ ;;; ;;; Undo/redo -(define-named-command com-undo () +(define-command (com-undo :name t :command-table editing-table) () (handler-case (undo (undo-tree (buffer (current-window)))) (no-more-undo () (beep) (display-message "No more undo"))) (full-redisplay (current-window))) -(set-key 'com-undo 'global-climacs-table +(set-key 'com-undo + 'editing-table '((#\_ :shift :control))) -(set-key 'com-undo 'global-climacs-table +(set-key 'com-undo + 'editing-table '((#\x :control) (#\u))) -(define-named-command com-redo () +(define-command (com-redo :name t :command-table editing-table) () (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 +(set-key 'com-redo + 'editing-table '((#\_ :shift :meta))) -(set-key 'com-redo 'global-climacs-table +(set-key 'com-redo + 'editing-table '((#\x :control) (#\r :control))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Dynamic abbrevs -(define-named-command com-dabbrev-expand () +(define-command (com-dabbrev-expand :name t :command-table editing-table) () (let* ((window (current-window)) (point (point window))) (with-slots (original-prefix prefix-start-offset dabbrev-expansion-mark) window @@ -1863,10 +2043,12 @@ (setf (offset dabbrev-expansion-mark) offset)))) (move)))))))) -(set-key 'com-dabbrev-expand 'global-climacs-table +(set-key 'com-dabbrev-expand + 'editing-table '((#\/ :meta))) -(define-named-command com-backward-paragraph ((count 'integer :prompt "Number of paragraphs")) +(define-command (com-backward-paragraph :name t :command-table movement-table) + ((count 'integer :prompt "Number of paragraphs")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -1875,10 +2057,11 @@ (loop repeat (- count) do (forward-paragraph point syntax))))) (set-key `(com-backward-paragraph ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\{ :shift :meta))) -(define-named-command com-forward-paragraph ((count 'integer :prompt "Number of paragraphs")) +(define-command (com-forward-paragraph :name t :command-table movement-table) + ((count 'integer :prompt "Number of paragraphs")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -1887,10 +2070,11 @@ (loop repeat (- count) do (backward-paragraph point syntax))))) (set-key `(com-forward-paragraph ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\} :shift :meta))) -(define-named-command com-mark-paragraph ((count 'integer :prompt "Number of paragraphs")) +(define-command (com-mark-paragraph :name t :command-table marking-table) + ((count 'integer :prompt "Number of paragraphs")) (let* ((pane (current-window)) (point (point pane)) (mark (mark pane)) @@ -1905,10 +2089,11 @@ (loop repeat (- count) do (backward-paragraph mark syntax))))) (set-key `(com-mark-paragraph ,*numeric-argument-marker*) - 'global-climacs-table + 'marking-table '((#\h :meta))) -(define-named-command com-backward-sentence ((count 'integer :prompt "Number of sentences")) +(define-command (com-backward-sentence :name t :command-table movement-table) + ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -1917,10 +2102,11 @@ (loop repeat (- count) do (forward-sentence point syntax))))) (set-key `(com-backward-sentence ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\a :meta))) -(define-named-command com-forward-sentence ((count 'integer :prompt "Number of sentences")) +(define-command (com-forward-sentence :name t :command-table movement-table) + ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -1929,10 +2115,11 @@ (loop repeat (- count) do (backward-sentence point syntax))))) (set-key `(com-forward-sentence ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\e :meta))) -(define-named-command com-kill-sentence ((count 'integer :prompt "Number of sentences")) +(define-command (com-kill-sentence :name t :command-table deletion-table) + ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) (mark (clone-mark point)) @@ -1944,10 +2131,11 @@ (delete-region point mark))) (set-key `(com-kill-sentence ,*numeric-argument-marker*) - 'global-climacs-table + 'deletion-table '((#\k :meta))) -(define-named-command com-backward-kill-sentence ((count 'integer :prompt "Number of sentences")) +(define-command (com-backward-kill-sentence :name t :command-table deletion-table) + ((count 'integer :prompt "Number of sentences")) (let* ((pane (current-window)) (point (point pane)) (mark (clone-mark point)) @@ -1959,7 +2147,7 @@ (delete-region point mark))) (set-key `(com-backward-kill-sentence ,*numeric-argument-marker*) - 'global-climacs-table + 'deletion-table '((#\x :control) (#\Backspace))) (defun forward-page (mark &optional (count 1)) @@ -1968,7 +2156,8 @@ do (end-of-buffer mark) (loop-finish))) -(define-named-command com-forward-page ((count 'integer :prompt "Number of pages")) +(define-command (com-forward-page :name t :command-table movement-table) + ((count 'integer :prompt "Number of pages")) (let* ((pane (current-window)) (point (point pane))) (if (plusp count) @@ -1976,7 +2165,7 @@ (backward-page point count)))) (set-key `(com-forward-page ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\x :control) (#\]))) (defun backward-page (mark &optional (count 1)) @@ -1986,18 +2175,21 @@ else do (beginning-of-buffer mark) (loop-finish))) -(define-named-command com-backward-page ((count 'integer :prompt "Number of pages")) +(define-command (com-backward-page :name t :command-table movement-table) + ((count 'integer :prompt "Number of pages")) (let* ((pane (current-window)) (point (point pane))) (if (plusp count) (backward-page point count) (forward-page point count)))) -(set-key `(com-backward-page ,*numeric-argument-marker*) 'global-climacs-table +(set-key `(com-backward-page ,*numeric-argument-marker*) + 'movement-table '((#\x :control) (#\[))) -(define-named-command com-mark-page ((count 'integer :prompt "Move how many pages") - (numargp 'boolean :prompt "Move to another page?")) +(define-command (com-mark-page :name t :command-table marking-table) + ((count 'integer :prompt "Move how many pages") + (numargp 'boolean :prompt "Move to another page?")) (let* ((pane (current-window)) (point (point pane)) (mark (mark pane))) @@ -2010,10 +2202,10 @@ (forward-page mark 1))) (set-key `(com-mark-page ,*numeric-argument-marker* ,*numeric-argument-p*) - 'global-climacs-table + 'marking-table '((#\x :control) (#\p :control))) -(define-named-command com-count-lines-page () +(define-command (com-count-lines-page :name t :command-table info-table) () (let* ((pane (current-window)) (point (point pane)) (start (clone-mark point)) @@ -2025,10 +2217,11 @@ (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 +(set-key 'com-count-lines-page + 'info-table '((#\x :control) (#\l))) -(define-named-command com-count-lines-region () +(define-command (com-count-lines-region :name t :command-table info-table) () (let* ((pane (current-window)) (point (point pane)) (mark (mark pane)) @@ -2036,10 +2229,11 @@ (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 +(set-key 'com-count-lines-region + 'info-table '((#\= :meta))) -(define-named-command com-what-cursor-position () +(define-command (com-what-cursor-position :name t :command-table info-table) () (let* ((pane (current-window)) (point (point pane)) (buffer (buffer pane)) @@ -2051,10 +2245,12 @@ char (char-code char) offset size (round (* 100 (/ offset size))) column))) -(set-key 'com-what-cursor-position 'global-climacs-table +(set-key 'com-what-cursor-position + 'info-table '((#\x :control) (#\=))) -(define-named-command com-eval-expression ((insertp 'boolean :prompt "Insert?")) +(define-command (com-eval-expression :name t :command-table base-table) + ((insertp 'boolean :prompt "Insert?")) (let* ((*package* (find-package :climacs-gui)) (string (handler-case (accept 'string :prompt "Eval") (error () (progn (beep) @@ -2071,7 +2267,7 @@ (display-message result)))) (set-key `(com-eval-expression ,*numeric-argument-p*) - 'global-climacs-table + 'base-table '((#\: :shift :meta))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2079,14 +2275,15 @@ ;;; Commenting ;;; figure out how to make commands without key bindings accept numeric arguments. -(define-named-command com-comment-region () +(define-command (com-comment-region :name t :command-table comment-table) () (let* ((pane (current-window)) (point (point pane)) (mark (mark pane)) (syntax (syntax (buffer pane)))) (comment-region syntax point mark))) -(define-named-command com-backward-expression ((count 'integer :prompt "Number of expressions")) +(define-command (com-backward-expression :name t :command-table movement-table) + ((count 'integer :prompt "Number of expressions")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2095,10 +2292,11 @@ (loop repeat (- count) do (forward-expression point syntax))))) (set-key `(com-backward-expression ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\b :control :meta))) -(define-named-command com-forward-expression ((count 'integer :prompt "Number of expresssions")) +(define-command (com-forward-expression :name t :command-table movement-table) + ((count 'integer :prompt "Number of expresssions")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2107,10 +2305,11 @@ (loop repeat (- count) do (backward-expression point syntax))))) (set-key `(com-forward-expression ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\f :control :meta))) -(define-named-command com-mark-expression ((count 'integer :prompt "Number of expressions")) +(define-command (com-mark-expression :name t :command-table marking-table) + ((count 'integer :prompt "Number of expressions")) (let* ((pane (current-window)) (point (point pane)) (mark (mark pane)) @@ -2122,10 +2321,11 @@ (loop repeat (- count) do (backward-expression mark syntax))))) (set-key `(com-mark-expression ,*numeric-argument-marker*) - 'global-climacs-table + 'marking-table '((#\@ :shift :control :meta))) -(define-named-command com-kill-expression ((count 'integer :prompt "Number of expressions")) +(define-command (com-kill-expression :name t :command-table deletion-table) + ((count 'integer :prompt "Number of expressions")) (let* ((pane (current-window)) (point (point pane)) (mark (clone-mark point)) @@ -2137,10 +2337,10 @@ (delete-region mark point))) (set-key `(com-kill-expression ,*numeric-argument-marker*) - 'global-climacs-table + 'deletion-table '((#\k :control :meta))) -(define-named-command com-backward-kill-expression +(define-command (com-backward-kill-expression :name t :command-table deletion-table) ((count 'integer :prompt "Number of expressions")) (let* ((pane (current-window)) (point (point pane)) @@ -2153,10 +2353,50 @@ (delete-region mark point))) (set-key `(com-backward-kill-expression ,*numeric-argument-marker*) - 'global-climacs-table + 'deletion-table '((#\Backspace :control :meta))) -(define-named-command com-forward-list ((count 'integer :prompt "Number of lists")) +;; (defparameter *insert-pair-alist* +;; '((#\( #\)) (#\[ #\]) (#\{ #\}) (#\< #\>) (#\" #\") (#\' #\') (#\` #\'))) + +(defun insert-pair (mark syntax &optional (count 0) (open #\() (close #\))) + (cond ((> count 0) + (loop while (and (not (end-of-buffer-p mark)) + (whitespacep (object-after mark))) + do (forward-object mark))) + ((< count 0) + (setf count (- count)) + (loop repeat count do (backward-expression mark syntax)))) + (unless (or (beginning-of-buffer-p mark) + (whitespacep (object-before mark))) + (insert-object mark #\Space)) + (insert-object mark open) + (let ((here (clone-mark mark))) + (loop repeat count + do (forward-expression here syntax)) + (insert-object here close) + (unless (or (end-of-buffer-p here) + (whitespacep (object-after here))) + (insert-object here #\Space)))) + +(defun insert-parentheses (mark syntax count) + (insert-pair mark syntax count #\( #\))) + +(define-command (com-insert-parentheses :name t :command-table editing-table) + ((count 'integer :prompt "Number of expressions") + (wrap-p 'boolean :prompt "Wrap expressions?")) + (let* ((pane (current-window)) + (point (point pane)) + (syntax (syntax (buffer pane)))) + (unless wrap-p (setf count 0)) + (insert-parentheses point syntax count))) + +(set-key `(com-insert-parentheses ,*numeric-argument-marker* ,*numeric-argument-p*) + 'editing-table + '((#\( :meta))) + +(define-command (com-forward-list :name t :command-table movement-table) + ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2165,10 +2405,11 @@ (loop repeat (- count) do (backward-list point syntax))))) (set-key `(com-forward-list ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\n :control :meta))) -(define-named-command com-backward-list ((count 'integer :prompt "Number of lists")) +(define-command (com-backward-list :name t :command-table movement-table) + ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2177,10 +2418,11 @@ (loop repeat (- count) do (forward-list point syntax))))) (set-key `(com-backward-list ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\p :control :meta))) -(define-named-command com-down-list ((count 'integer :prompt "Number of lists")) +(define-command (com-down-list :name t :command-table movement-table) + ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2189,10 +2431,11 @@ (loop repeat (- count) do (backward-down-list point syntax))))) (set-key `(com-down-list ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\d :control :meta))) -(define-named-command com-backward-down-list ((count 'integer :prompt "Number of lists")) +(define-command (com-backward-down-list :name t :command-table movement-table) + ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2200,7 +2443,8 @@ (loop repeat count do (backward-down-list point syntax)) (loop repeat (- count) do (down-list point syntax))))) -(define-named-command com-backward-up-list ((count 'integer :prompt "Number of lists")) +(define-command (com-backward-up-list :name t :command-table movement-table) + ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2209,10 +2453,10 @@ (loop repeat (- count) do (up-list point syntax))))) (set-key `(com-backward-up-list ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\u :control :meta))) -(define-named-command com-up-list ((count 'integer :prompt "Number of lists")) +(define-command (com-up-list :name t :command-table movement-table) ((count 'integer :prompt "Number of lists")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2220,16 +2464,18 @@ (loop repeat count do (up-list point syntax)) (loop repeat (- count) do (backward-up-list point syntax))))) -(define-named-command com-eval-defun () +(define-command (com-eval-defun :name t :command-table lisp-table) () (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) (eval-defun point syntax))) -(set-key 'com-eval-defun 'global-climacs-table +(set-key 'com-eval-defun + 'lisp-table '((#\x :control :meta))) -(define-named-command com-beginning-of-definition ((count 'integer :prompt "Number of definitions")) +(define-command (com-beginning-of-definition :name t :command-table movement-table) + ((count 'integer :prompt "Number of definitions")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2238,10 +2484,11 @@ (loop repeat (- count) do (end-of-definition point syntax))))) (set-key `(com-beginning-of-definition ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\a :control :meta))) -(define-named-command com-end-of-definition ((count 'integer :prompt "Number of definitions")) +(define-command (com-end-of-definition :name t :command-table movement-table) + ((count 'integer :prompt "Number of definitions")) (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -2250,10 +2497,10 @@ (loop repeat (- count) do (beginning-of-definition point syntax))))) (set-key `(com-end-of-definition ,*numeric-argument-marker*) - 'global-climacs-table + 'movement-table '((#\e :control :meta))) -(define-named-command com-mark-definition () +(define-command (com-mark-definition :name t :command-table marking-table) () (let* ((pane (current-window)) (point (point pane)) (mark (mark pane)) @@ -2263,10 +2510,11 @@ (setf (offset mark) (offset point))) (end-of-definition mark syntax))) -(set-key 'com-mark-definition 'global-climacs-table +(set-key 'com-mark-definition + 'marking-table '((#\h :control :meta))) -(define-named-command com-package () +(define-command (com-package :name t :command-table lisp-table) () (let* ((pane (current-window)) (syntax (syntax (buffer pane))) (package (climacs-lisp-syntax::package-of syntax))) @@ -2276,22 +2524,22 @@ ;;; ;;; For testing purposes -(define-named-command com-reset-profile () +(define-command (com-reset-profile :name t :command-table development-table) () #+sbcl (sb-profile:reset) #-sbcl nil) -(define-named-command com-report-profile () +(define-command (com-report-profile :name t :command-table development-table) () #+sbcl (sb-profile:report) #-sbcl nil) -(define-named-command com-recompile () +(define-command (com-recompile :name t :command-table development-table) () (asdf:operate 'asdf:load-op :climacs)) (define-gesture-name :select-other :pointer-button-press (:left :meta) :unique nil) (define-presentation-translator lisp-string-to-string - (climacs-lisp-syntax::lisp-string string global-climacs-table + (climacs-lisp-syntax::lisp-string string development-table :gesture :select-other :tester-definitive t :menu nil @@ -2299,115 +2547,116 @@ (object) object) -(define-named-command com-accept-string () +(define-command (com-accept-string :name t :command-table development-table) () (display-message (format nil "~s" (accept 'string)))) -(define-named-command com-accept-symbol () +(define-command (com-accept-symbol :name t :command-table development-table) () (display-message (format nil "~s" (accept 'symbol)))) -(define-named-command com-accept-lisp-string () +(define-command (com-accept-lisp-string :name t :command-table development-table) () (display-message (format nil "~s" (accept 'lisp-string)))) -(define-named-command com-toggle-visible-mark () +(define-command (com-visible-mark :name t :command-table marking-table) () (setf (mark-visible-p (current-window)) (not (mark-visible-p (current-window))))) (loop for code from (char-code #\Space) to (char-code #\~) do (set-key `(com-self-insert ,*numeric-argument-marker*) - 'global-climacs-table + 'self-insert-table (list (list (code-char code))))) (set-key `(com-self-insert ,*numeric-argument-marker*) - 'global-climacs-table + 'self-insert-table '((#\Newline))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Some Unicode stuff -(define-named-command com-insert-charcode ((code 'integer :prompt "Code point")) +(define-command (com-insert-charcode :name t :command-table self-insert-table) + ((code 'integer :prompt "Code point")) (insert-object (point (current-window)) (code-char code))) -(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))) +(set-key '(com-insert-charcode 193) 'self-insert-table '((:dead--acute)(#\A))) +(set-key '(com-insert-charcode 201) 'self-insert-table '((:dead--acute)(#\E))) +(set-key '(com-insert-charcode 205) 'self-insert-table '((:dead--acute)(#\I))) +(set-key '(com-insert-charcode 211) 'self-insert-table '((:dead--acute)(#\O))) +(set-key '(com-insert-charcode 218) 'self-insert-table '((:dead--acute)(#\U))) +(set-key '(com-insert-charcode 221) 'self-insert-table '((:dead--acute)(#\Y))) +(set-key '(com-insert-charcode 225) 'self-insert-table '((:dead--acute)(#\a))) +(set-key '(com-insert-charcode 233) 'self-insert-table '((:dead--acute)(#\e))) +(set-key '(com-insert-charcode 237) 'self-insert-table '((:dead--acute)(#\i))) +(set-key '(com-insert-charcode 243) 'self-insert-table '((:dead--acute)(#\o))) +(set-key '(com-insert-charcode 250) 'self-insert-table '((:dead--acute)(#\u))) +(set-key '(com-insert-charcode 253) 'self-insert-table '((:dead--acute)(#\y))) +(set-key '(com-insert-charcode 199) 'self-insert-table '((:dead--acute)(#\C))) +(set-key '(com-insert-charcode 231) 'self-insert-table '((:dead--acute)(#\c))) +(set-key '(com-insert-charcode 215) 'self-insert-table '((:dead--acute)(#\x))) +(set-key '(com-insert-charcode 247) 'self-insert-table '((:dead--acute)(#\-))) +(set-key '(com-insert-charcode 222) 'self-insert-table '((:dead--acute)(#\T))) +(set-key '(com-insert-charcode 254) 'self-insert-table '((:dead--acute)(#\t))) +(set-key '(com-insert-charcode 223) 'self-insert-table '((:dead--acute)(#\s))) +(set-key '(com-insert-charcode 39) 'self-insert-table '((:dead--acute)(#\Space))) + +(set-key '(com-insert-charcode 197) 'self-insert-table '((:dead--acute)(:dead--acute)(#\A))) +(set-key '(com-insert-charcode 229) 'self-insert-table '((:dead--acute)(:dead--acute)(#\a))) + +(set-key '(com-insert-charcode 192) 'self-insert-table '((:dead--grave)(#\A))) +(set-key '(com-insert-charcode 200) 'self-insert-table '((:dead--grave)(#\E))) +(set-key '(com-insert-charcode 204) 'self-insert-table '((:dead--grave)(#\I))) +(set-key '(com-insert-charcode 210) 'self-insert-table '((:dead--grave)(#\O))) +(set-key '(com-insert-charcode 217) 'self-insert-table '((:dead--grave)(#\U))) +(set-key '(com-insert-charcode 224) 'self-insert-table '((:dead--grave)(#\a))) +(set-key '(com-insert-charcode 232) 'self-insert-table '((:dead--grave)(#\e))) +(set-key '(com-insert-charcode 236) 'self-insert-table '((:dead--grave)(#\i))) +(set-key '(com-insert-charcode 242) 'self-insert-table '((:dead--grave)(#\o))) +(set-key '(com-insert-charcode 249) 'self-insert-table '((:dead--grave)(#\u))) +(set-key '(com-insert-charcode 96) 'self-insert-table '((:dead--grave)(#\Space))) + +(set-key '(com-insert-charcode 196) 'self-insert-table '((:dead--diaeresis :shift)(#\A))) +(set-key '(com-insert-charcode 203) 'self-insert-table '((:dead--diaeresis :shift)(#\E))) +(set-key '(com-insert-charcode 207) 'self-insert-table '((:dead--diaeresis :shift)(#\I))) +(set-key '(com-insert-charcode 214) 'self-insert-table '((:dead--diaeresis :shift)(#\O))) +(set-key '(com-insert-charcode 220) 'self-insert-table '((:dead--diaeresis :shift)(#\U))) +(set-key '(com-insert-charcode 228) 'self-insert-table '((:dead--diaeresis :shift)(#\a))) +(set-key '(com-insert-charcode 235) 'self-insert-table '((:dead--diaeresis :shift)(#\e))) +(set-key '(com-insert-charcode 239) 'self-insert-table '((:dead--diaeresis :shift)(#\i))) +(set-key '(com-insert-charcode 246) 'self-insert-table '((:dead--diaeresis :shift)(#\o))) +(set-key '(com-insert-charcode 252) 'self-insert-table '((:dead--diaeresis :shift)(#\u))) +(set-key '(com-insert-charcode 255) 'self-insert-table '((:dead--diaeresis :shift)(#\y))) +(set-key '(com-insert-charcode 34) 'self-insert-table '((:dead--diaeresis :shift)(#\Space))) + +(set-key '(com-insert-charcode 195) 'self-insert-table '((:dead--tilde :shift)(#\A))) +(set-key '(com-insert-charcode 209) 'self-insert-table '((:dead--tilde :shift)(#\N))) +(set-key '(com-insert-charcode 227) 'self-insert-table '((:dead--tilde :shift)(#\a))) +(set-key '(com-insert-charcode 241) 'self-insert-table '((:dead--tilde :shift)(#\n))) +(set-key '(com-insert-charcode 198) 'self-insert-table '((:dead--tilde :shift)(#\E))) +(set-key '(com-insert-charcode 230) 'self-insert-table '((:dead--tilde :shift)(#\e))) +(set-key '(com-insert-charcode 208) 'self-insert-table '((:dead--tilde :shift)(#\D))) +(set-key '(com-insert-charcode 240) 'self-insert-table '((:dead--tilde :shift)(#\d))) +(set-key '(com-insert-charcode 216) 'self-insert-table '((:dead--tilde :shift)(#\O))) +(set-key '(com-insert-charcode 248) 'self-insert-table '((:dead--tilde :shift)(#\o))) +(set-key '(com-insert-charcode 126) 'self-insert-table '((:dead--tilde :shift)(#\Space))) + +(set-key '(com-insert-charcode 194) 'self-insert-table '((:dead--circumflex :shift)(#\A))) +(set-key '(com-insert-charcode 202) 'self-insert-table '((:dead--circumflex :shift)(#\E))) +(set-key '(com-insert-charcode 206) 'self-insert-table '((:dead--circumflex :shift)(#\I))) +(set-key '(com-insert-charcode 212) 'self-insert-table '((:dead--circumflex :shift)(#\O))) +(set-key '(com-insert-charcode 219) 'self-insert-table '((:dead--circumflex :shift)(#\U))) +(set-key '(com-insert-charcode 226) 'self-insert-table '((:dead--circumflex :shift)(#\a))) +(set-key '(com-insert-charcode 234) 'self-insert-table '((:dead--circumflex :shift)(#\e))) +(set-key '(com-insert-charcode 238) 'self-insert-table '((:dead--circumflex :shift)(#\i))) +(set-key '(com-insert-charcode 244) 'self-insert-table '((:dead--circumflex :shift)(#\o))) +(set-key '(com-insert-charcode 251) 'self-insert-table '((:dead--circumflex :shift)(#\u))) +(set-key '(com-insert-charcode 94) 'self-insert-table '((:dead--circumflex :shift)(#\Space))) -(define-named-command com-regex-search-forward () +(define-command (com-regex-search-forward :name t :command-table search-table) () (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 () +(define-command (com-regex-search-backward :name t :command-table search-table) () (let ((string (accept 'string :prompt "RE search backward" :delimiter-gestures nil :activation-gestures Index: climacs/esa.lisp diff -u climacs/esa.lisp:1.17 climacs/esa.lisp:1.18 --- climacs/esa.lisp:1.17 Tue Sep 6 23:30:34 2005 +++ climacs/esa.lisp Tue Sep 13 21:23:59 2005 @@ -466,6 +466,17 @@ (helper command-table nil) results))) +(defun find-all-keystrokes-and-commands-with-inheritance (start-table) + (let ((results '())) + (labels ((helper (table) + (let ((res (find-all-keystrokes-and-commands table))) + (when res (setf results (nconc res results))) + (dolist (subtable (command-table-inherit-from + (find-command-table table))) + (helper subtable))))) + (helper start-table)) + results)) + (defun sort-by-name (list) (sort list #'string< :key (lambda (item) (symbol-name (second item))))) @@ -486,8 +497,9 @@ &optional (sort-function #'sort-by-name)) (formatting-table (stream) (loop for (keys command) - in (funcall sort-function (find-all-keystrokes-and-commands - command-table)) + in (funcall sort-function + (find-all-keystrokes-and-commands-with-inheritance + command-table)) do (formatting-row (stream) (formatting-cell (stream :align-x :right) (with-text-style (stream '(:sans-serif nil nil)) From rstrandh at common-lisp.net Tue Sep 13 23:42:19 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 14 Sep 2005 01:42:19 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi climacs/Doc/climacs-user.texi Message-ID: <20050913234219.AE3758815C@common-lisp.net> Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv26214 Modified Files: climacs-internals.texi climacs-user.texi Log Message: Chapter on getting help. Date: Wed Sep 14 01:42:17 2005 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.17 climacs/Doc/climacs-internals.texi:1.18 --- climacs/Doc/climacs-internals.texi:1.17 Tue Mar 15 07:19:21 2005 +++ climacs/Doc/climacs-internals.texi Wed Sep 14 01:42:17 2005 @@ -1833,11 +1833,12 @@ @section Suggested CLIM gadget Undo might be presented in a CLIM gadget in the form of a tree where -branches are added to the right over time, in @xref{figundo}. +branches are added to the right over time, in + at c @xref{figundo}. - at image{undo} - at anchor{figundo} + at c @image{undo} + at c @anchor{figundo} where the bigger black circle indicates the current state. The tree will be fairly tall and skinny, so the gadget should probably be a Index: climacs/Doc/climacs-user.texi diff -u climacs/Doc/climacs-user.texi:1.3 climacs/Doc/climacs-user.texi:1.4 --- climacs/Doc/climacs-user.texi:1.3 Tue Sep 13 01:35:55 2005 +++ climacs/Doc/climacs-user.texi Wed Sep 14 01:42:17 2005 @@ -43,6 +43,7 @@ * Different editing modes:: * Kill ring:: * Advanced editing commands:: +* Getting help:: * Key Index:: * Concept Index:: @end menu @@ -552,6 +553,56 @@ @node Searching and replacing @section Searching and replacing + + at node Getting help + at chapter Getting help + +In addition to this manual, @climacs{} contains an online help +facility. There are several different topics that you can get help +with. Most of these topics are obtained by some order using the + at kbd{C-h} + at kindex C-h +prefex key. The key following @kbd{C-h} determines what kind of help +information is displayed. + + at menu +* Help with a key binding:: +* Help with a particular key sequence:: +* Help finding an order for a command:: + at end menu + + at node Help with a key binding + at section Help with a key binding + +To obtain a list of all orders and the associated commands that are +valid in a particular context, use the order @kbd{C-h b} + at kindex C-h b +(@command{Describe Bindings}). A table with each command name and +associated order (if any) is displayed in a new window. + + at node Help with a particular key sequence + at section Help with a particular key sequence + +To obtain a description of what some putative order will do, use the +order @kbd{C-h c} + at kindex C-h c +(@command{Describe Key Briefly}. You will be prompted for a key +sequence. If the key sequence you type is bound to a command, the +command name will be displayed in the minibuffer. Otherwise a message +indicating that the key is not bound to a command will be displayed. + + at node Help finding an order for a command + at section Help finding an order for a command + +Sometimes, you know the name of a command, and would like to find out +whether it is bound to any order, and if so, which one(s). For that, +you can use the order @kbd{C-h w} + at kindex C-h w +(@command{Where Is}). You will be prompted for a command name +(completion can be used as usual), and if the command name given is +bound to an order, that order will displayed in the minibuffer. +Otherwise, a message indicating that the command is not bound to any +order will be displayed. @node Key Index @unnumbered Key Index From rstrandh at common-lisp.net Tue Sep 13 23:45:40 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Wed, 14 Sep 2005 01:45:40 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi Message-ID: <20050913234540.0FB018815C@common-lisp.net> Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv26357 Modified Files: climacs-internals.texi Log Message: Uncommented some lines that were accidentally commented out. Date: Wed Sep 14 01:45:39 2005 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.18 climacs/Doc/climacs-internals.texi:1.19 --- climacs/Doc/climacs-internals.texi:1.18 Wed Sep 14 01:42:17 2005 +++ climacs/Doc/climacs-internals.texi Wed Sep 14 01:45:39 2005 @@ -1833,12 +1833,10 @@ @section Suggested CLIM gadget Undo might be presented in a CLIM gadget in the form of a tree where -branches are added to the right over time, in - at c @xref{figundo}. +branches are added to the right over time, in @xref{figundo}. - - at c @image{undo} - at c @anchor{figundo} + at image{undo} + at anchor{figundo} where the bigger black circle indicates the current state. The tree will be fairly tall and skinny, so the gadget should probably be a From rstrandh at common-lisp.net Thu Sep 22 23:25:16 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Fri, 23 Sep 2005 01:25:16 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/Doc/Makefile climacs/Doc/climacs-user.texi Message-ID: <20050922232516.0FA8B880E6@common-lisp.net> Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv31173 Modified Files: Makefile climacs-user.texi Log Message: Include the user manual in the Makefile. Minor fixes to avoid errors from texinfo translators. Date: Fri Sep 23 01:25:15 2005 Author: rstrandh Index: climacs/Doc/Makefile diff -u climacs/Doc/Makefile:1.1 climacs/Doc/Makefile:1.2 --- climacs/Doc/Makefile:1.1 Sat Dec 25 13:05:17 2004 +++ climacs/Doc/Makefile Fri Sep 23 01:25:14 2005 @@ -1,4 +1,4 @@ -all: climacs-internals.pdf climacs-internals.ps +all: climacs-internals.pdf climacs-internals.ps climacs-user.pdf climacs-user.ps %.eps: %.fig fig2dev -Leps -m 0.75 $< $@ @@ -9,6 +9,13 @@ climacs-internals.ps: climacs-internals.texi undo.eps texi2dvi climacs-internals.texi dvips -o climacs-internals.ps climacs-internals.dvi + +climacs-user.pdf: climacs-user.texi + texi2pdf climacs-user.texi + +climacs-user.ps: climacs-user.texi + texi2dvi climacs-user.texi + dvips -o climacs-user.ps climacs-user.dvi clean: rm -f *.aux *.cp *.fn *.fns *.ky *.log *.pdf *.pg *.toc *.tp *.tps *.vr *.dvi *.ps *.eps *~ Index: climacs/Doc/climacs-user.texi diff -u climacs/Doc/climacs-user.texi:1.4 climacs/Doc/climacs-user.texi:1.5 --- climacs/Doc/climacs-user.texi:1.4 Wed Sep 14 01:42:17 2005 +++ climacs/Doc/climacs-user.texi Fri Sep 23 01:25:14 2005 @@ -178,7 +178,7 @@ commands of @climacs{}. @menu -* Entering and exiting @climacs{}:: +* Entering and exiting Climacs:: * Numeric arguments:: * Entering and deleting text:: * Moving around:: @@ -186,8 +186,8 @@ * Editing the contents of a file:: @end menu - at node Entering and exiting @climacs{} - at section Entering and exiting @climacs{} + at node Entering and exiting Climacs + at section Entering and exiting Climacs The typical way of entering @climacs{} is to type a @cl{} @emph{expression} at the prompt of a @cl{} @emph{listener} such as: From rstrandh at common-lisp.net Sat Sep 24 18:53:55 2005 From: rstrandh at common-lisp.net (Robert Strandh) Date: Sat, 24 Sep 2005 20:53:55 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/Doc/climacs-user.texi Message-ID: <20050924185355.2C125880DE@common-lisp.net> Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv17448 Modified Files: climacs-user.texi Log Message: Fixed spelling errors and a faulty index entry. Date: Sat Sep 24 20:53:49 2005 Author: rstrandh Index: climacs/Doc/climacs-user.texi diff -u climacs/Doc/climacs-user.texi:1.5 climacs/Doc/climacs-user.texi:1.6 --- climacs/Doc/climacs-user.texi:1.5 Fri Sep 23 01:25:14 2005 +++ climacs/Doc/climacs-user.texi Sat Sep 24 20:53:48 2005 @@ -145,7 +145,7 @@ window that displays the buffer. Points are right-sticky marks, even when a language such as Arabic is edited, simply because by convention, the @climacs{} buffer is considered as being organized -from left to right. It is question of @emph{rendering} as to whether +from left to right. It is a question of @emph{rendering} as to whether the objects in the buffer are actually displayed from left to right, from right to left, or in any other appropriate order. @@ -164,7 +164,8 @@ @emph{command}. @cindex command Such a key sequence is called a @emph{complete key sequence} - at cindex complete key sequence or an @emph{order}. + at cindex complete key sequence +or an @emph{order}. @cindex order @node Basic editing commands @@ -204,7 +205,7 @@ saved. In addition, if you answer no to any of those questions, you will be asked to confirm that you want to quit @climacs{} anyway. The reason for this pestering on the part of @climacs{} is that currently -when you quit @climacs{}, the buffer contents is lost. +when you quit @climacs{}, the buffer contents are lost. @node Numeric arguments @section Numeric arguments @@ -315,7 +316,7 @@ When used with a numeric argument, this command is not simply repeated that many times. Instead, the number of lines indicated by the -numerid argument are removed. +numeric argument are removed. Because this command name contains the word @emph{kill} it saves the deleted objects on the @emph{kill ring} (@pxref{kill-ring}). @@ -353,7 +354,7 @@ @node Moving by words @subsection Moving by words - at climacs{} will allow you to move around by larger unites than + at climacs{} will allow you to move around by larger units than objects. The order @kbd{M-f} @@ -396,7 +397,7 @@ @command{Next Line} is also associated with the @emph{down-arrow key}. -When you move by lines, @climacs{} tries to be smart about what +When you move by lines, @climacs{} tries to be smart about which @emph{column} point ends up in, in the following way: when a sequence of commands that move by lines is given, the initial column of point is remembered (this is called the @emph{goal column}). @climacs{} @@ -457,7 +458,7 @@ The result of finding a file is that a @emph{buffer} will be created that has the name of the file, and the file will be associated with -that buffer when the contents is saved. +that buffer when the content is saved. @node Saving a buffer @subsection Saving a buffer @@ -494,7 +495,7 @@ Normally, typing ordinary characters to @climacs{} results in these characters being @emph{inserted} at point. Sometimes, however, it is useful to treat a line of objects as being of @emph{fixed length}, and -have @climacs{} @emph{replace} objects as new ones are begin typed. +have @climacs{} @emph{replace} objects as new ones are being typed. This is exactly the purpose of @climacs{} @emph{overwrite mode}. This mode alters the insert commands so that the object after point is @@ -525,11 +526,11 @@ @section Keyboard macros Sometimes, it is useful to be able to repeat a sequence of keystrokes -several times. @climacs{} allows you to do this through a features +several times. @climacs{} allows you to do this through a feature called @emph{keyboard macros}. @cindex keyboard macro @climacs{} does this by @emph{recording} whatever the user types on -the keyboard, and then making it possibly to @emph{replaying} the +the keyboard, and then making it possibly to @emph{replay} the recorded sequence. To start recording a sequence of keystrokes, use the order @kbd{C-x (} @@ -586,9 +587,9 @@ To obtain a description of what some putative order will do, use the order @kbd{C-h c} @kindex C-h c -(@command{Describe Key Briefly}. You will be prompted for a key +(@command{Describe Key Briefly}). You will be prompted for a key sequence. If the key sequence you type is bound to a command, the -command name will be displayed in the minibuffer. Otherwise a message +command name will be displayed in the minibuffer. Otherwise, a message indicating that the key is not bound to a command will be displayed. @node Help finding an order for a command From afuchs at common-lisp.net Sun Sep 25 19:03:53 2005 From: afuchs at common-lisp.net (Andreas Fuchs) Date: Sun, 25 Sep 2005 21:03:53 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/INSTALL Message-ID: <20050925190353.82BD088556@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21185 Modified Files: INSTALL Log Message: Fix two small typos in INSTALL. Date: Sun Sep 25 21:03:52 2005 Author: afuchs Index: climacs/INSTALL diff -u climacs/INSTALL:1.4 climacs/INSTALL:1.5 --- climacs/INSTALL:1.4 Sun Jan 23 17:37:24 2005 +++ climacs/INSTALL Sun Sep 25 21:03:52 2005 @@ -37,8 +37,8 @@ find bugs in McCLIM, or ask for functionality of McCLIM that can be useful to us. -For that reason, McCLIM often depend on very fresh CVS versions of +For that reason, Climacs often depends on very fresh CVS versions of McCLIM. If you discover a bug, please try to install a new version of -McCLIM before looking to hard for any other reasons. +McCLIM before looking to hard for any other reasons. From afuchs at common-lisp.net Sun Sep 25 19:36:32 2005 From: afuchs at common-lisp.net (Andreas Fuchs) Date: Sun, 25 Sep 2005 21:36:32 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/INSTALL Message-ID: <20050925193632.2BD6F88556@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv23262 Modified Files: INSTALL Log Message: Add a paragraph to INSTALL detailing how to get McCLIM and CLX, written by Xan on #lisp. Date: Sun Sep 25 21:36:32 2005 Author: afuchs Index: climacs/INSTALL diff -u climacs/INSTALL:1.5 climacs/INSTALL:1.6 --- climacs/INSTALL:1.5 Sun Sep 25 21:03:52 2005 +++ climacs/INSTALL Sun Sep 25 21:36:31 2005 @@ -1,3 +1,9 @@ +*Note*: Climacs depends on McCLIM, a graphic toolkit for Common Lisp +(http://www.cliki.net/McCLIM) and CLX, a low level, Xlib-like library +on top of which McCLIM is built (http://www.cliki.net/CLX). Make sure +these are properly installed on your system before attempting to install +Climacs. + Install instructions for Climacs. We assume that if you have gotten this far, it means that you have either extracted a tar file with everything in it, or checked out the files from some CVS repository. From abakic at common-lisp.net Sun Sep 25 20:06:27 2005 From: abakic at common-lisp.net (Aleksandar Bakic) Date: Sun, 25 Sep 2005 22:06:27 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/cl-automaton/state-and-transition.lisp Message-ID: <20050925200627.1A9F88855C@common-lisp.net> Update of /project/climacs/cvsroot/climacs/cl-automaton In directory common-lisp.net:/tmp/cvs-serv25386/cl-automaton Modified Files: state-and-transition.lisp Log Message: Fixed one more typo in INSTALL. Cleaned up :climacs.tests in climacs.asd. Changed *do-not-escape* to *escape-unicode-chars*, as requested by Derek Peschel. Date: Sun Sep 25 22:06:27 2005 Author: abakic Index: climacs/cl-automaton/state-and-transition.lisp diff -u climacs/cl-automaton/state-and-transition.lisp:1.1 climacs/cl-automaton/state-and-transition.lisp:1.2 --- climacs/cl-automaton/state-and-transition.lisp:1.1 Fri Aug 5 00:07:48 2005 +++ climacs/cl-automaton/state-and-transition.lisp Sun Sep 25 22:06:26 2005 @@ -118,10 +118,11 @@ sum (sxhash st)) most-positive-fixnum))) -(defvar *do-not-escape* t) ; nil may be useful in Slime +(defvar *escape-unicode-chars* nil) ; true may be useful in Slime (defun escaped-char (c) - (if (or *do-not-escape* (and (<= #x21 c #x7e) (/= c (char-code #\\)))) + (if (or (not *escape-unicode-chars*) + (and (<= #x21 c #x7e) (/= c (char-code #\\)))) (code-char c) (format nil "\\u~4,'0O" c))) From abakic at common-lisp.net Sun Sep 25 20:06:26 2005 From: abakic at common-lisp.net (Aleksandar Bakic) Date: Sun, 25 Sep 2005 22:06:26 +0200 (CEST) Subject: [climacs-cvs] CVS update: climacs/INSTALL climacs/climacs.asd Message-ID: <20050925200626.9FD1888556@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25386 Modified Files: INSTALL climacs.asd Log Message: Fixed one more typo in INSTALL. Cleaned up :climacs.tests in climacs.asd. Changed *do-not-escape* to *escape-unicode-chars*, as requested by Derek Peschel. Date: Sun Sep 25 22:06:25 2005 Author: abakic Index: climacs/INSTALL diff -u climacs/INSTALL:1.6 climacs/INSTALL:1.7 --- climacs/INSTALL:1.6 Sun Sep 25 21:36:31 2005 +++ climacs/INSTALL Sun Sep 25 22:06:25 2005 @@ -45,6 +45,6 @@ For that reason, Climacs often depends on very fresh CVS versions of McCLIM. If you discover a bug, please try to install a new version of -McCLIM before looking to hard for any other reasons. +McCLIM before looking too hard for any other reasons. Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.37 climacs/climacs.asd:1.38 --- climacs/climacs.asd:1.37 Fri Aug 12 23:15:26 2005 +++ climacs/climacs.asd Sun Sep 25 22:06:25 2005 @@ -81,21 +81,15 @@ ((:file "rt" :pathname #p"testing/rt.lisp") (:file "buffer-test" :depends-on ("rt")) (:file "base-test" :depends-on ("rt")) - (:file "automaton-test-package" - :pathname #P"cl-automaton/automaton-test-package.lisp" - :depends-on ("rt")) - (:file "eqv-hash-test" - :pathname #P"cl-automaton/eqv-hash-test.lisp" - :depends-on ("rt" "automaton-test-package")) - (:file "state-and-transition-test" - :pathname #P"cl-automaton/state-and-transition-test.lisp" - :depends-on ("rt" "automaton-test-package")) - (:file "automaton-test" - :pathname #P"cl-automaton/automaton-test.lisp" - :depends-on ("rt" "automaton-test-package")) - (:file "regexp-test" - :pathname #P"cl-automaton/regexp-test.lisp" - :depends-on ("rt" "automaton-test-package")))) + (:module + "cl-automaton" + :depends-on ("rt") + :components + ((:file "automaton-test-package") + (:file "eqv-hash-test" :depends-on ("automaton-test-package")) + (:file "state-and-transition-test" :depends-on ("automaton-test-package")) + (:file "automaton-test" :depends-on ("automaton-test-package")) + (:file "regexp-test" :depends-on ("automaton-test-package")))))) #+asdf (defmethod asdf:perform :around ((o asdf:compile-op)