1 ;; Copyright (c) 2003 Nikodemus Siivola
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:
11 ;; The above copyright notice and this permission notice shall be included
12 ;; in all copies or substantial portions of the Software.
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.
24 (defvar *whitespace* (list #\Space #\Tab))
26 (defun convert-and-free-foreign-string (foreign-string)
27 (let ((lisp-string (convert-from-foreign-string foreign-string)))
28 (free-foreign-object foreign-string)
31 (defmacro ignore-end-of-file (&body forms)
33 (handler-bind ((end-of-file (lambda (e)
35 (throw 'end-of-file nil))))
38 (def-function ("readline" c-readline)
43 (def-function ("add_history" c-add-history)
48 (def-function ("add_completion" c-add-completion)
53 (def-function ("clear_completions" c-clear-completions)
58 (def-function "use_custom_complete"
63 (def-function "use_filename_complete"
70 (defun add-completion (string)
71 "Add STRING as a custom-completion."
73 (with-cstring (c-str string)
74 (= 1 (c-add-completion c-str))))
76 (defun clear-completions ()
77 "Clear all custom-completions."
79 (c-clear-completions))
81 (defun use-package-complete (package)
82 "Load symbols in package CL-USER as custom-completions."
83 (unless (eql pkg package)
86 (do-symbols (sym (find-package package))
87 (add-completion (string-downcase (string sym)))))
91 ;;; Everything that affects the custom-completion collection goes
95 (defun add-history (string)
96 "Add STRING to history."
97 (with-cstring (c-string string)
98 (c-add-history c-string))
101 (defun readline (&key (prompt "") (history t))
102 "Read a line from current TTY with line-editing."
103 (with-cstring (c-prompt prompt)
104 (let* ((str (convert-and-free-foreign-string (c-readline c-prompt)))
105 (str2 (string-trim *whitespace* str)))
106 (when (and history (not (string= "" str2)))
110 (defun readexpr (&key
111 (primary-prompt "=> ")
112 (secondary-prompt "| ")
114 "Read an expression from current TTY with line-editing."
116 (do* ((str (readline :prompt primary-prompt :history history)
117 (readline :prompt secondary-prompt :history history))
118 (input str (concatenate 'string input " " str)))
120 (setq expr (with-input-from-string (in input)
128 (def-function "no_echo"
133 (def-function "restore_term"
138 (defmacro without-echo (&body forms)