- climacs-cvs@common-lisp.net - mailman3.common-lisp.net

[climacs-cvs] CVS climacs
by thenriksen 07 Feb '06

07 Feb '06

Update of /project/climacs/cvsroot/climacs In directory common-lisp:/tmp/cvs-serv12315 Modified Files: packages.lisp misc-commands.lisp lisp-syntax.lisp gui.lisp climacs.asd Log Message: Refactored the Lisp syntax module so it is no longer integrated with the global command table and gui.lisp. --- /project/climacs/cvsroot/climacs/packages.lisp 2005/11/12 23:09:34 1.83 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/02/07 15:21:30 1.84 @@ -161,6 +161,31 @@ #:url #:climacs-textual-view #:+climacs-textual-view+)) +(defpackage :esa + (:use :clim-lisp :clim) + (:export #:minibuffer-pane #:display-message + #:esa-pane-mixin #:previous-command + #:info-pane #:master-pane + #:esa-frame-mixin #:windows #:recordingp #:executingp + #:*numeric-argument-p* #:*current-gesture* + #:esa-top-level #:simple-command-loop + #:global-esa-table #:keyboard-macro-table + #:help-table + #:set-key + #:find-applicable-command-table)) + +(defpackage :climacs-gui + (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax + :climacs-kill-ring :climacs-pane :clim-extensions :undo :esa) + ;;(:import-from :lisp-string) + (:export :climacs ; Main entry point. + ;; GUI functions follow. + :current-window + :point + :syntax + :mark + :insert-character)) + (defpackage :climacs-fundamental-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-syntax :flexichain :climacs-pane) @@ -182,24 +207,7 @@ (defpackage :climacs-lisp-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base - :climacs-syntax :flexichain :climacs-pane) + :climacs-syntax :flexichain :climacs-pane :climacs-gui) (:export :lisp-string)) -(defpackage :esa - (:use :clim-lisp :clim) - (:export #:minibuffer-pane #:display-message - #:esa-pane-mixin #:previous-command - #:info-pane #:master-pane - #:esa-frame-mixin #:windows #:recordingp #:executingp - #:*numeric-argument-p* #:*current-gesture* - #:esa-top-level #:simple-command-loop - #:global-esa-table #:keyboard-macro-table - #:help-table - #:set-key - #:find-applicable-command-table)) -(defpackage :climacs-gui - (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax - :climacs-kill-ring :climacs-pane :clim-extensions :undo :esa) - (:import-from :climacs-lisp-syntax :lisp-string) - (:export :climacs)) --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2005/11/12 23:09:34 1.2 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/02/07 15:21:30 1.3 @@ -1304,16 +1304,6 @@ (loop repeat count do (up-list point syntax)) (loop repeat (- count) do (backward-up-list point syntax))))) -(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 - 'lisp-table - '((#\x :control :meta))) - (define-command (com-beginning-of-definition :name t :command-table movement-table) ((count 'integer :prompt "Number of definitions")) (let* ((pane (current-window)) @@ -1354,11 +1344,5 @@ 'marking-table '((#\h :control :meta))) -(define-command (com-package :name t :command-table lisp-table) () - (let* ((pane (current-window)) - (syntax (syntax (buffer pane))) - (package (climacs-lisp-syntax::package-of syntax))) - (display-message (format nil "~s" package)))) - (define-command (com-visible-mark :name t :command-table marking-table) () (setf (mark-visible-p (current-window)) (not (mark-visible-p (current-window))))) --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/02/01 21:57:56 1.42 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/02/07 15:21:30 1.43 @@ -24,6 +24,14 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; The command table. + +(make-command-table 'lisp-table + :errorp nil + :inherit-from '(climacs-gui::global-climacs-table)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; the syntax object (define-syntax lisp-syntax (basic-syntax) @@ -36,7 +44,8 @@ (scan) (package)) (:name "Lisp") - (:pathname-types "lisp" "lsp" "cl")) + (:pathname-types "lisp" "lsp" "cl") + (:command-table lisp-table)) (defmethod initialize-instance :after ((syntax lisp-syntax) &rest args) (declare (ignore args)) --- /project/climacs/cvsroot/climacs/gui.lisp 2006/01/22 13:20:54 1.200 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/02/07 15:21:30 1.201 @@ -63,6 +63,14 @@ (defparameter *with-scrollbars* t "If T, classic look and feel. If NIL, stripped-down look (:") +;;; Basic command tables follow. The global command table, +;;; `global-climacs-table', inherits from these, so they should not +;;; contain any overly syntax-specific commands. The idea is that it +;;; should be safe for any syntax to inherit its command-table from +;;; `global-climacs-table' (so the usual movement, search and +;;; navigation-commands are available), without risking adding alien +;;; commands that require the buffer to be in a specific syntax. + ;;; Basic functionality (make-command-table 'base-table :errorp nil) ;;; buffers @@ -83,8 +91,6 @@ (make-command-table 'indent-table :errorp nil) ;;; information about the buffer (make-command-table 'info-table :errorp nil) -;;; lisp-related commands -(make-command-table 'lisp-table :errorp nil) ;;; marking things (make-command-table 'marking-table :errorp nil) ;;; moving around @@ -124,7 +130,6 @@ fill-table indent-table info-table - lisp-table marking-table movement-table pane-table --- /project/climacs/cvsroot/climacs/climacs.asd 2005/11/23 17:39:28 1.40 +++ /project/climacs/cvsroot/climacs/climacs.asd 2006/02/07 15:21:30 1.41 @@ -69,7 +69,8 @@ (:file "prolog-syntax" :depends-on ("packages" "base" "syntax" "pane" "buffer")) (:file "prolog2paiprolog" :depends-on ("prolog-syntax")) (:file "ttcn3-syntax" :depends-on ("packages" "buffer" "syntax" "base" "pane")) - (:file "lisp-syntax" :depends-on ("packages" "syntax" "buffer" "base" "pane")) + (:file "lisp-syntax" :depends-on ("packages" "syntax" "buffer" "base" "pane" "gui")) + (:file "lisp-syntax-commands" :depends-on ("lisp-syntax")) (:file "esa" :depends-on ("packages")) (:file "gui" :depends-on ("packages" "syntax" "base" "buffer" "undo" "pane" "esa" "kill-ring" "io" "text-syntax" "abbrev"))

