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

[climacs-cvs] CVS update: climacs/Doc/climacs-user.texi
by rstrandh＠common-lisp.net 12 Sep '05

12 Sep '05

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 +@node Advanced editing commands +@chapter Advanced editing commands + +@menu +* Keyboard macros:: +* Searching and replacing:: +@end menu + +@node Keyboard macros +@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}. +@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 +recorded sequence. + +To start recording a sequence of keystrokes, use the order @kbd{C-x (} +@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 )} +@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 +@kbd{C-x e} +@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. + +@node Searching and replacing +@section Searching and replacing @node Key Index @unnumbered Key Index

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-user.texi
by rstrandh＠common-lisp.net 12 Sep '05

12 Sep '05

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} +@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-@key{Backspace}} @@ -349,6 +351,27 @@ @node Moving by words @subsection Moving by words +@climacs{} will allow you to move around by larger unites than +objects. + +The order @kbd{M-f} +@kindex M-f +(@command{Forward Word}) lets you move forward over the @emph{word} +@cindex word +following point. With a numeric argument, this command moves point +forward that many words. + +The order @kbd{M-b} +@kindex M-b +(@command{Backward Word}) lets you move backward over the @emph{word} +@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}, +@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. + +@node Editing the contents of a file +@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. +@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. + +@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 +@end menu + +@node Finding a file +@subsection Finding a file + +To find a file, use the order @kbd{C-x C-f} +@kindex C-x C-f +(@command{Find File}). + +@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. + +@node Saving a buffer +@subsection Saving a buffer + +To save a buffer, use the order @kbd{C-x C-s} +@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}). + +@node Writing a buffer +@subsection Writing a buffer +@anchor{write-buffer} + +To write a buffer to a file, use the order @kbd{C-x C-w} +@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 +@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

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-user.texi
by rstrandh＠common-lisp.net 12 Sep '05

12 Sep '05

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

1 0

[climacs-cvs] CVS update: climacs/packages.lisp climacs/gui.lisp climacs/esa.lisp
by dmurray＠common-lisp.net 06 Sep '05

06 Sep '05

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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

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

05 Sep '05

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

1 0

[climacs-cvs] CVS update: climacs/esa.lisp
by dmurray＠common-lisp.net 05 Sep '05

05 Sep '05

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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS update: climacs/esa.lisp climacs/gui.lisp
by mretzlaff＠common-lisp.net 01 Sep '05

