| |
|---|
| | ;;; author: Daniel Vedder |
|---|
| | ;;; date: 09/05/2015 |
|---|
| | ;;; |
|---|
| | |
|---|
| | (defpackage "DV-UTILS" |
|---|
| | (:nicknames "UTILS") |
|---|
| | (:use "COMMON-LISP") |
|---|
| | (:export |
|---|
| | "LET-GENSYMS" "DEBUGGING" "SIMPLE-INPUT" "MAGIC" "SET-LIST" "INPUT" |
|---|
| | "INPUT-STRING" "WHILE" "!=" "CASSOC" "SAFE-NTH" "SAFE-AREF" "DOVECTOR" |
|---|
| | "REMOVE-FIRST-IF" "AVERAGE" "KEYS" "LETTER-IN-STRING" "STRING-FROM-LIST" |
|---|
| | "SPLIT-STRING" "CUT-STRING" "CHAR-LIST-TO-STRING" "TRIM-WHITESPACE" |
|---|
| | "TO-STRING" "EXTRACT-ELEMENTS" "COUNT-INSTANCES" "SET-P" "TO-LIST" |
|---|
| | "CUT-LIST" "RANDOM-ELT" "LOAD-TEXT-FILE" "PRINT-TEXT-FILE" |
|---|
| | "WRITE-TO-FILE" "BUILD-SYMBOL" "MAKE-LIST-FUNCTION" "NUMBER-MENU" |
|---|
| | "CHOOSE-NUMBER-OPTION" "CHOOSE-OPTION" "CLEAR-SCREEN" "REPL")) |
|---|
| | |
|---|
| | (in-package "DV-UTILS") |
|---|
| | |
|---|
| | ;;; MACROS |
|---|
| | |
|---|
| | (defmacro let-gensyms (syms &body body) |
|---|
| | "Gratefully copied from Paul Graham's 'On Lisp'..." |
|---|
| | ;; I had to rename it from with-gensyms due to a naming conflict |
|---|
| | `(let ,(mapcar #'(lambda (s) |
|---|
| | `(,s (gensym))) |
|---|
| | syms) |
|---|
| | ,@body)) |
|---|
| | |
|---|
| | (defmacro debugging (str &rest format-args) |
|---|
| | "If *debugging* is true, print str" |
|---|
| | `(when *debugging* (format t ,str ,@format-args))) |
|---|
| | |
|---|
| | ;; TODO DEPRECATED - Needs to be replaced in the current code |
|---|
| | (defmacro simple-input (var &optional (prompt ">>>")) |
|---|
| | "Take input from terminal and store it in var" |
|---|
| | `(progn |
|---|
| | (format t "~&~A " ,prompt) |
|---|
| | (setf ,var (read)))) |
|---|
| | |
|---|
| | ;; XXX Very useful for debugging, but represents a major security hole |
|---|
| | ;; when used in a network setting |
|---|
| | (defmacro magic (var) |
|---|
| | "Execute typed-in Lisp code" |
|---|
| | `(when (eq ,var 'magic) |
|---|
| | (repl))) |
|---|
| | |
|---|
| | ;; XXX potentially inefficient if called often |
|---|
| | (defmacro set-list (value &rest var-list) |
|---|
| | "Set each symbol in var-list to value" |
|---|
| |
|---|
| | ;; XXX Add a prompt parameter again? |
|---|
| | `(progn |
|---|
| | (format t "~&>>> ") |
|---|
| | (set-list (read) ,@vars) |
|---|
| | (magic (first (list ,@vars))) |
|---|
| | (first (list ,@vars)))) |
|---|
| | |
|---|
| | (defmacro input-string (&optional (var (gensym))) |
|---|
| | "Read a string input line" |
|---|
| | `(progn |
|---|
| | (format t "~&>>> ") |
|---|
| | (setf ,var (read-line)) |
|---|
| | (magic (read-from-string ,var)) |
|---|
| | ,var)) |
|---|
| | |
|---|
| | (defmacro while (condition &body body) |
|---|
| | "An implementation of a while loop as found in other languages" |
|---|
| |
|---|
| | (format t "~&Invalid choice! Please choose again:~%>>> ") |
|---|
| | (setf choice (read))) |
|---|
| | (funcall (second (nth choice entries)))) |
|---|
| | |
|---|
| | (defun clear-screen () |
|---|
| | "Clear the screen in an OS-dependent manner" |
|---|
| | ;; NOTE: only works with CLISP! (ext:shell function used) |
|---|
| | (cond ((member ':unix *features*) (ext:shell "clear")) |
|---|
| | ((member ':win32 *features*) (ext:shell "cls")) |
|---|
| | (t (debugging "~&clear-screen is not supported on this operating system!")))) |
|---|
| | |
|---|
| | |