1 0

[climacs-cvs] CVS climacs
by thenriksen 01 Feb '06

01 Feb '06

Update of /project/climacs/cvsroot/climacs In directory common-lisp:/tmp/cvs-serv16117 Modified Files: lisp-syntax.lisp Log Message: Fixed bug that would result in an error when a backward-expression command was invoked on an expression last in the file but with one or more comments following it. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/01/11 18:52:45 1.41 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/02/01 21:57:56 1.42 @@ -1457,7 +1457,11 @@ (form-before-in-children (children first) offset)))) ((and (>= offset (end-offset first)) (or (null rest) - (<= offset (start-offset (first-form rest))))) + ;; `first-form' may return NIL if there are nothing but + ;; comments left; in that case, just take a comment + ;; with `first'. + (<= offset (start-offset (or (first-form rest) + (first rest)))))) (return (let ((potential-form (when (typep first 'list-form) (form-before-in-children (children first) offset))))

1 0

[climacs-cvs] CVS climacs
by CVS User dmurray 22 Jan '06

22 Jan '06

Update of /project/climacs/cvsroot/climacs In directory common-lisp:/tmp/cvs-serv3558 Modified Files: gui.lisp Log Message: Changed *info-bg-color* to +gray85+ --- /project/climacs/cvsroot/climacs/gui.lisp 2006/01/08 09:08:17 1.199 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/01/22 13:20:54 1.200 @@ -100,7 +100,7 @@ (defvar *bg-color* +white+) (defvar *fg-color* +black+) -(defvar *info-bg-color* +white+) +(defvar *info-bg-color* +gray85+) (defvar *info-fg-color* +black+) (defvar *mini-bg-color* +white+) (defvar *mini-fg-color* +black+)

1 0

[climacs-cvs] CVS update: climacs/file-commands.lisp
by dmurray＠common-lisp.net 21 Jan '06

21 Jan '06

