├── .gitattributes ├── LICENSE ├── README.md └── lsh.rkt /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 Dexter Santucci 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # lsh 2 | Lisp Shell 3 | 4 | This is a cross-platform shell developed in Racket. To use, either compile to binary using Racket 6.11 or newer, or run: 5 | 6 | Windows: 7 | "C:\Program Files\Racket\racket.exe" -f "lsh.rkt" -e "(require 'lsh)" -i 8 | 9 | Unix: 10 | racket -f "lsh.rkt" -e "(require 'lsh)" -i 11 | 12 | Available commands: 13 | 14 | help ; displays this message 15 | cd ; displays the current working directory or change it 16 | cd/ ; same as (cd "/") - goes back to filesystem root 17 | pwd ; print the current directory's path 18 | dir ; list the current directory's file list or the specified path 19 | ls ; prints the current folder's file list 20 | mkdir ; makes a folder 21 | run ; run a program from the current directory, optionally takes parameters 22 | run# ; run a program directly using its path 23 | racket ; edit a file using DrRacket 24 | edit ; edit a file using notepad 25 | edit-me ; edit lsh source file using DrRacket 26 | url ; browse to an url 27 | google ; google an url 28 | cp ; copy a file or folder 29 | mkdir ; create a folder 30 | touch ; create an empty file 31 | find ; walk the current path 32 | show ; pretty-prints a command result 33 | rm ; delete a file 34 | rmdir ; delete a folder 35 | echo ; display something on the screen 36 | search ; equivalent to Google's 'I'm feeling lucky' 37 | 38 | LSH evaluates Scheme and Racket forms from the command line. Remember to (display ) forms if you need to output results to the screen. 39 | This is still very Alpha, but I use it all the time, so you might as well have it too. I use it in Windows, but it should work out of the box on Linux, BSD and MacOS - and if not, would require minor changes. 40 | 41 | ## License 42 | 43 | LSH is free software; see [LICENSE](https://github.com/DexterLagan/lsh/blob/main/LICENSE) for more details. 44 | -------------------------------------------------------------------------------- /lsh.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/gui 2 | 3 | ; A library to explore files and directories DOS and UNIX style. 4 | ; Typically, DOS commands will display path objects while their UNIX counterparts will pretty-print paths instead. 5 | 6 | ; Version history: 7 | ; Alpha 8 | ; v0.1 - First version. Racket 6.7. 9 | ; v0.2 - Adds support for extra commands such as google, touch, edit, find, show, earch and echo. Racket 6.10. 10 | ; v0.3 - Adds support for variables (get/set) and self-editing with edit-me. Racket 6.11. 11 | ; v0.3b - Light version without gui library support. Racket 6.11. 12 | ; v0.3.1b - fixes save-script. Racket 6.11. 13 | ; v0.4 - First posted on GitHub, gui enabled. 14 | 15 | (define current-version "v0.4 Alpha") 16 | 17 | (provide help ; displays this message 18 | cd ; displays the current working directory or change it 19 | cd/ ; same as (cd "/") - goes back to filesystem root 20 | pwd ; print the current directory's path 21 | dir ; list the current directory's file list or the specified path 22 | ls ; prints the current folder's file list 23 | mkdir ; makes a folder 24 | run ; run a program from the current directory, optionally takes parameters 25 | run# ; run a program directly using its path 26 | racket ; edit a file using DrRacket 27 | edit ; edit a file using notepad 28 | edit-me ; edit lsh source file using DrRacket 29 | url ; browse to an url 30 | google ; google an url 31 | cp ; copy a file or folder 32 | mkdir ; create a folder 33 | touch ; create an empty file 34 | find ; walk the current path 35 | show ; pretty-prints a command result 36 | rm ; delete a file 37 | rmdir ; delete a folder 38 | echo ; display something on the screen 39 | search) ; equivalent to Google's 'I'm feeling lucky' 40 | 41 | ;;; defs 42 | 43 | ;; generic about message 44 | (define (about) (echo "Welcome to LSH (Lisp SHell) " current-version " - type help for usage.")) 45 | 46 | ;; display help page 47 | (define (help) 48 | (newline) 49 | (about) 50 | (displayln "Available commands: 51 | help ; displays this message 52 | cd ; displays the current working directory or change it 53 | cd\\ ; same as (cd \"/\") - goes back to the filesystem's root 54 | pwd ; print the current directory's path 55 | dir ; list the current directory's file list or the specified path 56 | ls ; prints the current folder's file list 57 | run ; run a program, optionally takes parameters 58 | racket ; edit a file using DrRacket 59 | cat ; display a text file on the screen 60 | edit ; edit a file using notepad 61 | edit-me ; edit a file using DrRacket 62 | url ; browse to an url 63 | google ; google an url 64 | search ; search and open first matching link 65 | 66 | Advanced commands: 67 | echo [something] ; displays something on the screen 68 | cp src dst ; copy a file or folder 69 | mkdir dst ; create a folder 70 | touch [file path] ; create an empty file 71 | find ; walk the current path 72 | find [wildcard] ; walk and filter the current path 73 | find pred ... ; same as find-files 74 | show v ; pretty-prints result of a command that returns a list 75 | rm file ; delete a file 76 | rmdir dir ; delete a folder 77 | set var = value ; set a local variable 78 | set ; list local variables and their values 79 | start-recording ; start recording a script 80 | save-script [file path] ; stops recording and save the script")) 81 | 82 | ;; generic + 83 | (require (except-in racket +) (rename-in racket [+ old+])) 84 | (define + 85 | (lambda args 86 | (cond [(no args) null] 87 | [(andmap string? args) (apply string-append args)] ; adding strings? string-append! 88 | [(andmap number? args) (apply old+ args)] ; adding numbers? add them using the old + 89 | [(andmap list? args) (apply append args)] ; adding list? append! 90 | [else (apply ~a args)]))) ; else brute-force ~a arguments :) 91 | 92 | ;; better displayln/string-append 93 | (define echo 94 | (λ args 95 | (displayln (apply ~a args)))) 96 | 97 | ;; all-but-last-element of list 98 | (define (all-but-last l) (reverse (cdr (reverse l)))) 99 | 100 | ;; predicate returns true if current lsh session is being run from inside DrRacket 101 | (define (debug-mode) (string-contains? (path->string (find-system-path 'run-file)) "DrRacket")) 102 | 103 | ;; Define a global namespace to allow input-loop eval to understand our commands 104 | (define-namespace-anchor a) 105 | (define input-loop-ns (namespace-anchor->namespace a)) 106 | 107 | ;; double-quote command parameters 108 | (define (double-quote-params command-line) 109 | (let* ((parts (string-split command-line " ")) 110 | (command (first parts)) 111 | (params (rest parts)) 112 | (quoted-params (if (= (length params) 1) 113 | (+ "\"" (first params) "\"") 114 | (+ "\"" (string-join params " ") "\"")))) 115 | (if (= (length parts) 1) (string-replace command-line "\\" "/") 116 | (string-replace (string-join (list command quoted-params) " ") "\\" "/")))) 117 | 118 | ;; Clean up an exception for display 119 | (define (clean-exception e) 120 | (string-join (cdr (string-split (~a e) " ")) " ")) 121 | 122 | ;; Main evaluation proc 123 | (define (evaluate v) 124 | (if (non-empty-string? v) 125 | (with-handlers ([exn:fail:syntax? 126 | (λ (e) (displayln (clean-exception e)))] 127 | [exn:fail? 128 | (λ (e) (displayln (clean-exception e)))]) 129 | (eval (call-with-input-string v read) input-loop-ns)) 130 | (void))) 131 | 132 | ;; generic invalid command error message 133 | (define (invalid-command command) 134 | (displayln (+ command " : unknown command or missing parameter. Type 'help' for help.\n"))) 135 | 136 | ;; check that a command is either the exact command alone or the command followed by a space 137 | (define (alone-or-got-param? command-line command) 138 | (or (string=? command-line command) 139 | (string-prefix? command-line (+ command " ")))) 140 | 141 | ;; display a nice prompt with the current directory 142 | (define (display-prompt) 143 | (display (+ (path->string (current-directory)) "> "))) 144 | 145 | ;; predicate that returns true if given command is built-in 146 | (define (built-in? command) 147 | (or (string=? command "pwd") 148 | (string=? command "edit-me") 149 | (string=? command "start-recording") 150 | (string-prefix? command "cp ") 151 | (string-prefix? command "rm ") 152 | (string-prefix? command "cd ") ; built-in commands 153 | (string-prefix? command "cd/") 154 | (string-prefix? command "cd..") 155 | (string-prefix? command "cd\\") 156 | (string-prefix? command "cat ") 157 | (string-prefix? command "run ") 158 | (string-prefix? command "url ") 159 | (string-prefix? command "show ") 160 | (string-prefix? command "edit ") 161 | (string-prefix? command "rmdir ") 162 | (string-prefix? command "touch ") 163 | (string-prefix? command "mkdir ") 164 | (alone-or-got-param? command "ls") 165 | (alone-or-got-param? command "ll") 166 | (alone-or-got-param? command "dir") 167 | (alone-or-got-param? command "set") 168 | (alone-or-got-param? command "find") 169 | (alone-or-got-param? command "help") 170 | (alone-or-got-param? command "google") 171 | (alone-or-got-param? command "save-script") 172 | (string-prefix? command "search ") 173 | (string-prefix? command "racket "))) 174 | 175 | ;; predicate returns true when command is a macro 176 | (define (macro? command) 177 | (or (alone-or-got-param? command "set") 178 | (alone-or-got-param? command "get"))) 179 | 180 | ;; multiple non-empty-string? predicate 181 | (define non-empty-strings? 182 | (λ args 183 | (andmap non-empty-string? args))) 184 | 185 | ;; local variable list 186 | (define local-vars null) 187 | 188 | ;; adds a variable to the local variable list 189 | (define (add-local-var var) 190 | (set! local-vars (cons var local-vars))) 191 | 192 | ;; predicate returns true if variable is in the local variable list 193 | (define (local-var? var) 194 | (member var local-vars)) 195 | 196 | ;; pretty prints variables set through the 'SET' command 197 | (define (display-local-vars) 198 | (if (null? local-vars) (displayln "No local variable set.") 199 | (for-each (λ (var) (displayln (+ var " = " (evaluate var)))) local-vars))) ; for each variable in the list, display varable-name = variable-value 200 | 201 | ;; get macro 202 | (define (matches-get command params) 203 | (if (and (string=? command "get") 204 | (null? params)) (display-local-vars) 205 | #f)) 206 | 207 | ;; set macro 208 | (define (matches-set command params p1 p2 p3) 209 | (cond ((and (string=? command "set") 210 | (string=? p2 "=") 211 | (non-empty-strings? p1 p3)) (add-local-var p1) ; save variable in local variable list 212 | (+ "(define " p1 " " p3 ")")) 213 | ((and (string=? command "set") 214 | (null? params)) (display-local-vars) "(void)") 215 | (else #f))) 216 | 217 | ;; syntax rules 218 | (define (matches-syntax-rules command params p1 p2 p3) 219 | (or (matches-get command params) 220 | (matches-set command params p1 p2 p3))) 221 | 222 | ;; transform syntax to match racket's 223 | (define (transform-syntax stx) 224 | (if (non-empty-string? stx) 225 | (let* ((parts (string-split stx " ")) ; split syntax parts 226 | (count (length parts)) ; get syntax part count 227 | (command (car parts)) ; first syntax part 228 | (params (cdr parts)) ; rest of syntax parts 229 | (p1 (if (> count 1) (cadr parts) "")) ; second syntax part 230 | (p2 (if (> count 2) (caddr parts) "")) ; third syntax part 231 | (p3 (if (> count 3) (cadddr parts) "")) ; fourth syntax part 232 | (others (if (> count 4) (cdddr parts) ""))) ; rest of the syntax parts 233 | (unless (matches-syntax-rules command params p1 p2 p3) 234 | (+ "(echo \"Macro transformer error: I don't understand '" (~a parts) "'. 235 | command: " (~a command) " 236 | param1: " (~a p1) " 237 | param2: " (~a p2) " 238 | param3: " (~a p3) " 239 | param-rest: " (~a others) "\")"))) 240 | "")) ; return empty string as default 241 | 242 | ;; handle built-in commands 243 | (define (handle-built-in command) 244 | (begin 245 | (define transformed-command (if (macro? command) (transform-syntax command) ; if command is a macro, transform syntax, 246 | (double-quote-params command))) ; else automatically double-quote parameters 247 | ;(echo "Transformed command: '" (~a transformed-command) "'") ; for debugging 248 | (define final-command (cond ((string=? transformed-command "") "") ; return nothing if transformed command is empty 249 | ((string-prefix? transformed-command "find") ; if this is one of the commands returning a list - like find 250 | (+ "(show (" transformed-command "))")) ; automatically use show to pretty-print list 251 | ((string-prefix? transformed-command "(") transformed-command) ; if the command is already an s-expression, return it 252 | (else (+ "(" transformed-command ")")))) ; else transform into s-expression 253 | ;(echo "About to execute: '" (~a final-command) "'") ; for debugging 254 | (if (non-empty-strings? transformed-command final-command) ; make sure transformed and final syntaxes are not empty 255 | (evaluate final-command) (invalid-command command)) ; Evaluate final command 256 | (newline))) 257 | 258 | ;; clean up entry from line-feeds and carriage returns 259 | (define (clean-up command) 260 | (string-trim (string-replace2 command "\n" "\r" "" ""))) 261 | 262 | 263 | ;; currently recording a script? 264 | (define recording-script? #f) 265 | (define current-script null) 266 | 267 | ;; adds a line to the script currently being recorded 268 | (define (record-script line) 269 | (set! current-script (cons line current-script))) 270 | 271 | ;; generic confirmation line 272 | (define (show-confirmation-line msg) 273 | (display (+ msg " ")) 274 | (let ((answer (read-line))) 275 | (if (string-prefix? answer "y") #t #f))) 276 | 277 | ;; start recording a script 278 | (define (start-recording) 279 | (set! current-script null) 280 | (set! recording-script? #t)) 281 | 282 | ;; save the current script to file and replace existing 283 | (define (save-script file) 284 | (let ((write-file (λ () (begin 285 | (with-handlers ([exn:fail? 286 | (λ (e) (displayln "Access denied writing file. Try again."))]) 287 | (display-lines-to-file (all-but-last (reverse current-script)) file #:exists 'replace #:separator #"\r")) 288 | (set! recording-script? #f))))) 289 | (if (file-exists? file) 290 | (when (show-confirmation-line "File exists. Overwrite?") 291 | (write-file)) 292 | (write-file)))) 293 | 294 | ;; Input loop 295 | (define (input-loop) 296 | (let/ec break 297 | (let loop () 298 | (display-prompt) ; display command prompt 299 | (define command (clean-up (read-line))) ; get input from user; trim and remove annoying enters and returns 300 | (when recording-script? (record-script command)) 301 | (cond [(string=? command "") (loop)] ; if nothing entered, loop 302 | [(string-prefix? command "exit") (break)] ; the only thing that breaks the loop apart from ctrl-c 303 | [(built-in? command) (handle-built-in command)] ; detect built-in commands and handle them 304 | [(local-var? command) (displayln (evaluate command))] ; if the command is recognized as a local variable, display its value 305 | [(string-prefix? command "(") (begin (evaluate command) (newline))] ; Evaluate s-expressions directly 306 | [(file-exists? command) (run# command)] ; if the file specified exists, run it 307 | [(cond ((file-exists? (+ command ".exe")) (run# (+ command ".exe"))) ; else, 308 | ((file-exists? (+ command ".com")) (run# (+ command ".com"))) ; if a similar file with an executable extension is found, 309 | ((file-exists? (+ command ".bat")) (run# (+ command ".bat"))) ; run 310 | ((file-exists? (+ command ".sh")) (run# (+ command ".sh"))))] ; it. 311 | [else (invalid-command command)]) 312 | (loop))) 313 | (displayln "Goodbye!")) 314 | 315 | ;; macros 316 | 317 | ;; a cosmetic macro -- adds then, else 318 | (define-syntax my-if ; macro name 319 | (syntax-rules (then else) ; literals it uses, if any 320 | ((my-if e1 then e2 else e3) ; pattern 321 | (if e1 e2 e3)))) ; template 322 | 323 | ;; shortcuts 324 | (define no null?) 325 | (define mkdir make-directory) 326 | (define cp copy-directory/files) 327 | (define rm delete-file) 328 | (define rmdir delete-directory) 329 | (define (show v) 330 | (for-each displayln v)) 331 | 332 | ;; double string-replace 333 | (define (string-replace2 s p1 p2 r1 r2) 334 | (string-replace (string-replace s p1 r1) p2 r2)) 335 | 336 | ;; displays current directory or changes it - supports 'cd ~' and 'cd ~/Downloads' 337 | (define cd 338 | (λ args 339 | (cond ((no args) (current-directory)) 340 | (else (let ((fa (first args))) 341 | (cond ((string? fa) (cond ((string=? fa "~") (current-directory (find-system-path 'home-dir))) 342 | ((string-prefix? fa "~/") (current-directory (+ (path->string (find-system-path 'home-dir)) (string-replace fa "~/" "")))) 343 | (else (current-directory fa)))) 344 | (else (current-directory args)))))))) 345 | 346 | (define (cd/) (cd "/")) 347 | (define (cd\\) (cd "\\")) 348 | (define (cd..) (cd "..")) 349 | 350 | ;; create an empty file 351 | (define (touch file) 352 | (display-to-file "" file)) 353 | 354 | ;; prints the current working directory path as a string 355 | (define (pwd) 356 | (displayln (path->string (current-directory)))) 357 | 358 | ;; lists the files in the current directory 359 | (define dir directory-list) 360 | 361 | ;; dir 362 | (define (ll) 363 | (display (string-replace 364 | (with-output-to-string (λ () (system (cond ((equal? (system-type 'os) 'windows) "dir") 365 | ((equal? (system-type 'os) 'unix) "ls -la") 366 | ((equal? (system-type 'os) 'macosx) "ls -la") 367 | (else "ls -la"))))) 368 | "\r" ""))) 369 | 370 | ;; unix cat equivalent 371 | (define (cat file) 372 | (if (> (file-size file) 64000) (displayln "File too big for display.") 373 | (let ([in (open-input-file file #:mode 'text)]) 374 | (displayln (read-string (file-size file) in))))) 375 | 376 | ;; prints the current working directory listing as a string 377 | (define (ls) 378 | (for-each displayln (map path->string (directory-list)))) 379 | 380 | ;; prints the current working directory listing as a string with file sizes and types 381 | (define (ll#) 382 | (let* ((paths (directory-list)) 383 | (listing (map path->string paths)) 384 | (sizes (map number->string (map file-size paths))) 385 | (files-and-sizes (map 386 | (λ (s1 s2) (+ s1 " " s2)) 387 | listing sizes))) 388 | (for-each displayln files-and-sizes))) 389 | 390 | ;; run a program from the current directory 391 | (define (run program [params ""]) 392 | (void (shell-execute #f (+ (path->string (current-directory)) program) params 393 | (current-directory) 'sw_shownormal))) 394 | 395 | ;; run a program from the path supplied and detects the absolute path 396 | (define (run# program [params ""]) 397 | (void (shell-execute #f (if (or (string-contains? program "/") 398 | (string-contains? program "\\")) program (+ (path->string (current-directory)) program)) 399 | params 400 | (current-directory) 'sw_shownormal))) 401 | 402 | ;; edit a file using DrRacket 403 | (define (racket file) 404 | (void (shell-execute "open" file "" 405 | (current-directory) 'sw_shownormal))) 406 | 407 | ;; edit the present lsh source file using DrRacket 408 | (define (edit-me) 409 | (void (shell-execute "open" (+ (current-directory-for-user) "lsh.rkt") "" 410 | (current-directory-for-user) 'sw_shownormal))) 411 | 412 | ;; edit a file using notepad 413 | (define (edit file) 414 | (void (shell-execute "open" "notepad" file 415 | (current-directory) 'sw_shownormal))) 416 | 417 | ;; open an URL 418 | (define (url url) 419 | (void (shell-execute #f (+ "http://" url) "" 420 | (current-directory) 'sw_shownormal))) 421 | 422 | ;; google something 423 | (define (google something) 424 | (void (shell-execute #f (+ "https://www.google.com/search?q=" (string-replace something " " "+")) "" 425 | (current-directory) 'sw_shownormal))) 426 | 427 | ;; google I'm feeling lucky 428 | (define (search something) 429 | (void (shell-execute #f (+ "https://www.google.com/search?q=" (string-replace something " " "+") "&btnI") "" 430 | (current-directory) 'sw_shownormal))) 431 | 432 | ;; better find-files 433 | (define (any file) #t) 434 | (define (all-but-first-two s) (list->string (cddr (string->list s)))) 435 | (define (all-but-last-two s) (list->string (reverse (cddr (reverse (string->list s)))))) 436 | (define (all-but-last-three s) (list->string (reverse (cdddr (reverse (string->list s)))))) 437 | (define begins-with? string-prefix?) 438 | (define ends-with? string-suffix?) 439 | 440 | (define find 441 | (λ args 442 | (cond ((no args) (find-files any)) 443 | (else (let ((fa (first args))) 444 | (cond ((string? fa) (cond ((begins-with? fa "*.") (find-files (λ (path) (ends-with? (path->string path) (+ "." (all-but-first-two fa)))))) 445 | ((ends-with? fa "*.*") (find-files (λ (path) (begins-with? (path->string path) (all-but-last-three fa))))) 446 | ((ends-with? fa ".*") (find-files (λ (path) (begins-with? (path->string path) (+ (all-but-last-two fa) "."))))) 447 | (else (find-files (λ (s) (string=? s fa)))))) 448 | (else (find-files args)))))))) 449 | 450 | ;;; main 451 | (about) 452 | (newline) 453 | ; (when (not (debug-mode)) (input-loop)) ; for debugging only 454 | (input-loop) 455 | 456 | 457 | 458 | --------------------------------------------------------------------------------