clim-desktop-cvs

clim-desktop-cvs@common-lisp.net

70 discussions

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 05 Jun '06

05 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv2701 Modified Files: swine.lisp Log Message: `Symbol-name-at-mark': Survive if no symbol can be found at mark. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/04 22:25:15 1.24 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/05 20:21:50 1.25 @@ -124,8 +124,8 @@ (defun symbol-name-at-mark (mark syntax) "Return the text of the symbol at mark." - (token-string syntax - (symbol-at-mark mark syntax))) + (let ((token (symbol-at-mark mark syntax))) + (when token (token-string syntax token)))) (defun this-form (mark syntax) "Return a form at mark. This function defines which

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 04 Jun '06

04 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv20774 Modified Files: swine.lisp swine-cmds.lisp Log Message: Updated Swine to use the new package selection code in Climacs. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/03 18:14:42 1.23 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/04 22:25:15 1.24 @@ -143,13 +143,6 @@ (or (find-package package-designator) *package*)) -(defmacro with-syntax-package (syntax (package-sym) - &body body) - "Evaluate `body' with `package-sym' bound to a valid package, - preferably taken from `syntax'." - `(let ((,package-sym (usable-package (slot-value ,syntax 'package)))) - ,@body)) - (defmacro evaluating-interactively (&body body) `(handler-case (progn ,@body) (end-of-file () @@ -158,7 +151,7 @@ ;;; Real code: (defun macroexpand-token (syntax token &optional (all nil)) - (with-syntax-package syntax (package) + (with-syntax-package syntax (start-offset token) (package) (let ((*package* package)) (let* ((string (token-string syntax token)) (expression (read-from-string string)) @@ -204,7 +197,7 @@ (esa:display-message result)))) (defun compile-definition-interactively (mark pane syntax) - (with-syntax-package syntax (package) + (with-syntax-package syntax mark (package) (let* ((token (definition-at-mark mark syntax)) (string (token-string syntax token)) (m (clone-mark mark)) @@ -471,7 +464,7 @@ (when (and (needs-saving buffer) (accept 'boolean :prompt (format nil "Save buffer ~A ?" (name buffer)))) (climacs-gui::save-buffer buffer)) - (with-syntax-package (syntax buffer) (package) + (with-syntax-package (syntax buffer) 0 (package) (multiple-value-bind (result notes) (compile-file-for-climacs (filepath buffer) package load-p) (show-note-counts notes (second result)) @@ -1130,40 +1123,38 @@ (climacs-gui::delete-window *completion-pane*) (setf *completion-pane* nil))) -(defun show-completions-by-fn (fn symbol) - (with-slots (package) (syntax (buffer (climacs-gui::current-window))) - (climacs-gui::display-message (format nil "~a completions" symbol)) - (let* ((result (funcall fn symbol (package-name (usable-package package)))) - (set (first result)) - (longest (second result))) - (cond ((<= (length set) 1) - (clear-completions)) - (t (let ((stream (or *completion-pane* - (climacs-gui::typeout-window "Simple Completions")))) - (setf *completion-pane* stream) - (window-clear stream) - (format stream "~{~A~%~}" set)))) +(defun show-completions-by-fn (fn symbol package) + (climacs-gui::display-message (format nil "~a completions" symbol)) + (let* ((result (funcall fn symbol (package-name package))) + (set (first result)) + (longest (second result))) + (cond ((<= (length set) 1) + (clear-completions)) + (t (let ((stream (or *completion-pane* + (climacs-gui::typeout-window "Simple Completions")))) + (setf *completion-pane* stream) + (window-clear stream) + (format stream "~{~A~%~}" set)))) - (climacs-gui::display-message (format nil "Longest is ~a|" longest)) - longest))) + (climacs-gui::display-message (format nil "Longest is ~a|" longest)) + longest)) -(defun show-completions (symbol) - (show-completions-by-fn #'simple-completions symbol)) +(defun show-completions (symbol-name package) + (show-completions-by-fn #'simple-completions symbol-name package)) -(defun show-fuzzy-completions (symbol) - (with-syntax-package (syntax (buffer (climacs-gui::current-window))) (package) - (climacs-gui::display-message (format nil "~a completions" symbol)) - (let* ((set (fuzzy-completions symbol package 10)) - (best (caar set))) - (cond ((<= (length set) 1) - (clear-completions)) - (t (let ((stream (or *completion-pane* - (climacs-gui::typeout-window "Simple Completions")))) - (setf *completion-pane* stream) - (window-clear stream) - (loop for completed-string in set - do (format stream "~{~A ~}~%" completed-string))))) +(defun show-fuzzy-completions (symbol-name package) + (climacs-gui::display-message (format nil "~a completions" symbol-name)) + (let* ((set (fuzzy-completions symbol-name package 10)) + (best (caar set))) + (cond ((<= (length set) 1) + (clear-completions)) + (t (let ((stream (or *completion-pane* + (climacs-gui::typeout-window "Simple Completions")))) + (setf *completion-pane* stream) + (window-clear stream) + (loop for completed-string in set + do (format stream "~{~A ~}~%" completed-string))))) - (climacs-gui::display-message (format nil "Best is ~a|" best)) - best))) + (climacs-gui::display-message (format nil "Best is ~a|" best)) + best)) --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/06/03 18:14:42 1.21 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/06/04 22:25:15 1.22 @@ -32,7 +32,7 @@ (mark (point (current-window))) (token (form-before syntax (offset mark)))) (if token - (with-syntax-package syntax (package) + (with-syntax-package syntax mark (package) (let ((*package* package)) (climacs-gui::com-eval-expression (read-from-string (token-string syntax token)) @@ -238,16 +238,20 @@ If more than one completion is available, a list of possible completions will be displayed." - (let* ((point-current-window (point (current-window))) + (let* ((pane (current-window)) + (buffer (buffer pane)) + (syntax (syntax buffer)) + (point-current-window (point pane)) (name (symbol-name-at-mark point-current-window - (syntax (buffer (current-window)))))) + syntax))) (when name - (let ((completion (show-completions name)) - (mark (clone-mark point-current-window))) - (unless (= (length completion) 0) - (backward-object mark (length name)) - (delete-region mark point-current-window) - (insert-sequence point-current-window completion)))))) + (with-syntax-package syntax point-current-window (package) + (let ((completion (show-completions name package)) + (mark (clone-mark point-current-window))) + (unless (= (length completion) 0) + (backward-object mark (length name)) + (delete-region mark point-current-window) + (insert-sequence point-current-window completion))))))) (define-command (com-fuzzily-complete-symbol :name t :command-table lisp-table) () "Attempt to fuzzily complete the abbreviation at mark. @@ -255,16 +259,20 @@ Fuzzy completion tries to guess which symbol is abbreviated. If the abbreviation is ambiguous, a list of possible completions will be displayed." - (let* ((point-current-window (point (current-window))) + (let* ((pane (current-window)) + (buffer (buffer pane)) + (syntax (syntax buffer)) + (point-current-window (point pane)) (name (symbol-name-at-mark point-current-window - (syntax (buffer (current-window)))))) + syntax))) (when name - (let ((completion (show-fuzzy-completions name)) - (mark (clone-mark point-current-window))) - (unless (= (length completion) 0) - (backward-object mark (length name)) - (delete-region mark point-current-window) - (insert-sequence point-current-window completion)))))) + (with-syntax-package syntax point-current-window (package) + (let ((completion (show-fuzzy-completions name package)) + (mark (clone-mark point-current-window))) + (unless (= (length completion) 0) + (backward-object mark (length name)) + (delete-region mark point-current-window) + (insert-sequence point-current-window completion))))))) (esa:set-key 'com-complete-symbol 'lisp-table

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 03 Jun '06

03 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv21320 Modified Files: swine.lisp swine-cmds.lisp Log Message: Added `evaluating-interactively' macro for providing error messages when Climacs cannot convert some some text to code for evaluation or compilation, added usage of this macro to Eval Region and Compile Definition. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/03 17:50:56 1.22 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/03 18:14:42 1.23 @@ -150,6 +150,11 @@ `(let ((,package-sym (usable-package (slot-value ,syntax 'package)))) ,@body)) +(defmacro evaluating-interactively (&body body) + `(handler-case (progn ,@body) + (end-of-file () + (esa:display-message "Unbalanced parentheses in form.")))) + ;;; Real code: (defun macroexpand-token (syntax token &optional (all nil)) @@ -192,11 +197,7 @@ (offset start) (offset end))) (values (multiple-value-list - (handler-case (eval-string string) - (error (condition) - (progn (beep) - (esa:display-message "~A" condition) - (return-from eval-region nil)))))) + (eval-string string))) ;; Enclose each set of values in {}. (result (apply #'format nil "~{{~:[No values~;~:*~{~S~^,~}~]}~}" values))) --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/06/01 23:21:29 1.20 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/06/03 18:14:42 1.21 @@ -82,8 +82,9 @@ (point (point (current-window)))) (when (mark> mark point) (rotatef mark point)) - (eval-region mark point - (syntax (buffer (current-window)))))) + (evaluating-interactively + (eval-region mark point + (syntax (buffer (current-window))))))) (esa:set-key 'com-eval-region 'lisp-table @@ -92,9 +93,10 @@ (define-command (com-compile-definition :name t :command-table lisp-table) () "Compile and load definition at point." - (compile-definition-interactively (point (current-window)) - (current-window) - (syntax (buffer (current-window))))) + (evaluating-interactively + (compile-definition-interactively (point (current-window)) + (current-window) + (syntax (buffer (current-window)))))) (esa:set-key 'com-compile-definition 'lisp-table

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 03 Jun '06

03 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv19304 Modified Files: swine.lisp Log Message: Fixed `macroexpand-token' to set the package "properly" before macroexpanding and fixed `one-line-ify' to not break on strings with ending linespace. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/03 11:26:45 1.21 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/03 17:50:56 1.22 @@ -153,27 +153,29 @@ ;;; Real code: (defun macroexpand-token (syntax token &optional (all nil)) - (let* ((string (token-string syntax token)) - (expression (read-from-string string)) - (expansion (funcall (if all - #'macroexpand - #'macroexpand-1) - expression)) - (expansion-string (with-output-to-string (s) - (pprint expansion s)))) - (let ((buffer (climacs-gui::switch-to-buffer "*Macroexpansion*"))) - (climacs-gui::set-syntax buffer "Lisp")) - (let ((point (point (climacs-gui::current-window))) - (header-string (one-line-ify (subseq string 0 - (min 40 (length string)))))) - (climacs-gui::end-of-buffer point) - (unless (beginning-of-buffer-p point) - (insert-object point #\Newline)) - (insert-sequence point - (format nil ";;; Macroexpand-~:[1~;all~] ~A...~%" - all header-string)) - (insert-sequence point expansion-string) - (insert-object point #\Newline)))) + (with-syntax-package syntax (package) + (let ((*package* package)) + (let* ((string (token-string syntax token)) + (expression (read-from-string string)) + (expansion (funcall (if all + #'macroexpand + #'macroexpand-1) + expression)) + (expansion-string (with-output-to-string (s) + (pprint expansion s)))) + (let ((buffer (climacs-gui::switch-to-buffer "*Macroexpansion*"))) + (climacs-gui::set-syntax buffer "Lisp")) + (let ((point (point (climacs-gui::current-window))) + (header-string (one-line-ify (subseq string 0 + (min 40 (length string)))))) + (climacs-gui::end-of-buffer point) + (unless (beginning-of-buffer-p point) + (insert-object point #\Newline)) + (insert-sequence point + (format nil ";;; Macroexpand-~:[1~;all~] ~A...~%" + all header-string)) + (insert-sequence point expansion-string) + (insert-object point #\Newline)))))) (defun eval-string (string) "Evaluate all expressions in STRING and return a list of @@ -383,9 +385,13 @@ with new-string = (make-array 0 :element-type 'character :adjustable t :fill-pointer 0) when (char= (char string count) #\Newline) - do (vector-push-extend #\Space new-string) - (loop while (whitespacep (char string count)) - do (incf count)) + do (loop while (and (< count (length string)) + (whitespacep (char string count))) + do (incf count) + ;; Just ignore whitespace if it is last in the + ;; string. + finally (when (< count (length string)) + (vector-push-extend #\Space new-string))) else do (vector-push-extend (char string count) new-string) (incf count)

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 03 Jun '06

03 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv32393 Modified Files: swine.lisp Log Message: Check whether symbol is fbound before looking up it's arglist. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/02 21:06:32 1.20 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/03 11:26:45 1.21 @@ -478,7 +478,7 @@ (defmethod compute-list-indentation ((syntax lisp-syntax) symbol tree path) (if (null (cdr path)) ;; top level - (let* ((arglist (arglist symbol)) + (let* ((arglist (when (fboundp symbol) (arglist symbol))) (body-or-rest-pos (or (position '&body arglist) (position '&rest arglist)))) (if (and (or (macro-function symbol)

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 02 Jun '06

02 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv19697 Modified Files: swine.lisp Log Message: Added fallback indentation for macros (proper indentation of &body and &rest parameters even when no specific rules have been defined for the operator). Belongs in Climacs itself (as usual). --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/01 23:21:29 1.19 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/02 21:06:32 1.20 @@ -470,6 +470,36 @@ (show-note-counts notes (second result)) (when notes (show-notes notes (name buffer) ""))))) +;;; Fix indentation of macro forms: + +;; Redefine the basic method from Climacs to check the symbols argument list. +;; This gives us Emacs/SLIME-style indentation regarding +;; &body and &rest parameters in macros. +(defmethod compute-list-indentation ((syntax lisp-syntax) symbol tree path) + (if (null (cdr path)) + ;; top level + (let* ((arglist (arglist symbol)) + (body-or-rest-pos (or (position '&body arglist) + (position '&rest arglist)))) + (if (and (or (macro-function symbol) + (special-operator-p symbol)) + (and (not (null body-or-rest-pos)) + (plusp body-or-rest-pos))) + ;; macro-form with "interesting" arguments. + (if (>= (- (car path) 2) body-or-rest-pos) + ;; &body arg. + (values (elt-noncomment (children tree) 1) 1) + ;; non-&body-arg. + (values (elt-noncomment (children tree) 1) 3)) + ;; normal form. + (if (= (car path) 2) + ;; indent like first child + (values (elt-noncomment (children tree) 1) 0) + ;; indent like second child + (values (elt-noncomment (children tree) 2) 0)))) + ;; inside a subexpression + (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path)))) + ;;; Parameter hinting code. ;;; -----------------------

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 02 Jun '06

