January 2006 - climacs-cvs@common-lisp.net

[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