Update of /project/climacs/cvsroot/climacs In directory common-lisp:/tmp/cvs-serv26169 Modified Files: file-commands.lisp Log Message: Added defaults to find-file commands, thanks to Troels "Athas" Henriksen. Needs a recent mcclim. Date: Sat Jan 21 14:38:50 2006 Author: dmurray Index: climacs/file-commands.lisp diff -u climacs/file-commands.lisp:1.1 climacs/file-commands.lisp:1.2 --- climacs/file-commands.lisp:1.1 Sat Nov 12 03:38:32 2005 +++ climacs/file-commands.lisp Sat Jan 21 14:38:50 2006 @@ -169,8 +169,21 @@ (redisplay-frame-panes *application-frame*) buffer)))))) +(defun directory-of-buffer (buffer) + "Extract the directory part of the filepath to the file in BUFFER. + If BUFFER does not have a filepath, the path to the users home + directory will be returned." + (make-pathname + :directory + (pathname-directory + (or (filepath buffer) + (user-homedir-pathname))))) + (define-command (com-find-file :name t :command-table buffer-table) () - (let* ((filepath (accept 'pathname :prompt "Find File"))) + (let* ((filepath (accept 'pathname :prompt "Find File" + :default (directory-of-buffer (buffer (current-window))) + :default-type 'pathname + :insert-default t))) (find-file filepath))) (set-key 'com-find-file @@ -214,7 +227,10 @@ nil))))))) (define-command (com-find-file-read-only :name t :command-table buffer-table) () - (let ((filepath (accept 'pathname :Prompt "Find file read only"))) + (let ((filepath (accept 'pathname :Prompt "Find file read only" + :default (directory-of-buffer (buffer (current-window))) + :default-type 'pathname + :insert-default t))) (find-file-read-only filepath))) (set-key 'com-find-file-read-only @@ -235,11 +251,17 @@ (needs-saving buffer) t)) (define-command (com-set-visited-file-name :name t :command-table buffer-table) () - (let ((filename (accept 'pathname :prompt "New file name"))) + (let ((filename (accept 'pathname :prompt "New file name" + :default (directory-of-buffer (buffer (current-window))) + :default-type 'pathname + :insert-default t))) (set-visited-file-name filename (buffer (current-window))))) (define-command (com-insert-file :name t :command-table buffer-table) () - (let ((filename (accept 'pathname :prompt "Insert File")) + (let ((filename (accept 'pathname :prompt "Insert File" + :default (directory-of-buffer (buffer (current-window))) + :default-type 'pathname + :insert-default t)) (pane (current-window))) (when (probe-file filename) (setf (mark pane) (clone-mark (point pane) :left)) @@ -325,7 +347,10 @@ (call-next-method))) (define-command (com-write-buffer :name t :command-table buffer-table) () - (let ((filepath (accept 'pathname :prompt "Write Buffer to File")) + (let ((filepath (accept 'pathname :prompt "Write Buffer to File" + :default (directory-of-buffer (buffer (current-window))) + :default-type 'pathname + :insert-default t)) (buffer (buffer (current-window)))) (cond ((directory-pathname-p filepath)

1 0

[climacs-cvs] CVS update: climacs/lisp-syntax.lisp
by rstrandh＠common-lisp.net 11 Jan '06

11 Jan '06

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv17905 Modified Files: lisp-syntax.lisp Log Message: Indentation for with-open-file and some CLIM macros that I am currently using. Date: Wed Jan 11 19:52:45 2006 Author: rstrandh Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.40 climacs/lisp-syntax.lisp:1.41 --- climacs/lisp-syntax.lisp:1.40 Wed Jan 11 18:10:15 2006 +++ climacs/lisp-syntax.lisp Wed Jan 11 19:52:45 2006 @@ -2066,6 +2066,18 @@ (define-simple-indentor (flet indent-local-function-definitions)) (define-simple-indentor (labels indent-local-function-definitions)) +(define-simple-indentor (with-open-file indent-list)) + +;;; CLIM indentation + +(define-simple-indentor (clim:with-output-as-presentation indent-list)) +(define-simple-indentor (clim:vertically indent-list)) +(define-simple-indentor (clim:horizontally indent-list)) +(define-simple-indentor (clim:scrolling indent-list)) +(define-simple-indentor (clim:with-drawing-options indent-list)) +(define-simple-indentor (clim:define-command-table indent-list)) +(define-simple-indentor (clim:define-command indent-list indent-list)) +(define-simple-indentor (clim:define-application-frame indent-list indent-list)) (defun compute-path-in-trees (trees n offset) (cond ((or (null trees)

1 0

[climacs-cvs] CVS update: climacs/lisp-syntax.lisp
by rstrandh＠common-lisp.net 11 Jan '06

11 Jan '06

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv9480 Modified Files: lisp-syntax.lisp Log Message: Added indentation functions for `flet' and `labels'. Date: Wed Jan 11 18:10:16 2006 Author: rstrandh Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.39 climacs/lisp-syntax.lisp:1.40 --- climacs/lisp-syntax.lisp:1.39 Wed Dec 21 07:06:54 2005 +++ climacs/lisp-syntax.lisp Wed Jan 11 18:10:15 2006 @@ -1937,6 +1937,7 @@ (define-simple-indentor (defvar indent-form)) (define-simple-indentor (defparameter indent-form)) (define-simple-indentor (defconstant indent-form)) +(define-simple-indentor (lambda indent-ordinary-lambda-list)) ;;; non-simple-cases: LOOP, MACROLET, FLET, LABELS @@ -2043,6 +2044,28 @@ (values tree 2) (values tree 4)) (indent-form syntax (elt-form (children tree) (car path)) (cdr path)))) + +(defmethod indent-local-function-definition ((syntax lisp-syntax) tree path) + (cond ((null (cdr path)) + ;; top level + (cond ((= (car path) 1) + ;; before name, indent 1 + (values tree 1)) + ((= (car path) 2) + ;; between name and lambda list, indent 4 + (values (elt-form (children tree) 1) 4)) + (t + ;; after lambda list, indent 2 + (values (elt-form (children tree) 1) 2)))) + ((= (car path) 1) + ;; inside lambda list + (indent-ordinary-lambda-list syntax (elt-form (children tree) 1) (cdr path))) + (t (indent-form syntax (elt-form (children tree) (car path)) (cdr path))))) + +(define-list-indentor indent-local-function-definitions indent-local-function-definition) + +(define-simple-indentor (flet indent-local-function-definitions)) +(define-simple-indentor (labels indent-local-function-definitions)) (defun compute-path-in-trees (trees n offset) (cond ((or (null trees)

1 0

[climacs-cvs] CVS update: climacs/window-commands.lisp
by dholman＠common-lisp.net 09 Jan '06

09 Jan '06

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv11496 Modified Files: window-commands.lisp Log Message: Adding color customizations to constellations. Date: Mon Jan 9 05:15:19 2006 Author: dholman Index: climacs/window-commands.lisp diff -u climacs/window-commands.lisp:1.3 climacs/window-commands.lisp:1.4 --- climacs/window-commands.lisp:1.3 Mon Dec 5 10:56:19 2005 +++ climacs/window-commands.lisp Mon Jan 9 05:15:12 2006 @@ -82,7 +82,8 @@ (defun make-typeout-constellation (&optional label) (let* ((typeout-pane - (make-pane 'typeout-pane :width 900 :height 400 :display-time nil)) + (make-pane 'typeout-pane :foreground *fg-color* :background *bg-color* + :width 900 :height 400 :display-time nil)) (label (make-pane 'label-pane :label label)) (vbox @@ -128,6 +129,8 @@ :name 'window :end-of-line-action :scroll :incremental-redisplay t + :background *bg-color* + :foreground *fg-color* :display-function 'display-window :command-table 'global-climacs-table)) (vbox @@ -137,6 +140,8 @@ extended-pane) extended-pane) (make-pane 'climacs-info-pane + :background *info-bg-color* + :foreground *info-fg-color* :master-pane extended-pane :width 900)))) (values vbox extended-pane)))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by dholman＠common-lisp.net 08 Jan '06

08 Jan '06

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv18686 Modified Files: gui.lisp Log Message: Adds basic color customization and an example of its use. See (climacs-gui::climacs-rv) for climacs in reverse video. (Similar to `emacs -rv`) Date: Sun Jan 8 10:08:18 2006 Author: dholman Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.198 climacs/gui.lisp:1.199 --- climacs/gui.lisp:1.198 Mon Nov 14 17:30:13 2005 +++ climacs/gui.lisp Sun Jan 8 10:08:17 2006 @@ -98,9 +98,18 @@ ;;; windows (make-command-table 'window-table :errorp nil) +(defvar *bg-color* +white+) +(defvar *fg-color* +black+) +(defvar *info-bg-color* +white+) +(defvar *info-fg-color* +black+) +(defvar *mini-bg-color* +white+) +(defvar *mini-fg-color* +black+) + + (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 @@ -130,11 +139,15 @@ :width 900 :height 400 :end-of-line-action :scroll :incremental-redisplay t + :background *bg-color* + :foreground *fg-color* :display-function 'display-window :command-table 'global-climacs-table)) (info-pane (make-pane 'climacs-info-pane :master-pane extended-pane + :background *info-bg-color* + :foreground *info-fg-color* :width 900))) (setf (windows *application-frame*) (list extended-pane) (buffers *application-frame*) (list (buffer extended-pane))) @@ -145,7 +158,7 @@ extended-pane) extended-pane) info-pane))) - (minibuffer (make-pane 'climacs-minibuffer-pane :width 900))) + (minibuffer (make-pane 'climacs-minibuffer-pane :background *mini-bg-color* :foreground *mini-fg-color* :width 900))) (:layouts (default (vertically (:scroll-bars nil) @@ -176,6 +189,17 @@ (if new-process (clim-sys:make-process #'run :name process-name) (run))))) + +(defun climacs-rv (&key new-process (process-name "Climacs") + (width 900) (height 400)) + "Starts up a climacs session" + (let ((*bg-color* +black+) + (*fg-color* +white+) + (*info-bg-color* +blue+) + (*info-fg-color* +yellow+) + (*mini-bg-color* +black+) + (*mini-fg-color* +white+)) + (climacs :new-process new-process :process-name process-name :width width :height height))) (defun display-info (frame pane) (declare (ignore frame))

1 0

[climacs-cvs] CVS update: climacs/lisp-syntax.lisp
by rstrandh＠common-lisp.net 21 Dec '05

21 Dec '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24141 Modified Files: lisp-syntax.lisp Log Message: Fixed a minor bug that signaled an error when an attempt was made to parse the array syntax. Date: Wed Dec 21 07:06:54 2005 Author: rstrandh Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.38 climacs/lisp-syntax.lisp:1.39 --- climacs/lisp-syntax.lisp:1.38 Sat Oct 29 06:20:46 2005 +++ climacs/lisp-syntax.lisp Wed Dec 21 07:06:54 2005 @@ -905,7 +905,7 @@ ;;; reduce according to the rule form -> #A form (define-lisp-action (|#A form | t) - (reduce-until-type array-start-form array-start-lexeme)) + (reduce-until-type array-form array-start-lexeme)) ;;;;;;;;;;;;;;;; structure

1 0

[climacs-cvs] CVS update: climacs/window-commands.lisp
by dholman＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv28153 Modified Files: window-commands.lisp Log Message: Fixed behavior of window splits when there is just one climacs-pane, and tried to make sure the window always splits evenly. Date: Mon Dec 5 10:56:19 2005 Author: dholman Index: climacs/window-commands.lisp diff -u climacs/window-commands.lisp:1.2 climacs/window-commands.lisp:1.3 --- climacs/window-commands.lisp:1.2 Sun Nov 13 10:24:45 2005 +++ climacs/window-commands.lisp Mon Dec 5 10:56:19 2005 @@ -38,15 +38,31 @@ (first (first children)) (second (second children)) (third (third children)) + (first-split-p (= (length (sheet-children parent)) 2)) + (parent-region (sheet-region parent)) + (parent-height (rectangle-height parent-region)) + (parent-width (rectangle-width parent-region)) + (filler (when first-split-p (make-pane 'basic-pane))) ;Prevents resizing. (adjust (make-pane 'clim-extensions:box-adjuster-gadget))) (assert (member constellation children)) + + (when first-split-p (setf (sheet-region filler) (sheet-region parent)) + (sheet-adopt-child parent filler)) + (sheet-disown-child parent constellation) + + (if vertical-p + (resize-sheet constellation parent-width (/ parent-height 2)) + (resize-sheet constellation (/ parent-width 2) parent-height)) + (let ((new (if vertical-p (vertically () constellation adjust additional-constellation) (horizontally () constellation adjust additional-constellation)))) (sheet-adopt-child parent new) + + (when first-split-p (sheet-disown-child parent filler)) (reorder-sheets parent (if (eq constellation first) (if third @@ -283,8 +299,8 @@ (remove window (windows *application-frame*))) (setf *standard-output* (car (windows *application-frame*))) (sheet-disown-child box other) + (sheet-adopt-child parent other) (sheet-disown-child parent box) - (sheet-adopt-child parent other) (reorder-sheets parent (if (eq box first) (if third (list other second third)

1 0