02 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv21969 Modified Files: climacs.lisp Log Message: Removed unnecessary Find File Arg command. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/06/01 23:00:09 1.11 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/06/02 09:25:09 1.12 @@ -4,10 +4,6 @@ (let ((url (accept 'url :prompt "Browse URL"))) (closure:visit url))) -(define-command (com-find-file-arg :name t :command-table buffer-table) - ((file 'pathname)) - (find-file file)) - (define-command (com-inspect-buffer :name "Inspect Buffer" :command-table base-table) () (clouseau:inspector (buffer (current-window))))

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 01 Jun '06

01 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv10585 Modified Files: swine.lisp swine-cmds.lisp Log Message: Changed the generic function `show-arglist-for-form' to a normal function named `show-arglist-for-form-at-mark', added `preceding-form' function and used it instead of `this-form' in the `with-code-insight' macro. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/01 19:59:11 1.18 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/01 23:21:29 1.19 @@ -133,6 +133,11 @@ (or (form-around syntax (offset mark)) (form-before syntax (offset mark)))) +(defun preceding-form (mark syntax) + "Return a form at mark." + (or (form-before syntax (offset mark)) + (form-around syntax (offset mark)))) + (defun usable-package (package-designator) "Return a usable package based on `package-designator'." (or (find-package package-designator) @@ -952,7 +957,7 @@ (,form-sym ;; Find a form with a valid (fboundp) operator. (let ((immediate-form - (this-form ,mark-value-sym ,syntax-value-sym))) + (preceding-form ,mark-value-sym ,syntax-value-sym))) ;; Recurse upwards until we find a form with a valid ;; operator. This could be improved a lot, as we could ;; inspect the lambda list of the found operator and @@ -977,21 +982,16 @@ (when ,form-sym (find-operand-info ,mark-value-sym ,syntax-value-sym ,form-sym)) ,@body)))) - ;; This is a generic function in order to facilitate different lambda - ;; list types for different form types (I'm not yet sure when this - ;; would be useful). -(defgeneric show-arglist-for-form (mark syntax) - (:documentation "Display the argument list for the operator of - `form'. The list need not be complete. If an argument list cannot - be retrieved for the operator, nothing will be displayed.")) - -(defmethod show-arglist-for-form (mark syntax) +(defun show-arglist-for-form-at-mark (mark syntax) + "Display the argument list for the operator of +`form'. The list need not be complete. If an argument list cannot +be retrieved for the operator, nothing will be displayed." (with-code-insight mark syntax (:operator operator :preceding-operand preceding-operand :preceding-operand-indices preceding-operand-indices :operands operands) - (when (valid-operator-p operator) - (show-arglist-silent operator preceding-operand-indices preceding-operand operands)))) + (when (valid-operator-p operator) + (show-arglist-silent operator preceding-operand-indices preceding-operand operands)))) (defparameter *find-definition-stack* '()) --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/31 18:01:04 1.19 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/06/01 23:21:29 1.20 @@ -223,9 +223,7 @@ ;; the parse tree our insertion of a space character may have ;; done. (update-syntax (buffer syntax) syntax) - ;; Try to find the argument before point, if that is not possible, - ;; find the form that point is in. - (show-arglist-for-form mark syntax) + (show-arglist-for-form-at-mark mark syntax) (forward-object mark) (clear-completions)))

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 01 Jun '06

