← Back to branch summary

~ubuntu-branches/ubuntu/karmic/maxima/karmic

« back to all changes in this revision

Viewing changes to share/contrib/stringproc/stringproc.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Barry deFreese
  • Date: 2006-07-06 17:04:52 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20060706170452-j9ypoqc1kjfnz221
Tags: 5.9.3-1ubuntu1
* Re-sync with Debian
* Comment out backward-delete-char-untabify in maxima.el (Closes Malone #5273)
* debian/control: build-dep automake -> automake1.9 (Closes BTS: #374663)

Show diffs side-by-side

added added

removed removed

Lines of Context:
share/contrib/stringproc/stringproc.lisp
 
1
;;
 
2
;;  string processing
 
3
 
 
4
;;  Author: Volker van Nek, Aachen, van.Nek@gmx.net
 
5
 
 
6
;;  Written for Maxima 5.9.2 .
 
7
 
 
8
;;  Test file: rteststringproc.mac
 
9
;;  Info file: stringproc.texi
 
10
 
 
11
;;  This program is free software; you can redistribute it and/or
 
12
;;  modify it under the terms of the GNU General Public License,
 
13
;;  http://www.gnu.org/copyleft/gpl.html.
 
14
 
 
15
;;  This program has NO WARRANTY, not even the implied warranty of
 
16
;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
17
 
 
18
;;  If you use this software for education, please let me know. 
 
19
 
 
20
;;  Date: 05-10-31
 
21
;;        05-11-03  fixed: $ssort (case inversion), $smismatch (1-indexed) 
 
22
;;                  new functions: invert-string-case, $sinvertcase
 
23
;;        05-11-09  fixed: $ssubst (test,s,e in recursive call) 
 
24
;;        05-11-12  new file-header 
 
25
;;        05-11-20  fixed: $cunlisp (Variable naming error) 
 
26
;;                  $sremove (unnecessary line deleted)
 
27
;;        05-11-27  fixed: $ascii (src/commac.lisp/ascii doesn't work with clisp) 
 
28
;;        06-01-06  commented out: $sprint (again in plot.lisp)
 
29
;;        06-01-10  fixed: m-string (make-symbol replaced by intern)
 
30
;;        06-02-22  fixed: strip&$ (problems with empty string)
 
31
;;                  fixed: $simplode (empty string: "&")
 
32
;;                  fixed: $ssubst (case inversion problem)
 
33
 
 
34
(in-package "MAXIMA")
 
35
 
 
36
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
37
;;  1. I/O
 
38
 
 
39
(defun $openw (file) 
 
40
   (open 
 
41
      (l-string file)
 
42
      :direction :output  
 
43
      :if-does-not-exist :create))
 
44
 
 
45
(defun $opena (file) 
 
46
   (open 
 
47
      (l-string file) 
 
48
      :direction :output 
 
49
      :if-exists :append
 
50
      :if-does-not-exist :create))
 
51
 
 
52
(defun $openr (file) (open (l-string file)))
 
53
      
 
54
(defun $close (stream) (close stream))
 
55
 
 
56
(defun $flength (stream) (file-length stream))
 
57
 
 
58
(defun $fposition (stream &optional pos)
 
59
   (if pos
 
60
      (file-position stream (1- pos))
 
61
      (1+ (file-position stream))))
 
62
   
 
63
 
 
64
(defun $readline (stream) 
 
65
   (let ((line (read-line stream nil nil)))
 
66
      (if line
 
67
         (m-string line))))
 
68
 
 
69
(defun $freshline (&optional (stream)) (fresh-line stream))
 
70
 
 
71
(defun $newline (&optional (stream)) (terpri stream))
 
72
 
 
73
 
 
74
;;  $printf covers most features of CL-function format
 
75
(defmacro $printf (stream mstring &rest args)
 
76
  (let ((string (l-string ($ssubst "~a" "~s" (meval mstring) '$sequalignore)))
 
77
        (listbrace ($ssearch "~{" (meval mstring)))
 
78
        body)
 
79
    (dolist (arg args)
 
80
       (progn
 
81
         (setq arg (meval arg))
 
82
         (setq arg 
 
83
           (cond ((numberp arg) arg)
 
84
                 ((mstringp arg) (l-string arg))
 
85
                 ((and (symbolp arg) (not (boundp arg)))
 
86
                    ;;`(quote ,(stripdollar arg)))  ;; 5.9.1
 
87
                    `(quote ,(maybe-invert-string-case (subseq (string arg) 1)))) ;; 5.9.2
 
88
                 ((and (listp arg) (listp (car arg)) (mlistp arg))
 
89
                    (if listbrace
 
90
                       `(quote ,(cltree arg))
 
91
                       (merror 
 
92
                          "printf: For printing lists use ~M in the control string." 
 
93
                          "\~\{ and \~\}")))
 
94
                 (t ($sconcat arg))))  
 
95
         (setq body (append body (list arg)))))
 
96
   (if stream
 
97
      `(format ,stream ,string ,@body)  
 
98
      `(m-string (format ,stream ,string ,@body)))))
 
99
 
 
100
;;  cltree converts a Maxima-tree into a CL-tree on lisp level
 
101
;;  helper-function for $printf
 
102
(defun cltree (mtree)
 
103
  (labels 
 
104
    ((clt (todo done)
 
105
       (if (null todo)
 
106
         (nreverse done)
 
107
         (clt (cdr todo) 
 
108
              (cons (let ((x (car todo)))
 
109
                      (if (and (listp x) (listp (car x)) (mlistp x)) 
 
110
                        (cltree x) 
 
111
                        (mhandle x)))
 
112
                    done))))
 
113
     (mhandle (obj)
 
114
       (progn
 
115
          (setq obj (meval obj))
 
116
          (cond ((numberp obj) obj)
 
117
                ((mstringp obj) (maxima-string obj))
 
118
                (t (if (and (symbolp obj) (not (boundp obj))) 
 
119
                      ;;(stripdollar obj)  ;; 5.9.1
 
120
                      (maybe-invert-string-case (subseq (string obj) 1)) ;; 5.9.2
 
121
                      ($sconcat obj)))))))  
 
122
   (clt (cdr mtree) nil)))  
 
123
 
 
124
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
125
;;  2. characters 
 
126
 
 
127
;;  converts a maxima-string of length 1 into a lisp-character
 
128
(defun $lchar (mch) (l-char mch));; for testing only
 
129
 
 
130
(defun l-char (mch) 
 
131
  (let ((smch (l-string mch)))
 
132
    (if (= (length smch) 1)
 
133
      (character smch)
 
134
      (merror 
 
135
        "stringproc2.lisp: ~:M cannot be converted into a character." 
 
136
          mch))))
 
137
 
 
138
;;  converts a lisp-character into a maxima-string of length 1
 
139
(defun $cunlisp (lch) (m-char lch));; for testing only
 
140
 
 
141
(defun m-char (lch)
 
142
   (m-string 
 
143
      (make-string 1 :initial-element lch)))
 
144
 
 
145
;;  tests, if object is lisp-character
 
146
(defun $lcharp (obj) (characterp obj));; for testing only
 
147
 
 
148
 
 
149
 
 
150
;;  tests, if object is maxima-character
 
151
(defun $charp (obj) 
 
152
   (and (mstringp obj) (= 1 (length (l-string obj)))))
 
153
 
 
154
;;  tests for different maxima-characters
 
155
(defun $constituent (mch)   (constituent (l-char mch)))
 
156
(defun $alphanumericp (mch) (alphanumericp (l-char mch)))
 
157
(defun $alphacharp (mch)    (alpha-char-p (l-char mch)))
 
158
(defun $lowercasep (mch)    (lower-case-p (l-char mch)))
 
159
(defun $uppercasep (mch)    (upper-case-p (l-char mch)))
 
160
(defun $digitcharp (mch)    
 
161
   (let ((nr (char-int (l-char mch))))
 
162
      (and (> nr 47) (< nr 58)))) 
 
163
 
 
164
;;  ascii-char <-> index
 
165
(defun $cint (mch) (char-int (l-char mch)))
 
166
(defun $ascii (int) (m-char (character int)))
 
167
 
 
168
;;  comparison - test functions
 
169
(defun $cequal (ch1 ch2)          (char= (l-char ch1) (l-char ch2)))
 
170
(defun $cequalignore (ch1 ch2)    (char-equal (l-char ch1) (l-char ch2)))
 
171
(defun $clessp (ch1 ch2)          (char< (l-char ch1) (l-char ch2)))
 
172
(defun $clesspignore (ch1 ch2)    (char-lessp (l-char ch1) (l-char ch2)))               
 
173
(defun $cgreaterp (ch1 ch2)       (char> (l-char ch1) (l-char ch2)))
 
174
(defun $cgreaterpignore (ch1 ch2) (char-greaterp (l-char ch1) (l-char ch2)))
 
175
 
 
176
#|
 
177
 $newline    (definitions placed beneath string functions)
 
178
 $tab      
 
179
 $space    
 
180
|#
 
181
           
 
182
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
183
;;  3.  strings 
 
184
 
 
185
#|
 
186
(defmfun strip& (obj) ;; 5.9.1
 
187
   (if (memq (getchar obj 1) '(&))
 
188
      (intern (subseq (string obj) 1))
 
189
      obj))
 
190
|#
 
191
(defmfun strip&$ (str) ;; 5.9.2
 
192
   (let ((c1 (string (getcharn str 1))))
 
193
      (if (or (equal c1 "&") (equal c1 "$"))
 
194
         (subseq str 1)
 
195
         str)))
 
196
 
 
197
 
 
198
;;  converts maxima-string into lisp-string
 
199
(defun $lstring (mstr) (l-string mstr)) ;; for testing only (avoid lisp string in maxima)
 
200
;;(defun l-string (mstr) (string (strip& mstr))) ;; 5.9.1
 
201
(defun l-string (mstr) (strip&$ (maybe-invert-string-case (string mstr)))) ;; 5.9.2
 
202
 
 
203
;;  converts lisp-string back into maxima-string
 
204
(defun $sunlisp (lstr) (m-string lstr))
 
205
;;(defun m-string (lstr) (make-symbol (concatenate 'string "&" lstr))) ;; 5.9.1
 
206
(defun m-string (lstr) (intern (maybe-invert-string-case (concatenate 'string "&" lstr)))) ;; 5.9.2
 
207
 
 
208
 
 
209
;;  tests, if object is lisp-string
 
210
(defun $lstringp (obj) (stringp obj))
 
211
 
 
212
;;  tests, if object is maxima-string
 
213
(defun $stringp (obj) (mstringp obj))
 
214
 
 
215
               
 
216
;;  copy               
 
217
(defun $scopy (mstr) 
 
218
   (m-string 
 
219
      (copy-seq (l-string mstr))))
 
220
 
 
221
;;  make
 
222
(defun $smake (n mch) 
 
223
   (m-string 
 
224
      (make-string n :initial-element (l-char mch))))
 
225
 
 
226
 
 
227
;;  returns a maxima-string of length 1
 
228
(defun $charat (mstr index) ;; 1-indexed!  
 
229
   (m-string 
 
230
      (subseq (l-string mstr) (1- index) index))) 
 
231
 
 
232
(defun $charlist (mstr) ;; 1-indexed!
 
233
   ;;(let* ((str (l-string mstr)) ;; 5.9.1
 
234
   (let* ((str (strip&$ (string mstr))) ;; 5.9.2
 
235
          (len (length str))
 
236
          lis)
 
237
      (do ((n 1 (1+ n)))
 
238
          ((> n len) lis)
 
239
          (setq lis (cons ($charat str n) lis)))
 
240
      (cons '(mlist) (reverse lis))))
 
241
 
 
242
(putprop '$sexplode '$charlist 'alias)
 
243
 
 
244
 
 
245
;;  $tokens implements Paul Grahams function tokens in Maxima
 
246
(defun $tokens (mstr &optional (test '$constituent))
 
247
  (cons '(mlist)
 
248
        (tokens (l-string mstr)
 
249
                ;(intern (string-upcase (string (stripdollar test))));; 5.9.1 
 
250
                (intern (string (stripdollar test)));; 5.9.2
 
251
                0)))
 
252
                     
 
253
(defun tokens (str test start) ;; Author: Paul Graham - ANSI Common Lisp, 1996, page 67
 
254
  (let ((p1 (position-if test str :start start)))
 
255
   (if p1
 
256
       (let ((p2 (position-if #'(lambda (ch) 
 
257
                                  (not (funcall test ch)))
 
258
                              str :start p1)))
 
259
         (cons (m-string (subseq str p1 p2)) ;; modified: conses maxima-strings
 
260
               (if p2 
 
261
                   (tokens str test p2) 
 
262
                   nil)))
 
263
       nil)))
 
264
           
 
265
;;  test functions for $tokens:                
 
266
(defun constituent (ch) ;; Author: Paul Graham - ANSI Common Lisp, 1996, page 67
 
267
  (and (graphic-char-p ch)
 
268
       (not (char= ch #\  ))))
 
269
 
 
270
(defun alphacharp (ch) (alpha-char-p ch))
 
271
(defun digitcharp (ch) (digit-char-p ch)) 
 
272
(defun lowercasep (ch) (lower-case-p ch))
 
273
(defun uppercasep (ch) (upper-case-p ch))
 
274
(defun charp (ch) (characterp ch))
 
275
;;     characterp (ch)  
 
276
;;     alphanumericp (ch)  
 
277
  
 
278
  
 
279
;;  splits string at an optional user defined delimiter character
 
280
;;  optional flag for multiple delimiter chars
 
281
(defun $split (mstr &optional (dc " ") (m t)) 
 
282
  (cons '(mlist) 
 
283
        (split (l-string mstr) 
 
284
               (character (stripdollar dc))
 
285
               m)))
 
286
                
 
287
(defun split (str dc &optional (m t)) 
 
288
  (labels 
 
289
    ((splitrest (str dc m start) 
 
290
       (let ((p1 (position dc str :start start)))
 
291
          (if p1
 
292
            (let* ((p2 (position dc str :start (1+ p1)))
 
293
                   (ss (subseq str (1+ p1) p2)))
 
294
               (if (and m (string= ss ""))
 
295
                 (if p2 (splitrest str dc m p2) nil)
 
296
                 (cons ss (if p2 (splitrest str dc m p2) nil))))
 
297
            nil))))
 
298
   (let ((p1 (position dc str)))
 
299
     (if p1
 
300
        (let ((ss (subseq str 0 p1))) 
 
301
           (if (and m (string= ss ""))
 
302
              (splitrest str dc m p1)
 
303
              (cons (m-string ss) (splitrest str dc m p1))))
 
304
        (list str)))))
 
305
 
 
306
;;  parser for numbers  
 
307
(defun $parsetoken (mstr)  
 
308
   (let ((res (with-input-from-string (lstr (l-string mstr)) 
 
309
                 (read lstr))))
 
310
      (if (numberp res) res)))
 
311
 
 
312
 
 
313
;;  $sconcat for lists, allows an optional user defined separator string
 
314
;;  returns maxima-string
 
315
(defun $simplode (lis &optional (ds "&")) 
 
316
   (setq lis (cdr lis))
 
317
   (let ((res ""))
 
318
      (setq ds (l-string ds))
 
319
      (dolist (mstr lis)
 
320
         (setq res (concatenate 'string res ($sconcat mstr) ds)))
 
321
      (m-string (string-right-trim ds res))))      
 
322
 
 
323
 
 
324
;;  modified version of $sconcat, returns maxima-string
 
325
(defun $sconc (&rest args)
 
326
  (let ((ans "") )
 
327
    (dolist (elt args)
 
328
       (setq ans 
 
329
          (concatenate 'string ans
 
330
             (cond ((and (symbolp elt) (eql (getcharn elt 1) #\&))
 
331
                      (l-string elt))
 
332
                   ((stringp elt) elt)
 
333
                   (t (coerce (mstring elt) 'string))))))
 
334
    (m-string ans))) 
 
335
 
 
336
 
 
337
 
 
338
(defun $slength (mstr) 
 
339
   (length (l-string mstr))) 
 
340
   
 
341
(defun $sposition (mch mstr) ;; 1-indexed!
 
342
   (let ((pos (position (l-char mch) (l-string mstr))))
 
343
     (if pos (1+ pos))))
 
344
   
 
345
(defun $sreverse (mstr) 
 
346
   (m-string 
 
347
      (reverse (l-string mstr))))
 
348
 
 
349
(defun $substring (mstr start &optional (end)) ;; 1-indexed!
 
350
   (m-string 
 
351
      (subseq (l-string mstr) (1- start) (if end (1- end)))))
 
352
 
 
353
 
 
354
;;  comparison - test functions   
 
355
(defun $sequalignore (mstr1 mstr2) 
 
356
   (string-equal (l-string mstr1) (l-string mstr2)))   
 
357
   
 
358
(defun $sequal (mstr1 mstr2) 
 
359
   (string= (l-string mstr1) (l-string mstr2)))  
 
360
 
 
361
 
 
362
;;  functions for string manipulation
 
363
(defun $ssubstfirst (news olds mstr &optional (test '$sequal) (s 1) (e)) ;; 1-indexed!
 
364
   (let* ((str (l-string mstr))
 
365
          (new (l-string news))
 
366
          (old (l-string olds))
 
367
          (len (length old))
 
368
          (pos (search old str 
 
369
                  :test (if (numberp test)
 
370
                           (merror
 
371
                             "ssubstfirst: Order of optional arguments: test, start, end")
 
372
                           test)
 
373
                  :start2 (1- s)
 
374
                  :end2 (if e (1- e)))))
 
375
      (m-string 
 
376
         (if (null pos)
 
377
            str
 
378
            (concatenate 'string 
 
379
               (subseq str 0 pos)
 
380
               new
 
381
               (subseq str (+ pos len)))))))
 
382
       
 
383
(defun $ssubst (news olds mstr &optional (test '$sequal) (s 1) (e)) ;; 1-indexed!
 
384
   (let* ((str (l-string mstr))
 
385
          (new (l-string news))
 
386
          (old (l-string olds))
 
387
          (pos (search old str 
 
388
                  :test (if (numberp test)
 
389
                           (merror
 
390
                             "ssubst: Order of optional arguments: test, start, end")
 
391
                           test)
 
392
                  :start2 (1- s)
 
393
                  :end2 (if e (1- e)))))
 
394
      (if (null pos) 
 
395
         (m-string str)
 
396
         ($ssubst  
 
397
            (maybe-invert-string-case new) 
 
398
            (maybe-invert-string-case old) 
 
399
            ($ssubstfirst  
 
400
               (maybe-invert-string-case new) 
 
401
               (maybe-invert-string-case old) 
 
402
               mstr test (1+ pos) (if e (1+ e)))
 
403
            test
 
404
            (1+ pos)
 
405
            (if e (1+ e)) ))))
 
406
 
 
407
 
 
408
(defun $sremove (seq mstr &optional (test '$sequal) (s 1) (e))  ;; 1-indexed!
 
409
  (labels ((sremovefirst (seq str &optional (test '$sequal) (s 0) (e)) 
 
410
     (let* ((len (length seq))
 
411
            (pos (search seq str 
 
412
                    :test test 
 
413
                    :start2 s 
 
414
                    :end2 e))
 
415
            (sq1 (subseq str 0 pos))
 
416
            (sq2 (subseq str (+ pos len))))
 
417
        (concatenate 'string sq1 sq2))))
 
418
   (let* ((str (l-string mstr))
 
419
          (sss (l-string seq))
 
420
          (end (if e (1- e)))
 
421
          (start (search sss str 
 
422
                    :test (if (numberp test)
 
423
                             (merror
 
424
                               "sremove: Order of optional arguments: test, start, end")
 
425
                             test)
 
426
                    :start2 (1- s) 
 
427
                    :end2 end)))
 
428
      (do ()
 
429
          ((null start) (m-string str))
 
430
          (progn
 
431
             (setq str (sremovefirst sss str test start end))
 
432
             (setq start (search sss str :test test :start2 start :end2 end)))))))
 
433
             
 
434
(defun $sremovefirst (seq mstr &optional (test '$sequal) (s 1) (e))  ;; 1-indexed!
 
435
   (let* ((str (l-string mstr))
 
436
          (sss (l-string seq))
 
437
          (len (length sss))
 
438
          (pos (search sss str 
 
439
                  :test (if (numberp test)
 
440
                           (merror
 
441
                             "sremovefirst: Order of optional arguments: test, start, end")
 
442
                           test)
 
443
                  :start2 (1- s) 
 
444
                  :end2 (if e (1- e))))
 
445
          (sq1 (subseq str 0 pos))
 
446
          (sq2 (if pos (subseq str (+ pos len)) "")))
 
447
      (m-string (concatenate 'string sq1 sq2))))
 
448
 
 
449
 
 
450
(defun $sinsert (seq mstr pos)  ;; 1-indexed!
 
451
   (let* ((str (l-string mstr))
 
452
          (sq1 (subseq str 0 (1- pos)))
 
453
          (sq2 (subseq str (1- pos))))
 
454
      (m-string (concatenate 'string sq1 (l-string seq) sq2))))
 
455
      
 
456
 
 
457
#|
 
458
(defun $ssort (mstr &optional (test '$clessp))  ;; 5.9.1
 
459
   (let ((copy (copy-seq (l-string mstr)))) 
 
460
      (m-string (sort copy test))))             
 
461
|#
 
462
 
 
463
(defun invert-string-case (string)  ;; 5.9.2
 
464
   (let* ((cl1 (explode (l-string string))) 
 
465
          (cl2 (map 'list #'l-char cl1))) ; l-char inverts case
 
466
      (string (implode (cdr (butlast cl2))))))
 
467
 
 
468
(defun $ssort (mstr &optional (test '$clessp))  ;; 5.9.2
 
469
   (let ((copy (invert-string-case (copy-seq (l-string mstr))))) 
 
470
      (m-string (invert-string-case (sort copy test)))))             
 
471
   
 
472
   
 
473
(defun $smismatch (mstr1 mstr2 &optional (test '$sequal))  ;; 1-indexed! 
 
474
   (1+ (mismatch (l-string mstr1) 
 
475
                 (l-string mstr2)
 
476
                 :test test))) 
 
477
 
 
478
(defun $ssearch (seq mstr &optional (test '$sequal) (s 1) (e))  ;; 1-indexed!
 
479
   (let ((pos 
 
480
           (search 
 
481
             (l-string seq) 
 
482
             (l-string mstr)
 
483
             :test (if (numberp test)
 
484
                     (merror 
 
485
                       "ssearch: Order of optional arguments: test, start, end")
 
486
                     test)
 
487
             :start2 (1- s)
 
488
             :end2 (if e (1- e)))))
 
489
     (if pos (1+ pos))))
 
490
 
 
491
 
 
492
 
 
493
(defun $strim (seq mstr) 
 
494
   (m-string 
 
495
      (string-trim (l-string seq) (l-string mstr))))
 
496
 
 
497
(defun $striml (seq mstr) 
 
498
   (m-string 
 
499
      (string-left-trim (l-string seq) (l-string mstr))))
 
500
 
 
501
(defun $strimr (seq mstr) 
 
502
   (m-string 
 
503
      (string-right-trim (l-string seq) (l-string mstr))))
 
504
 
 
505
 
 
506
 
 
507
(defun $supcase (mstr &optional (s 1) (e))  ;; 1-indexed!
 
508
   (m-string 
 
509
      (string-upcase (l-string mstr) :start (1- s) :end (if e (1- e)))))
 
510
 
 
511
(defun $sdowncase (mstr &optional (s 1) (e))  ;; 1-indexed!
 
512
   (m-string 
 
513
      (string-downcase (l-string mstr) :start (1- s) :end (if e (1- e)))))
 
514
 
 
515
(defun $sinvertcase (mstr &optional (s 1) (e)) ;; 5.9.2 only  ;; 1-indexed!
 
516
   (let* ((str (l-string mstr))
 
517
          (s1 (subseq str 0 (1- s)))
 
518
          (s2 (subseq str (1- s) (if e (1- e))))
 
519
          (s3 (if e (subseq str (1- e)) "")))
 
520
   (m-string 
 
521
      (concatenate 'string s1 (invert-string-case s2) s3)))) 
 
522
 
 
523
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
524
 
 
525
;; this character definitions must be placed beneath the definition of m-string
 
526
(defmvar $newline  (m-char #\newline))
 
527
(defmvar $tab      (m-char #\tab))
 
528
(defmvar $space    (m-char #\space))
 
529
 
 
530