├── EDIT.txt ├── ImageBasedDevelopment.txt ├── LICENSE.txt ├── LispEdit.lisp └── README.md /EDIT.txt: -------------------------------------------------------------------------------- 1 | 2 | EDIT - Structure editor for Common Lisp 3 | 4 | This code was taken from the LISPF4 project and was enhanced and 5 | converted to Common Lisp by Blake McBride. The LISPF4 editor is an 6 | implementation of the structure editor that came with InterLisp. 7 | 8 | In order for editing of functions to work, they must have been defined 9 | using the "defun" or "defmacro" defined in this package. 10 | 11 | Note that indexing of n'th element begins at 1, not 0. 12 | 13 | 14 | Several edit functions are implemented: 15 | 16 | (EDITF fn edcom) edit a function or macro. Value = NIL. 17 | (EDITS s edcom) edit any s-expr. Value = s 18 | (EDITV v edcom) edit variable v 19 | (EDITP s edcom) edit the property list associated with s 20 | edcom = list of edit commands 21 | (or NIL). If edcom is non-NIL the commands 22 | will be executed and the editor will exit. 23 | 24 | In what follows cexpr is the current expression. 25 | 26 | The following commands are implemented. 27 | 28 | OK Saves the changes and leaves the editor 29 | STOP Exits the editor without saving 30 | SAVE Saves edit for future edit session (only EDITF) 31 | 32 | Display: 33 | 34 | P Print to level 2 35 | PP PrettyPrint to level 2 36 | ? Print to level 100 37 | ?? PrettyPrint to level 100 38 | 39 | Positioning the cexpr: 40 | 41 | ! sets cexpr to top level expression 42 | n Set cexpr to the n'th element of cexpr. 43 | -n Set cexpr to the n'th element from the end of cexpr. 44 | 0 ascend one level. 45 | NX next expression 46 | (descend to the next element one level above) 47 | UP Ascend one level but only display elements to the 48 | right of the original cexpr. 49 | F expr searches the first occurrence of expr 50 | in the cexpr regardless of level 51 | 52 | (MARK atm) Set atom atm to the current edit position. 53 | (/ atm) Go to position marked by atom atm 54 | 55 | Expression editing: 56 | 57 | Adds: 58 | (-n e1 ...) inserts e1 ... before the n'th element. 59 | (N e1 ...) adds e1 ... after the last element within cexpr. 60 | (A e1 ...) Adds e1 ... AFTER cexpr. 61 | (B e1 ...) Adds e1 ... BEFORE cexpr. 62 | Replacing: 63 | (n e1 ...) n >= 1 replaces the n'th expression by e1 ... 64 | (= e1 ...) Replaces the entire current expression by e1 ... 65 | (R x y) All occurrences of x are replaced by y in cexpr. 66 | (MBD e1 ...) Replace cexpr with e1 ... and allow * to represent 67 | the original expression. 68 | Ex.: We have (PRINT X) and we want 69 | (COND ((NULL L) (PRINT X) NIL) 70 | (T (PRINT X) (GO LOP))) 71 | we do 72 | (MBD (COND ((NULL L) * NIL) 73 | (T * (GO LOP)))) 74 | (XTR e1 ...) Ex.: We have (COND ((NULL L) NIL) 75 | (T (PRINT L)) 76 | and we want (PRINT L) 77 | we do 78 | (XTR 3 2), (XTR (PRINT L)) or 79 | (XTR PRINT) 80 | 81 | Deletions: 82 | (n) n >= 1 deletes the n'th expression of cexpr 83 | (=) Delete the current expression. 84 | 85 | Global editing: 86 | 87 | S x Set x to the current expression. 88 | (US x cmds) Execute edit commands cmds with the ability to 89 | utilize the expression in atom x 90 | S and US can be used in different edit sessions. 91 | 92 | Ex.: Move the PROG expression of FOO to be the PROG expression of 93 | another function FII. 94 | 95 | (EDITF FOO) 96 | F PROG S DEF OK 97 | (EDITF FII) 98 | (US DEF (3 DEF)) OK 99 | 100 | The 3'rd element (the prog expression of FII) is replaced by the one 101 | stored in DEF. 102 | 103 | Parenthesis manipulation: 104 | 105 | (BI n m) Both In. A left parenthesis is inserted before 106 | the n'th element and a right parenthesis is 107 | inserted after the m'th element. 108 | (BI n) insert parenthesis around the n'th element 109 | (BO n) Both Out. Removes both parenthesis from the 110 | n'th element. 111 | (LI n) Left In. Inserts a left parenthesis before the 112 | n'th element and a corresponding right at the end 113 | (LO n) Left Out. Removes the left parenthesis from the 114 | n'th element. All elements after the n'th element 115 | are deleted. 116 | (RI n m) Right In. Move the parenthesis at the end of the 117 | n'th element in to after the m'th element inside 118 | the n'th element. 119 | (RO n) Right Out. Move the right parenthesis of the n'th 120 | element to the end of the current expression. All 121 | elements following the n'th element are moved 122 | inside the n'th element. 123 | 124 | Evaluation: 125 | 126 | E expr Evaluate expression expr. 127 | 128 | (ESET x c1...) Sets atom x to the edit commands c1... 129 | x Executes the edit commands associates with atom x. 130 | (ESET x) Disassociates all edit commands from atom x. 131 | 132 | -------------------------------------------------------------------------------- /ImageBasedDevelopment.txt: -------------------------------------------------------------------------------- 1 | A popular development scenario that I term "disk based" looks like the 2 | following: 3 | 4 | A. A program is created / edited with a text editor (like emacs) 5 | 6 | B. The code is saved to a disk file (like myprogram.lisp ) 7 | 8 | C. A language interpreter / compiler loads (from disk or a socket) 9 | and runs the code where the programmer evaluates its performance 10 | 11 | D. Go back to A. 12 | 13 | --- 14 | 15 | There is another development scenario that is old, but may be worth 16 | looking into. I term this other method "image based" and it looks 17 | like the following: 18 | 19 | 1. Code is added and edited right in the environment where it is being 20 | used (like CCL, SBCL, CLISP, etc.). Editing the code could be done 21 | with an editor like a structure editor written in Lisp rather than a 22 | text editor. 23 | 24 | 2. Run the code right in the environment it was created in. 25 | 26 | 3. Go to step 1 in order to continue development. 27 | 28 | Also: 29 | 30 | 4. The state of the project can be saved as an image file 31 | representing the entire project when necessary (i.e. CLISP .mem file, 32 | SBCL and CMUCL .core file, CCL image file, etc.). 33 | 34 | 5. A disk / text form of the application can also be created for 35 | reference or porting whenever needed (like mypackage.lisp ). 36 | 37 | Languages that use this latter model include Smalltalk and InterLisp. 38 | 39 | --- 40 | 41 | In order to do image based development in Common Lisp, certain tools 42 | are needed: 43 | 44 | a. A way of editing a program, like a structure editor 45 | 46 | b. A way of writing a text form of the application when desired (item 47 | 5 above) 48 | 49 | c. The interpreter / compiler should be able to save / load an image 50 | 51 | I have completed item "a". Item "b" is rudimentary. Item "c" 52 | is already included in many Lisp interpreters / compilers. Those 53 | without it can save/load a text form that will be provided by item 54 | "b", although this is somewhat clunky. 55 | 56 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | LISPF4 and its associated documentation are: 2 | 3 | Copyright (c) 1984 Dr. Mats Nordstrom, Hans Eriksson, Kristina Johansson, Dr. Tore Risch, 4 | Mats Carlsson, and Jaan Koort 5 | All rights reserved. 6 | 7 | Portions Copyright (c) 2015 Blake McBride 8 | 9 | 10 | Redistribution and use in source and binary forms, with or without 11 | modification, are permitted provided that the following conditions are 12 | met: 13 | 14 | 1. Redistributions of source code must retain the above copyright 15 | notice, this list of conditions and the following disclaimer. 16 | 17 | 2. Redistributions in binary form must reproduce the above copyright 18 | notice, this list of conditions and the following disclaimer in the 19 | documentation and/or other materials provided with the distribution. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | -------------------------------------------------------------------------------- /LispEdit.lisp: -------------------------------------------------------------------------------- 1 | ;; Common Lisp Structure Editor 2 | 3 | ;; The editor code was taken from the structure editor in LISPF4 and is: 4 | ;; Copyright (c) 1984 Dr. Mats Nordstrom, Hans Eriksson, Kristina Johansson, Dr. Tore Risch, 5 | ;; Mats Carlsson, and Jaan Koort 6 | ;; All rights reserved. 7 | 8 | ;; It was subsequently enhanced and converted to Common Lisp by: 9 | ;; Copyright (c) 2015 Blake McBride (blake@mcbridemail.com) 10 | 11 | ;; It is released under the license that accompanies this file. 12 | 13 | 14 | (CL:DEFPACKAGE "LISPEDIT" 15 | (:USE "COMMON-LISP") 16 | (:SHADOW "DEFMACRO" 17 | "DEFUN" 18 | "LOAD") 19 | (:EXPORT "DEFUN" 20 | "DEFMACRO" 21 | "EDITF" 22 | "EDITV" 23 | "EDITP" 24 | "EDITS" 25 | "LOAD" 26 | "MAKEFILE" 27 | "SAVE-IMAGE")) 28 | (IN-PACKAGE "LISPEDIT") 29 | 30 | (DEFPARAMETER *PACKAGE-SPECIAL* '( 31 | (SHADOW 'DEFMACRO) 32 | (SHADOW 'DEFUN) 33 | (SHADOW 'LOAD) 34 | (SETF (GET 'DEFMACRO 'FNCELL) 35 | '(MACRO (&REST ARGS) 36 | `(PROGN (COMMON-LISP:DEFMACRO ,(CAR ARGS) ,(CADR ARGS) ,@(CDDR ARGS)) 37 | (SETF (GET ',(CAR ARGS) 'FNCELL) '(MACRO ,@(CDR ARGS))) 38 | ',(CAR ARGS)))) 39 | (LET ((FUN (GET 'DEFMACRO 'FNCELL))) 40 | (EVAL `(COMMON-LISP:DEFMACRO DEFMACRO ,@(CDR FUN)))) 41 | )) 42 | 43 | (SHADOW 'DEFMACRO) 44 | (SETF (GET 'DEFMACRO 'FNCELL) 45 | '(MACRO (&REST ARGS) 46 | `(PROGN (COMMON-LISP:DEFMACRO ,(CAR ARGS) ,(CADR ARGS) ,@(CDDR ARGS)) 47 | (SETF (GET ',(CAR ARGS) 'FNCELL) '(MACRO ,@(CDR ARGS))) 48 | ',(CAR ARGS)))) 49 | (LET ((FUN (GET 'DEFMACRO 'FNCELL))) 50 | (EVAL `(COMMON-LISP:DEFMACRO DEFMACRO ,@(CDR FUN)))) 51 | 52 | ;; (COMMON-LISP:DEFMACRO DEFMACRO (&REST ARGS) 53 | ;; `(PROGN 54 | ;; (COMMON-LISP:DEFMACRO ,(CAR ARGS) 55 | ;; ,(CADR ARGS) 56 | ;; ,@(CDDR ARGS)) 57 | ;; (SETF (GET ',(CAR ARGS) 'FNCELL) 58 | ;; '(MACRO ,@(CDR ARGS))) 59 | ;; ',(CAR ARGS))) 60 | 61 | (SHADOW 'DEFUN) 62 | (DEFMACRO DEFUN (&REST ARGS) 63 | `(PROGN 64 | (COMMON-LISP:DEFUN ,(CAR ARGS) 65 | ,(CADR ARGS) 66 | ,@(CDDR ARGS)) 67 | (SETF (GET ',(CAR ARGS) 'FNCELL) 68 | '(LAMBDA ,@(CDR ARGS))) 69 | ',(CAR ARGS))) 70 | 71 | (SHADOW 'LOAD) 72 | (DEFUN LOAD (FNAME) 73 | (WITH-OPEN-FILE (S FNAME :DIRECTION :INPUT :IF-DOES-NOT-EXIST :ERROR) 74 | (PROG (EXP) 75 | LOOP 76 | (SETQ EXP (READ S NIL :EOF)) 77 | (AND (EQ EXP :EOF) 78 | (RETURN NIL)) 79 | (EVAL EXP) 80 | (GO LOOP)))) 81 | 82 | (DEFUN IS-FUNCTION (SYMBOL) 83 | (AND (FBOUNDP SYMBOL) 84 | (NOT (MACRO-FUNCTION SYMBOL)) 85 | (NOT (SPECIAL-OPERATOR-P SYMBOL)))) 86 | 87 | (DEFUN IS-MACRO (SYMBOL) 88 | (AND (FBOUNDP SYMBOL) 89 | (MACRO-FUNCTION SYMBOL) 90 | (NOT (SPECIAL-OPERATOR-P SYMBOL)))) 91 | 92 | (DEFUN MAKEFILE (FNAME) 93 | (WITH-OPEN-FILE (S FNAME :DIRECTION :OUTPUT :IF-EXISTS :OVERWRITE :IF-DOES-NOT-EXIST :CREATE) 94 | (MAPC (LAMBDA (X) (PRINT X S)(TERPRI S)) *PACKAGE-SPECIAL*) 95 | (DO-ALL-SYMBOLS (SYM) 96 | (WHEN (AND (EQ (FIND-PACKAGE 'COMMON-LISP-USER) 97 | (SYMBOL-PACKAGE SYM)) 98 | (BOUNDP SYM) 99 | (NOT (EQ SYM '*PACKAGE-SPECIAL*))) 100 | (PPRINT (CONS 'DEFPARAMETER (LIST SYM `',(SYMBOL-VALUE SYM))) S) 101 | (TERPRI S))) 102 | (DO-ALL-SYMBOLS (SYM) 103 | (WHEN (AND (EQ (FIND-PACKAGE 'COMMON-LISP-USER) 104 | (SYMBOL-PACKAGE SYM)) 105 | (IS-MACRO SYM)) 106 | (PPRINT (CONS 'DEFMACRO (CONS SYM (CDR (GET SYM 'FNCELL)))) S) 107 | (TERPRI S))) 108 | (DO-ALL-SYMBOLS (SYM) 109 | (WHEN (AND (EQ (FIND-PACKAGE 'COMMON-LISP-USER) 110 | (SYMBOL-PACKAGE SYM)) 111 | (IS-FUNCTION SYM)) 112 | (PPRINT (CONS 'DEFUN (CONS SYM (CDR (GET SYM 'FNCELL)))) S) 113 | (TERPRI S))) 114 | (AND (BOUNDP '*PACKAGE-SPECIAL*) 115 | *PACKAGE-SPECIAL* 116 | (PPRINT `(DEFPARAMETER *PACKAGE-SPECIAL* ',*PACKAGE-SPECIAL*) S) 117 | (TERPRI S))) 118 | FNAME) 119 | 120 | (DEFMACRO INTH (L N) 121 | `(NTHCDR (1- ,N) ,L)) 122 | 123 | (DEFMACRO NLISTP (X) 124 | `(NOT (CONSP ,X))) 125 | 126 | (DEFMACRO COM-READ (CMD) 127 | `(PROG (RET) 128 | (COND ((NULL ,CMD) 129 | (PRINC "EDIT> " *QUERY-IO*) 130 | (FINISH-OUTPUT *QUERY-IO*) 131 | (RETURN (READ *QUERY-IO*))) 132 | (T (SETQ RET (CAR ,CMD)) 133 | (SETQ ,CMD (CDR ,CMD)) 134 | (RETURN RET))))) 135 | 136 | (DEFMACRO EDMSG (MSG) 137 | `(PROGN 138 | (PRINC ,MSG *QUERY-IO*) 139 | (TERPRI *QUERY-IO*) 140 | (SETQ EDCOM NIL) 141 | (GO NEXT))) 142 | 143 | (DEFMACRO EDITF (FN &REST L) 144 | `(PROG ((ESF (GET ',FN 'EDIT-SAVE)) 145 | (VF (GET ',FN 'FNCELL)) 146 | RESULT EXIT-TYPE) 147 | (MULTIPLE-VALUE-SETQ (RESULT EXIT-TYPE) (EDITS (OR ESF VF) ,@L)) 148 | (CASE EXIT-TYPE 149 | (OK (REMPROP ',FN 'EDIT-SAVE) 150 | (SETF (GET ',FN 'FNCELL) RESULT) 151 | (CASE (CAR RESULT) 152 | (LAMBDA 153 | ; (SETF (SYMBOL-FUNCTION ',FN) (COERCE RESULT 'FUNCTION))) 154 | (SETF (SYMBOL-FUNCTION ',FN) (COMPILE NIL RESULT))) 155 | (MACRO 156 | (EVAL (CONS 'DEFMACRO (CONS ',FN (CDR RESULT))))))) 157 | (SAVE (SETF (GET ',FN 'EDIT-SAVE) RESULT))) 158 | (RETURN ',FN))) 159 | 160 | (DEFMACRO EDITP (A &REST L) 161 | `(PROG (EXIT-TYPE VAL) 162 | (MULTIPLE-VALUE-SETQ (VAL EXIT-TYPE) (EDITS (SYMBOL-PLIST ',A) ,@L)) 163 | (AND (EQ EXIT-TYPE 'OK) 164 | (SETF (SYMBOL-PLIST ',A) VAL)) 165 | (RETURN ',A))) 166 | 167 | (DEFMACRO EDITV (A &REST L) 168 | `(PROG (EXIT-TYPE VAL) 169 | (MULTIPLE-VALUE-SETQ (VAL EXIT-TYPE) (EDITS ,A ,@L)) 170 | (AND (EQ EXIT-TYPE 'OK) 171 | (SETQ ,A VAL)) 172 | (RETURN ',A))) 173 | 174 | (DEFUN EDFIND1ST2 (A S TRC) 175 | (PROG (RES) 176 | LOOP (COND ((NLISTP S) 177 | (RETURN)) 178 | ((EQUAL A (CAR S)) 179 | (RETURN (CONS (CAR S) TRC))) 180 | ((SETQ RES 181 | (EDFIND1ST2 A 182 | (CAR S) 183 | (CONS (CAR S) TRC))) 184 | (RETURN RES)) 185 | (T (SETQ S (CDR S)) 186 | (GO LOOP))))) 187 | 188 | (DEFUN EDFIND1ST (A S TRC) 189 | (PROG (TEMP) 190 | (COND ((SETQ TEMP (MEMBER A (CDR S))) 191 | (RETURN (CONS TEMP TRC))) 192 | ((SETQ TEMP 193 | (EDFIND1ST2 A 194 | (COND ((EQUAL (CAR S) A) 195 | (CDR S)) 196 | (T S)) 197 | TRC)) 198 | (RETURN TEMP))) 199 | LOOP 200 | (SETQ S (CAR TRC)) 201 | (SETQ TRC (CDR TRC)) 202 | (COND ((NULL TRC) 203 | (RETURN)) 204 | ((SETQ TEMP 205 | (EDFIND1ST2 A 206 | (CDR (MEMBER S (CAR TRC))) 207 | TRC)) 208 | (RETURN TEMP)) 209 | (T (GO LOOP))))) 210 | 211 | (DEFUN EDITPR (X PP DEPTH CTLS) 212 | (LET ((*PRINT-LEVEL* DEPTH) 213 | (*PRINT-PRETTY* PP)) 214 | (COND ((TAILP X (CADR CTLS)) 215 | (PRINC "--- " *QUERY-IO*) 216 | (MAPC #'(LAMBDA (Y) 217 | (COND (PP (PRIN1 Y *QUERY-IO*) 218 | (PRINC " " *QUERY-IO*)) 219 | (T (PRINC Y *QUERY-IO*) 220 | (PRINC " " *QUERY-IO*)))) 221 | X) 222 | (PRINC ")" *QUERY-IO*) 223 | (TERPRI *QUERY-IO*)) 224 | (T (COND (PP (PRIN1 X *QUERY-IO*) 225 | (TERPRI *QUERY-IO*)) 226 | (T (PRIN1 X *QUERY-IO*) 227 | (TERPRI *QUERY-IO*))))))) 228 | 229 | (DEFUN EDSMASH (X A B) 230 | (RPLACA X A) 231 | (RPLACD X B)) 232 | 233 | (DEFUN EDITS (S-ORIG &REST EDCOM) 234 | (PROG (CL CTLS TEMP X A B L (S (COPY-TREE S-ORIG))) 235 | (AND (NLISTP S) 236 | (PRINT "NOT EDITABLE") 237 | (RETURN (VALUES NIL 'CANT-EDIT))) 238 | (AND EDCOM (SETQ EDCOM (APPEND EDCOM '(OK)))) 239 | START 240 | (SETQ CL S) 241 | (SETQ CTLS (LIST CL)) 242 | NEXT 243 | (SETQ L (COM-READ EDCOM)) 244 | (COND ((ATOM L) 245 | (GO ATOML))) 246 | (SETQ X (CAR L)) 247 | (SETQ L (CDR L)) 248 | (COND ((INTEGERP X) 249 | (GO NUMCARX)) 250 | ((GET X 'DEEDITL) 251 | (SETQ EDCOM 252 | (APPEND 253 | (APPLY (GET X 'DEEDITL) 254 | (LIST L)) 255 | EDCOM)) 256 | (GO NEXT)) 257 | (T (CASE X 258 | (R (NSUBST (CADR L) 259 | (CAR L) CL)) 260 | (N (NCONC CL L)) 261 | (US (COND ((SETQ TEMP 262 | (COPY-TREE (GET (CAR L) 'EDITVALUE))) 263 | (SETQ EDCOM 264 | (APPEND (SUBST TEMP (CAR L) (CDR L)) 265 | EDCOM))) 266 | (T (GO ILLG)))) 267 | (MARK (SETF (GET (CAR L) 'EDITCHAIN) CTLS)) 268 | (/ (COND ((AND (SYMBOLP (CAR L)) 269 | (SETQ TEMP 270 | (GET (CAR L) 'EDITCHAIN))) 271 | (SETQ CL (CAR TEMP)) 272 | (SETQ CTLS TEMP)) 273 | (T (GO ILLG)))) 274 | (= (SETQ EDCOM 275 | (CONS 'UP 276 | (CONS (CONS 1 L) EDCOM)))) 277 | (MBD (SETQ EDCOM 278 | (CONS (CONS '= (SUBST CL '* L)) 279 | (CONS 1 EDCOM)))) 280 | (XTR (SETQ EDCOM 281 | (APPEND 282 | (CONS 283 | '(MARK LISPF4-XTR) 284 | (APPEND L 285 | '(S LISPF4-XTR 286 | (/ LISPF4-XTR) 287 | (US LISPF4-XTR 288 | (= LISPF4-XTR))))) 289 | EDCOM))) 290 | (B (SETQ EDCOM 291 | (APPEND 292 | (LIST 'UP (CONS -1 L)) 293 | EDCOM))) 294 | (A (SETQ EDCOM 295 | (APPEND 296 | (LIST 'UP (CONS -2 L)) 297 | EDCOM))) 298 | (ESET (COND (L (COND 299 | ((SYMBOLP (CAR L)) 300 | (COND 301 | ((CADR L) 302 | (SETF (GET (CAR L) 'DEEDITA) (LIST 'QUOTE (CDR L)))) 303 | (T (REMPROP (CAR L) 'DEEDITA)))))))) 304 | (OTHERWISE (GO CONT))))) 305 | (GO NEXT) 306 | CONT (COND ((OR (NULL (INTEGERP (CAR L))) 307 | (< (CAR L) 1)) 308 | (GO ILLG))) 309 | (OR (SETQ TEMP (INTH CL (CAR L))) 310 | (GO EMPTY)) 311 | (CASE X 312 | (LO (EDSMASH TEMP (CAAR TEMP) 313 | (CDAR TEMP))) 314 | (LI (EDSMASH TEMP 315 | (CONS (CAR TEMP) 316 | (CDR TEMP)) 317 | NIL)) 318 | (RO (NCONC (CAR TEMP) 319 | (CDR TEMP)) 320 | (RPLACD TEMP NIL)) 321 | (RI (OR (INTEGERP (CADR L)) 322 | (GO ILLG)) 323 | (SETQ A (INTH (CAR TEMP) 324 | (CADR L))) 325 | (OR (CDR A) 326 | (GO EMPTY)) 327 | (RPLACD TEMP (NCONC (CDR A) 328 | (CDR TEMP))) 329 | (RPLACD A NIL)) 330 | (BO (EDSMASH TEMP 331 | (CAAR TEMP) 332 | (NCONC (CDAR TEMP) 333 | (CDR TEMP)))) 334 | (BI (SETQ B 335 | (CDR (SETQ A 336 | (COND ((NULL 337 | (INTEGERP (CADR L))) 338 | TEMP) 339 | (T (INTH CL (CADR L))))))) 340 | (RPLACD A NIL) 341 | (EDSMASH TEMP (CONS (CAR TEMP) 342 | (CDR TEMP)) B)) 343 | (OTHERWISE (GO ILLG))) 344 | (GO NEXT) 345 | NUMCARX 346 | (COND ((ZEROP X) 347 | (GO ILLG)) 348 | ((< X 0) 349 | (COND ((EQL X -1) 350 | (SETQ L 351 | (NCONC L 352 | (CONS (CAR CL) 353 | (CDR CL)))) 354 | (EDSMASH CL (CAR L) 355 | (CDR L))) 356 | ((NLISTP 357 | (SETQ A (INTH CL (- (1+ X))))) 358 | (GO EMPTY)) 359 | (T (RPLACD A (NCONC L (CDR A)))))) 360 | ((EQL X 1) 361 | (COND (L (EDSMASH CL 362 | (CAR L) 363 | (NCONC (CDR L) 364 | (CDR CL)))) 365 | ((NLISTP CL) 366 | (GO EMPTY)) 367 | ((NLISTP (CDR CL)) 368 | (SETQ TEMP (LENGTH (CADR CTLS))) 369 | (SETQ EDCOM 370 | (NCONC 371 | (LIST 0 372 | (CASE TEMP 373 | (1 '(1 NIL)) 374 | (OTHERWISE (CONS TEMP NIL)))) 375 | EDCOM))) 376 | (T (EDSMASH CL (CADR CL) 377 | (CDDR CL))))) 378 | ((NLISTP (SETQ A (INTH CL (1- X)))) 379 | (GO EMPTY)) 380 | (T (RPLACD A 381 | (COND ((CDR A) 382 | (NCONC L (CDDR A))) 383 | (T L))))) 384 | (GO NEXT) 385 | ATOML 386 | (SETQ X L) 387 | (COND ((INTEGERP X) 388 | (COND ((ZEROP X) 389 | (OR (CDR CTLS) 390 | (GO TOP)) 391 | (SETQ CTLS (CDR CTLS)) 392 | (SETQ CL (CAR CTLS))) 393 | (T (AND (< X 0) 394 | (SETQ X 395 | (+ (LENGTH CL) 1 X))) 396 | (SETQ X (INTH CL X)) 397 | (OR (LISTP X) 398 | (GO EMPTY)) 399 | (SETQ CL (CAR X)) 400 | (SETQ CTLS (CONS CL CTLS))))) 401 | (T (CASE X 402 | (P (EDITPR CL NIL 2 CTLS)) 403 | (PP (EDITPR CL T 2 CTLS)) 404 | (OK (RETURN (VALUES S 'OK))) 405 | (STOP (RETURN (VALUES S-ORIG 'STOP))) 406 | (SAVE (RETURN (VALUES S 'SAVE))) 407 | (UP (COND ((TAILP CL (CADR CTLS))) 408 | ((NULL (CDR CTLS)) 409 | (GO TOP)) 410 | (T (SETQ CTLS (CDR CTLS)) 411 | (SETQ CL 412 | (MEMBER CL (CAR CTLS))) 413 | (OR (EQ CL (CAR CTLS)) 414 | (SETQ CTLS (CONS CL CTLS)))))) 415 | (E (SETQ EDCOM (CONS (READ *QUERY-IO*) EDCOM)) 416 | (SETQ X (EVAL (COM-READ EDCOM))) 417 | (COND ((NULL EDCOM) 418 | (PRIN1 X *QUERY-IO*) 419 | (TERPRI *QUERY-IO*)))) 420 | (F (SETQ EDCOM (CONS (READ *QUERY-IO*) EDCOM)) 421 | (SETQ TEMP 422 | (EDFIND1ST 423 | (COM-READ EDCOM) 424 | CL CTLS)) 425 | (COND ((NULL TEMP) 426 | (EDMSG "NOT FOUND")) 427 | (T (SETQ CTLS TEMP) 428 | (SETQ CL (CAR TEMP)))) 429 | (COND ((ATOM CL) 430 | (SETQ EDCOM (CONS 'UP EDCOM))))) 431 | (! (GO START)) 432 | (NX (COND ((TAILP CL (CADR CTLS)) 433 | (SETQ CL (CDR CL)) 434 | (RPLACA CTLS CL)) 435 | (T (SETQ CTLS (CDR CTLS)) 436 | (SETQ CL 437 | (CADR (MEMBER CL (CAR CTLS)))) 438 | (SETQ CTLS (CONS CL CTLS))))) 439 | (? (EDITPR CL NIL 100 CTLS)) 440 | (?? (EDITPR CL T 100 CTLS)) 441 | (S (SETQ EDCOM (CONS (READ *QUERY-IO*) EDCOM)) 442 | (SETQ A (COM-READ EDCOM)) 443 | (COND ((SYMBOLP A) 444 | (SETF (GET A 'EDITVALUE) CL)) 445 | (T (GO ILLG)))) 446 | (OTHERWISE (COND ((AND (SYMBOLP X) (GET X 'DEEDITA)) 447 | (SETQ EDCOM 448 | (APPEND 449 | (EVAL (GET X 'DEEDITA)) 450 | EDCOM))) 451 | (T (GO ILLG))))))) 452 | (GO NEXT) 453 | ILLG (EDMSG "ILLEGAL COMMAND") 454 | TOP (EDMSG "ON TOP LEVEL") 455 | EMPTY 456 | (EDMSG "LIST EMPTY"))) 457 | 458 | #+:sbcl (defmacro save-image (file) `(sb-ext:save-lisp-and-die ,file)) 459 | #+:clisp (defmacro save-image (file) `(saveinitmem ,file)) 460 | #+:ccl (defmacro save-image (file) `(ccl:save-application ,file)) 461 | 462 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | *LISP Editor* 2 | 3 | The included code attempts to create an image based development 4 | environment as described in the file named ImageBasedDevelopment.txt 5 | 6 | The included structure editor is where the focus of my effort has been 7 | thus far. It is a pretty complete substantial sub-set of the standard 8 | InterLisp structure editor for Common Lisp. I have done some minimal 9 | testing on all of its functions. As far as I know, it functions error 10 | free. 11 | 12 | Since Common Lisp does not keep source s-exp's on loaded source code, 13 | I had to re-define the standard DEFUN & DEFMACRO to save a copy of the 14 | source on the symbol's property list, in addition to doing what DEFUN 15 | & DEFMACRO are supposed to do. You must use these if you wish to edit 16 | functions and macros. I have also created a LOAD that will use the 17 | defined DEFUN & DEFMACRO facilities. 18 | 19 | The editor provides four function. One edits functions and macros, 20 | one for variables, one for property lists, and one for s-exp's. 21 | So, for example, a function named MyFun may be edited as follows: 22 | 23 | (EDITF MyFun) 24 | 25 | You should not quote the function name. A complete reference manual 26 | for the editor is contained in the file named EDIT.txt 27 | 28 | There is also a function named MAKEFILE. That function attempts to 29 | write all of the functions, macros, and variables within a package 30 | into am external text file in a for suitable for reload'ing using the 31 | accompanying LOAD. It is extremely rudimentary at this point and 32 | surly needs to be enhanced. 33 | 34 | FUTURE 35 | 36 | The system does not yet understand anything beyond functions, macros, 37 | and variables. It needs work to understand CLOS and packages. 38 | 39 | I suppose currently the real value in this package is the structure 40 | editor. That is pretty complete and useful. Much of the rest of the 41 | code represents a small effort to create an environment that would render 42 | the structure editor useful. 43 | 44 | Source code for this system is available at: [https://github.com/blakemcbride/LispEdit](https://github.com/blakemcbride/LispEdit) 45 | 46 | Blake McBride 47 | blake@mcbridemail.com 48 | 49 | --------------------------------------------------------------------------------