/[linedit]/src/utility-functions.lisp
ViewVC logotype

Contents of /src/utility-functions.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (show annotations)
Sun Apr 25 11:40:18 2004 UTC (10 years ago) by nsiivola
Branch: MAIN
CVS Tags: HEAD
Changes since 1.12: +3 -1 lines
* Fixed a bug in completion (when completion was attempted on a fully completed name)
* Default of :if-exists :append to start-debug
1 ;; Copyright (c) 2003 Nikodemus Siivola
2 ;;
3 ;; Permission is hereby granted, free of charge, to any person obtaining
4 ;; a copy of this software and associated documentation files (the
5 ;; "Software"), to deal in the Software without restriction, including
6 ;; without limitation the rights to use, copy, modify, merge, publish,
7 ;; distribute, sublicense, and/or sell copies of the Software, and to
8 ;; permit persons to whom the Software is furnished to do so, subject to
9 ;; the following conditions:
10 ;;
11 ;; The above copyright notice and this permission notice shall be included
12 ;; in all copies or substantial portions of the Software.
13 ;;
14 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
17 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
18 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
19 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
20 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21
22 (in-package :linedit)
23
24 (declaim (type simple-string *word-delimiters*))
25 (defparameter *word-delimiters* "()[]{}',` \"")
26
27 (defvar *debug* nil)
28
29 (defun required ()
30 (error "Required argument missing."))
31
32 (defun concat (&rest strings)
33 (apply #'concatenate 'simple-string strings))
34
35 (defun word-delimiter-p (char)
36 (declare (simple-string *word-delimiters*)
37 (character char))
38 (find char *word-delimiters*))
39
40 (defun make-whitespace (n)
41 (make-string n :initial-element #\space))
42
43 (defun whitespacep (char)
44 (member char '(#\space #\newline #\tab #\return #\page)))
45
46 (defun at-delimiter-p (string index)
47 (and (< index (length string))
48 (word-delimiter-p (char string index))))
49
50 (defun start-debug (pathname &rest open-args)
51 "Start linedit debugging output to pathname, with additional
52 open-args passed to `open'."
53 (setf *debug* (apply #'open pathname
54 :direction :output
55 (append open-args '(:if-exists :append)))))
56
57 (defun end-debug ()
58 "End linedit debugging output."
59 (close *debug*)
60 (setf *debug* nil))
61
62 (defun dbg (format-string &rest format-args)
63 (when *debug*
64 (apply #'format *debug* format-string format-args)
65 (finish-output *debug*)))
66
67 (defun min* (&rest args)
68 "Like min, except ignores NILs."
69 (apply #'min (remove-if #'null args)))
70
71 (defun meta-escape (string)
72 (declare (simple-string string))
73 (let (stack)
74 (loop with last
75 for i from 1 upto (length string)
76 for char across string
77 ;; KLUDGE: Deal with character literals. Not quite sure this is
78 ;; the right and robust way to do it, though.
79 when (and (eql #\\ char) (not (eql #\# last)))
80 do (push #\\ stack)
81 do (push char stack)
82 (setf last char))
83 (coerce (nreverse stack) 'simple-string)))

  ViewVC Help
Powered by ViewVC 1.1.5