01 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv8746 Modified Files: beirc.lisp Log Message: Added Edit User Init File command, partially for easy access and partially to show off Climacs. :) --- /project/clim-desktop/cvsroot/clim-desktop/beirc.lisp 2006/01/06 03:15:45 1.1.1.1 +++ /project/clim-desktop/cvsroot/clim-desktop/beirc.lisp 2006/06/01 23:02:22 1.2 @@ -2,3 +2,7 @@ (define-beirc-command (com-browse-url :name t) ((url 'url :prompt "url")) (closure:visit url)) + +(define-beirc-command (com-edit-user-init-file :name t) + () + (ed *beirc-user-init-file*))

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 01 Jun '06

01 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv7956 Modified Files: climacs.lisp Log Message: The Climacs-internal com-edit-definition and com-edit-definition-of-type commands should not be directly callable (Climacs uses the global CLIM commands as well, except for com-edit-this-definition of course), add Edit Symbol Definition as the global command for editing all definitions (this fixes a bug). --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/06/01 19:59:11 1.10 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/06/01 23:00:09 1.11 @@ -76,7 +76,7 @@ ;; These commands should only be called from within Climacs: -(define-command (com-edit-definition :name t :command-table global-climacs-table) +(define-command (com-edit-definition :command-table global-climacs-table) ((symbol 'symbol :prompt "Edit symbol")) "Edit the definition of a symbol as a given type. @@ -87,7 +87,7 @@ displayed." (climacs-lisp-syntax:edit-definition symbol)) -(define-command (com-edit-definition-of-type :name t :command-table global-climacs-table) +(define-command (com-edit-definition-of-type :command-table global-climacs-table) ((symbol 'symbol :prompt "Edit symbol") (type 'symbol)) @@ -111,6 +111,17 @@ ;; The following commands can be safely called from outside Climacs: +(define-command (com-edit-symbol-definition :name t :command-table global-command-table) + ((symbol 'symbol + :prompt "Edit symbol")) + "Edit the definition of a symbol as a given type. + +If the symbol has been defined more than once (eg. to a function +as well as a class, or as numerous methods), a +mouse-click-sensitive list of available definitions will be +displayed." + (edit-in-climacs symbol)) + (define-command (com-edit-class-definition :name t :command-table global-command-table) ((symbol 'symbol :prompt "Edit symbol")) @@ -128,7 +139,7 @@ (edit-in-climacs thing)) (define-presentation-to-command-translator global-edit-symbol-definition-translator - (symbol com-edit-definition global-command-table + (symbol com-edit-symbol-definition global-command-table :tester ((object presentation) (declare (ignore object)) (and (not (eq (presentation-type presentation) 'unknown-symbol))))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

clim-desktop-cvs