01 Sep '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv4017 Modified Files: esa.lisp gui.lisp Log Message: Manually substituted all occasions of the following abbreviations: int -> minibuffer (sic! See below) win -> window buf -> buffer This is no assembler, right? We have more than three letters for symbols. > Robert Strandh wrote: > > Max-Gerd Retzlaff writes: > > Okay, that's all. Only one question left: Why is the variable in the > > DEFINE-APPLICATION-FRAME form that holds the minibuffer-pane called > > "int"? What is the meaning of "int"? I don't get it. > > *blush* it used to be for "interactor". Feel free to rename it. Date: Thu Sep 1 03:05:51 2005 Author: mretzlaff Index: climacs/esa.lisp diff -u climacs/esa.lisp:1.14 climacs/esa.lisp:1.15 --- climacs/esa.lisp:1.14 Tue Aug 30 19:28:52 2005 +++ climacs/esa.lisp Thu Sep 1 03:05:51 2005 @@ -423,7 +423,7 @@ esa-frame-mixin) () (:panes - (win (let* ((my-pane + (window (let* ((my-pane (make-pane 'example-pane :width 900 :height 400 :display-function 'display-my-pane @@ -437,12 +437,12 @@ (scrolling () my-pane) my-info-pane))) - (int (make-pane 'example-minibuffer-pane :width 900))) + (minibuffer (make-pane 'example-minibuffer-pane :width 900))) (:layouts (default (vertically (:scroll-bars nil) - win - int))) + window + minibuffer))) (:top-level (esa-top-level))) (defun display-my-pane (frame pane) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.185 climacs/gui.lisp:1.186 --- climacs/gui.lisp:1.185 Thu Sep 1 02:21:08 2005 +++ climacs/gui.lisp Thu Sep 1 03:05:51 2005 @@ -59,12 +59,12 @@ (:command-table (global-climacs-table :inherit-from (global-esa-table))) (:menu-bar nil) (:panes - (win (let* ((extended-pane + (window (let* ((extended-pane (make-pane 'extended-pane :width 900 :height 400 :end-of-line-action :scroll :incremental-redisplay t - :display-function 'display-win + :display-function 'display-window :command-table 'global-climacs-table)) (info-pane (make-pane 'climacs-info-pane @@ -79,12 +79,12 @@ extended-pane) extended-pane) info-pane))) - (int (make-pane 'climacs-minibuffer-pane :width 900))) + (minibuffer (make-pane 'climacs-minibuffer-pane :width 900))) (:layouts (default (vertically (:scroll-bars nil) - win - int))) + window + minibuffer))) (:top-level (esa-top-level))) (defun current-window () @@ -112,8 +112,8 @@ (defun display-info (frame pane) (declare (ignore frame)) (let* ((master-pane (master-pane pane)) - (buf (buffer master-pane)) - (size (size buf)) + (buffer (buffer master-pane)) + (size (size buffer)) (top (top master-pane)) (bot (bot master-pane)) (name-info (format nil "~3T~A~ @@ -124,13 +124,13 @@ ~{~:[~*~; ~A~]~}~ ~:[)~;~]~ ~3@T~A" - (cond ((and (needs-saving buf) - (read-only-p buf) + (cond ((and (needs-saving buffer) + (read-only-p buffer) "%*")) - ((needs-saving buf) "**") - ((read-only-p buf) "%%") + ((needs-saving buffer) "**") + ((read-only-p buffer) "%%") (t "--")) - (name buf) + (name buffer) *with-scrollbars* (cond ((and (mark= size bot) (mark= 0 top)) @@ -143,7 +143,7 @@ (round (* 100 (/ (offset top) size)))))) *with-scrollbars* - (name (syntax buf)) + (name (syntax buffer)) (list (slot-value master-pane 'overwrite-mode) "Ovwrt" @@ -157,7 +157,7 @@ "")))) (princ name-info pane))) -(defun display-win (frame pane) +(defun display-window (frame pane) "The display function used by the climacs application frame." (declare (ignore frame)) (redisplay-pane pane (eq pane (current-window)))) @@ -240,13 +240,13 @@ tab-width)))))) (defun insert-character (char) - (let* ((win (current-window)) - (point (point win))) + (let* ((window (current-window)) + (point (point window))) (unless (constituentp char) (possibly-expand-abbrev point)) (when (whitespacep char) (possibly-fill-line)) - (if (and (slot-value win 'overwrite-mode) (not (end-of-line-p point))) + (if (and (slot-value window 'overwrite-mode) (not (end-of-line-p point))) (progn (delete-range point) (insert-object point char)) @@ -433,14 +433,14 @@ '((#\x :control) (#\t :control))) (define-named-command com-previous-line ((numarg 'integer :prompt "How many lines?")) - (let* ((win (current-window)) - (point (point win))) - (unless (or (eq (previous-command win) 'com-previous-line) - (eq (previous-command win) 'com-next-line)) - (setf (slot-value win 'goal-column) (column-number point))) + (let* ((window (current-window)) + (point (point window))) + (unless (or (eq (previous-command window) 'com-previous-line) + (eq (previous-command window) 'com-next-line)) + (setf (slot-value window 'goal-column) (column-number point))) (if (plusp numarg) - (previous-line point (slot-value win 'goal-column) numarg) - (next-line point (slot-value win 'goal-column) (- numarg))))) + (previous-line point (slot-value window 'goal-column) numarg) + (next-line point (slot-value window 'goal-column) (- numarg))))) (set-key `(com-previous-line ,*numeric-argument-marker*) 'global-climacs-table @@ -451,14 +451,14 @@ '((:up))) (define-named-command com-next-line ((numarg 'integer :prompt "How many lines?")) - (let* ((win (current-window)) - (point (point win))) - (unless (or (eq (previous-command win) 'com-previous-line) - (eq (previous-command win) 'com-next-line)) - (setf (slot-value win 'goal-column) (column-number point))) + (let* ((window (current-window)) + (point (point window))) + (unless (or (eq (previous-command window) 'com-previous-line) + (eq (previous-command window) 'com-next-line)) + (setf (slot-value window 'goal-column) (column-number point))) (if (plusp numarg) - (next-line point (slot-value win 'goal-column) numarg) - (previous-line point (slot-value win 'goal-column) (- numarg))))) + (next-line point (slot-value window 'goal-column) numarg) + (previous-line point (slot-value window 'goal-column) (- numarg))))) (set-key `(com-next-line ,*numeric-argument-marker*) 'global-climacs-table @@ -1357,10 +1357,10 @@ (let* ((extended-pane (make-pane 'extended-pane :width 900 :height 400 - :name 'win + :name 'window :end-of-line-action :scroll :incremental-redisplay t - :display-function 'display-win + :display-function 'display-window :command-table 'global-climacs-table)) (vbox (vertically () @@ -1824,9 +1824,9 @@ ;;; Dynamic abbrevs (define-named-command com-dabbrev-expand () - (let* ((win (current-window)) - (point (point win))) - (with-slots (original-prefix prefix-start-offset dabbrev-expansion-mark) win + (let* ((window (current-window)) + (point (point window))) + (with-slots (original-prefix prefix-start-offset dabbrev-expansion-mark) window (flet ((move () (cond ((beginning-of-buffer-p dabbrev-expansion-mark) (setf (offset dabbrev-expansion-mark) (offset point)) @@ -1836,7 +1836,7 @@ (t (forward-object dabbrev-expansion-mark))))) (unless (or (beginning-of-buffer-p point) (not (constituentp (object-before point)))) - (unless (and (eq (previous-command win) 'com-dabbrev-expand) + (unless (and (eq (previous-command window) 'com-dabbrev-expand) (not (null prefix-start-offset))) (setf dabbrev-expansion-mark (clone-mark point)) (backward-word dabbrev-expansion-mark)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/pane.lisp climacs/slidemacs-gui.lisp
by mretzlaff＠common-lisp.net 01 Sep '05

01 Sep '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv963 Modified Files: gui.lisp packages.lisp pane.lisp slidemacs-gui.lisp Log Message: The COMPLETABLE-PATHNAME class This patch mainly removes the class COMPLETABLE-PATHNAME. There is nothing special about those pathnames that make them completable. They are just ordinary pathnames (no offence meant). Instead, the ACCEPT and PRESENT method that formerly specialized on that presentation type, specialize now on the ordinary PATHNAME class *and* on climacs' custom view class CLIMACS-TEXTUAL-VIEW, that was already defined in pane.lisp but was not yet used anywhere. (Robert Strandh accedes: "I think it must have been meant for this kind of situation.") The variable climacs-pane:+climacs-textual-view+ has been added, it hold an instance of the class climacs-pane:climacs-textual-view, just as there are such variables for the standard view classes (see clim spec 23.6). Both symbols, #:climacs-textual-view and #:+climacs-textual-view+, of the package CLIMACS-PANE are exported. +climacs-textual-view+ is the :DEFAULT-VIEW for the class CLIMACS-GUI::CLIMACS-MINIBUFFER-PANE now (set via the :DEFAULT-INITARGS parameter of the class definition) so that the aforementioned ACCEPT and PRESENT methods for pathnames are used in the minibuffer. (See at the beginning of gui.lisp.) The :DEFAULT-VIEW for the class CLIMACS-PANE:CLIMACS-PANE was not specified in the same way, but in the :AFTER method of (initialize-instance (pane climacs-pane)) via the line: (setf (stream-default-view pane) (make-instance 'climacs-textual-view)) This is changed to be specified in the appropriate DEFCLASS form, as well. As the :DEFAULT-VIEW of the minibuffer is now changed, all the calls to (accept 'completable-pathname :prompt "..") are now substituted by just (accept 'pathname :prompt "..") without the need for explicit specification by use of the :VIEW keyword. All these calls are changed, even the one in slidemacs-gui.lisp. (If we feel the need for a special view class for the info-pane we can always subclass CLIMACS-MINIBUFFER-PANE later. Only the :DEFAULT-VIEW inside the :DEFAULT-INITARGS argument has to be changed then, if we do things correctly.) The function CLIMACS-GUI:CLIMACS I added the keywords NEW-PROCESS and PROCESS-NAME to the lambda-list and the correspondent construct. You can now do (climacs-gui:climacs :new-process t) Just as it is possible with Clouseau and the Climacs-Listener. CLIMACS-GUI:CLIMACS is also exported now. Why wasn't it before? Some further comments, in case this message is not long enough for you, can be found in the original mail in which I published my patch: http://article.gmane.org/gmane.lisp.climacs.devel/264 Date: Thu Sep 1 02:21:09 2005 Author: mretzlaff Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.184 climacs/gui.lisp:1.185 --- climacs/gui.lisp:1.184 Tue Aug 30 19:28:52 2005 +++ climacs/gui.lisp Thu Sep 1 02:21:08 2005 @@ -47,7 +47,8 @@ (defclass climacs-minibuffer-pane (minibuffer-pane) () (:default-initargs - :height 20 :max-height 20 :min-height 20)) + :height 20 :max-height 20 :min-height 20 + :default-view +climacs-textual-view+)) (defparameter *with-scrollbars* t "If T, classic look and feel. If NIL, stripped-down look (:") @@ -98,11 +99,15 @@ (loop for buffer in buffers do (clear-modify buffer)))) -(defun climacs (&key (width 900) (height 400)) +(defun climacs (&key new-process (process-name "Climacs") + (width 900) (height 400)) "Starts up a climacs session" - (let ((frame (make-application-frame - 'climacs :width width :height height))) - (run-frame-top-level frame))) + (let ((frame (make-application-frame 'climacs :width width :height height))) + (flet ((run () + (run-frame-top-level frame))) + (if new-process + (clim-sys:make-process #'run :name process-name) + (run))))) (defun display-info (frame pane) (declare (ignore frame)) @@ -696,10 +701,6 @@ (set-key 'com-fill-paragraph 'global-climacs-table '((#\q :meta))) -(eval-when (:compile-toplevel :load-toplevel) - (define-presentation-type completable-pathname () - :inherit-from 'pathname)) - (defun filename-completer (so-far mode) (flet ((remove-trail (s) (subseq s 0 (let ((pos (position #\/ s :from-end t))) @@ -768,15 +769,12 @@ collect (list (subseq (namestring name) length nil) name)))))))) -(define-presentation-method present (object (type completable-pathname) - stream (view textual-view) - &key acceptably for-context-type) - (declare (ignore acceptably for-context-type)) +(define-presentation-method present (object (type pathname) + stream (view climacs-textual-view) &key) (princ (namestring object) stream)) -(define-presentation-method accept - ((type completable-pathname) stream (view textual-view) &key (default nil defaultp) - (default-type type)) +(define-presentation-method accept ((type pathname) stream (view climacs-textual-view) + &key (default nil defaultp) (default-type type)) (multiple-value-bind (pathname success string) (complete-input stream #'filename-completer @@ -851,8 +849,7 @@ buffer)))))) (define-named-command com-find-file () - (let* ((filepath (accept 'completable-pathname - :prompt "Find File"))) + (let* ((filepath (accept 'pathname :prompt "Find File"))) (find-file filepath))) (set-key 'com-find-file 'global-climacs-table @@ -895,7 +892,7 @@ nil))))))) (define-named-command com-find-file-read-only () - (let ((filepath (accept 'completable-pathname :Prompt "Find file read only"))) + (let ((filepath (accept 'pathname :Prompt "Find file read only"))) (find-file-read-only filepath))) (set-key 'com-find-file-read-only 'global-climacs-table @@ -914,12 +911,11 @@ (needs-saving buffer) t)) (define-named-command com-set-visited-file-name () - (let ((filename (accept 'completable-pathname :prompt "New file name"))) + (let ((filename (accept 'pathname :prompt "New file name"))) (set-visited-file-name filename (buffer (current-window))))) (define-named-command com-insert-file () - (let ((filename (accept 'completable-pathname - :prompt "Insert File")) + (let ((filename (accept 'pathname :prompt "Insert File")) (pane (current-window))) (when (probe-file filename) (setf (mark pane) (clone-mark (point pane) :left)) @@ -970,8 +966,7 @@ (defun save-buffer (buffer) (let ((filepath (or (filepath buffer) - (accept 'completable-pathname - :prompt "Save Buffer to File")))) + (accept 'pathname :prompt "Save Buffer to File")))) (cond ((directory-pathname-p filepath) (display-message "~A is a directory." filepath) @@ -1018,8 +1013,7 @@ (call-next-method))) (define-named-command com-write-buffer () - (let ((filepath (accept 'completable-pathname - :prompt "Write Buffer to File")) + (let ((filepath (accept 'pathname :prompt "Write Buffer to File")) (buffer (buffer (current-window)))) (cond ((directory-pathname-p filepath) @@ -1146,8 +1140,7 @@ (beep)))))) (define-named-command com-load-file () - (let ((filepath (accept 'completable-pathname - :prompt "Load File"))) + (let ((filepath (accept 'pathname :prompt "Load File"))) (load-file filepath))) (set-key 'com-load-file 'global-climacs-table Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.79 climacs/packages.lisp:1.80 --- climacs/packages.lisp:1.79 Fri Aug 19 11:12:48 2005 +++ climacs/packages.lisp Thu Sep 1 02:21:08 2005 @@ -157,7 +157,8 @@ #:query-replace-mode #:mark-visible-p #:with-undo - #:url)) + #:url + #:climacs-textual-view #:+climacs-textual-view+)) (defpackage :climacs-fundamental-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base @@ -197,5 +198,5 @@ (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax :climacs-kill-ring :climacs-pane :clim-extensions :undo :esa) - (:import-from :climacs-lisp-syntax :lisp-string)) - + (:import-from :climacs-lisp-syntax :lisp-string) + (:export :climacs)) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.31 climacs/pane.lisp:1.32 --- climacs/pane.lisp:1.31 Sun Aug 28 15:57:33 2005 +++ climacs/pane.lisp Thu Sep 1 02:21:08 2005 @@ -222,6 +222,8 @@ (defclass climacs-textual-view (textual-view tabify-mixin) ()) +(defparameter +climacs-textual-view+ (make-instance 'climacs-textual-view)) + (defclass filepath-mixin () ((filepath :initform nil :accessor filepath))) @@ -276,7 +278,10 @@ (full-redisplay-p :initform nil :accessor full-redisplay-p) (cache :initform (let ((cache (make-instance 'standard-flexichain))) (insert* cache 0 nil) - cache)))) + cache))) + (:default-initargs + :default-view +climacs-textual-view+)) + (defmethod tab-width ((pane climacs-pane)) (tab-width (stream-default-view pane))) @@ -295,7 +300,6 @@ (with-slots (buffer top bot scan) pane (setf top (clone-mark (low-mark buffer) :left) bot (clone-mark (high-mark buffer) :right))) - (setf (stream-default-view pane) (make-instance 'climacs-textual-view)) (with-slots (space-width tab-width) (stream-default-view pane) (let* ((medium (sheet-medium pane)) (style (medium-text-style medium))) Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.17 climacs/slidemacs-gui.lisp:1.18 --- climacs/slidemacs-gui.lisp:1.17 Tue Aug 30 19:28:52 2005 +++ climacs/slidemacs-gui.lisp Thu Sep 1 02:21:08 2005 @@ -570,5 +570,5 @@ (if (not (and (typep pane 'climacs-pane) (typep (syntax (buffer pane)) 'slidemacs-gui-syntax))) (beep) - (let ((file (accept 'climacs-gui::completable-pathname :prompt "Output to"))) - (postscript-print-pane pane file))))) \ No newline at end of file + (let ((file (accept 'pathname :prompt "Output to"))) + (postscript-print-pane pane file)))))

1 0