readline.lisp

   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 readline)
  23
  24 (defvar *whitespace* (list #\Space #\Tab))
  25
  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)
  29       lisp-string))
  30
  31 (defmacro ignore-end-of-file (&body forms)
  32   `(catch 'end-of-file
  33     (handler-bind ((end-of-file (lambda (e)
  34                                   (declare (ignore e))
  35                                   (throw 'end-of-file nil))))
  36       ,@forms)))
  37
  38 (def-function ("readline" c-readline)
  39     ((prompt :cstring))
  40   :module "readline"
  41   :returning (* :char))
  42
  43 (def-function ("add_history" c-add-history)
  44     ((str :cstring))
  45   :module "readline"
  46   :returning :void)
  47
  48 (def-function ("add_completion" c-add-completion)
  49     ((str :cstring))
  50   :module "cl-readline"
  51   :returning :int)
  52
  53 (def-function ("clear_completions" c-clear-completions)
  54     ()
  55   :module "cl-readline"
  56   :returning :void)
  57
  58 (def-function "use_custom_complete"
  59     ()
  60   :module "cl-readline"
  61   :returning :void)
  62
  63 (def-function "use_filename_complete"
  64     ()
  65   :module "cl-readline"
  66   :returning :void)
  67
  68 (let (pkg)
  69
  70   (defun add-completion (string)
  71     "Add STRING as a custom-completion."
  72     (setq pkg nil)
  73     (with-cstring (c-str string)
  74       (= 1 (c-add-completion c-str))))
  75
  76   (defun clear-completions ()
  77     "Clear all custom-completions."
  78     (setq pkg nil)
  79     (c-clear-completions))
  80
  81   (defun use-package-complete (package)
  82     "Load symbols in package CL-USER as custom-completions."
  83     (unless (eql pkg package)
  84       (setq pkg package)
  85       (clear-completions)
  86       (do-symbols (sym (find-package package))
  87         (add-completion (string-downcase (string sym)))))
  88     (use-custom-complete)
  89     nil))
  90
  91 ;;; Everything that affects the custom-completion collection goes
  92 ;;; above.
  93
  94
  95 (defun add-history (string)
  96   "Add STRING to history."
  97   (with-cstring (c-string string)
  98     (c-add-history c-string))
  99   string)
 100
 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)))
 107         (add-history str2))
 108       str)))
 109
 110 (defun readexpr (&key
 111                  (primary-prompt "=> ")
 112                  (secondary-prompt "|     ")
 113                  (history t))
 114   "Read an expression from current TTY with line-editing."
 115   (let (expr)
 116     (do* ((str (readline :prompt primary-prompt :history history)
 117                (readline :prompt secondary-prompt :history history))
 118           (input str (concatenate 'string input " " str)))
 119          ((ignore-end-of-file
 120            (setq expr (with-input-from-string (in input)
 121                         (read in nil nil))))
 122           expr))))
 123
 124 ;;
 125 ;; Termios
 126 ;;
 127
 128 (def-function "no_echo"
 129     ()
 130   :module "cl-termios"
 131   :returning :void)
 132
 133 (def-function "restore_term"
 134     ()
 135   :module "cl-termios"
 136   :returning :void)
 137
 138 (defmacro without-echo (&body forms)
 139   `(unwind-protect
 140     (progn
 141       (no-echo)
 142       ,@forms)
 143     (restore-term)))