3e8af1c65b8c

More
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Thu, 10 Jan 2019 20:16:53 -0500
parents 7bcae6fc1b59
children c3b026046776
branches/tags (none)
files lisp/build-binary lisp/build-manual lisp/clhs.lisp lisp/example.lisp lisp/genpass.lisp lisp/lispindent.lisp lisp/search.lisp restic/excludes.txt stumpwmrc vim/custom-dictionary.utf-8.add vim/vimrc

Changes

--- a/lisp/build-binary	Wed Jan 02 14:02:48 2019 -0500
+++ b/lisp/build-binary	Thu Jan 10 20:16:53 2019 -0500
@@ -6,4 +6,4 @@
 BINARY=$(basename "$1" .lisp)
 shift
 
-sbcl --load "$LISP" --eval "(sb-ext:save-lisp-and-die \"$BINARY\" :executable t :save-runtime-options t :toplevel 'toplevel)" "$@"
+sbcl --load "$LISP" --eval "(sb-ext:save-lisp-and-die \"$BINARY\" :executable t :save-runtime-options t :toplevel '$BINARY:toplevel)" "$@"
--- a/lisp/build-manual	Wed Jan 02 14:02:48 2019 -0500
+++ b/lisp/build-manual	Thu Jan 10 20:16:53 2019 -0500
@@ -7,4 +7,4 @@
 OUT="$NAME.1"
 shift
 
-sbcl --disable-debugger --load "$LISP" --eval "(with-open-file (f \"$OUT\" :direction :output :if-exists :supersede) (adopt:print-manual *ui* :stream f))" --quit "$@"
+sbcl --disable-debugger --load "$LISP" --eval "(with-open-file (f \"$OUT\" :direction :output :if-exists :supersede) (adopt:print-manual $NAME:*ui* :stream f))" --quit "$@"
--- a/lisp/clhs.lisp	Wed Jan 02 14:02:48 2019 -0500
+++ b/lisp/clhs.lisp	Thu Jan 10 20:16:53 2019 -0500
@@ -4,6 +4,12 @@
   (ql:quickload '(:adopt :drakma :plump :clss :alexandria)
                 :silent t))
 
+(defpackage :clhs
+  (:use :cl)
+  (:export :toplevel :*ui*))
+
+(in-package :clhs)
+
 
 ;;;; Config -------------------------------------------------------------------
 (defparameter *default-hyperspec-url* "http://www.lispworks.com/documentation/HyperSpec/")
--- a/lisp/example.lisp	Wed Jan 02 14:02:48 2019 -0500
+++ b/lisp/example.lisp	Thu Jan 10 20:16:53 2019 -0500
@@ -1,6 +1,12 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload '(:adopt) :silent t))
 
+(defpackage :example
+  (:use :cl)
+  (:export :toplevel :*ui*))
+
+(in-package :example)
+
 ;;;; Config -------------------------------------------------------------------
 (defparameter *default-name* "World")
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/genpass.lisp	Thu Jan 10 20:16:53 2019 -0500
@@ -0,0 +1,128 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload '(:adopt :series :iterate) :silent t))
+
+(defpackage :genpass
+  (:use :cl :iterate)
+  (:export :toplevel :*ui*))
+
+(in-package :genpass)
+
+
+(defun safep (char)
+  (or (char<= #\a char #\z)
+      (char<= #\A char #\Z)
+      (char<= #\0 char #\9)))
+
+(defun word-list ()
+  (iterate
+    (for line :in-file "/usr/share/dict/words" :using #'read-line)
+    (when (every #'safep line)
+      (collect line :result-type vector))))
+
+(defun random-unsigned-byte-32 ()
+  (with-open-file (urandom "/dev/urandom" :element-type '(unsigned-byte 8))
+    (logior (ash (read-byte urandom) 0)
+            (ash (read-byte urandom) 8)
+            (ash (read-byte urandom) 16)
+            (ash (read-byte urandom) 24))))
+
+(defun urandom (limit)
+  (check-type limit (integer 0 (#.(expt 2 32))))
+  (iterate
+    (with threshold = (mod (expt 2 32) limit))
+    (for candidate = (random-unsigned-byte-32))
+    (finding (mod candidate limit) :such-that (>= candidate threshold))))
+
+(defun random-elt (sequence)
+  (elt sequence (urandom (length sequence))))
+
+(defun random-words (n)
+  (iterate
+    (with words = (word-list))
+    (repeat n)
+    (collect (random-elt words))))
+
+(defun random-sentence% (words)
+  (format nil "~{~:(~A~)~^ ~}" (random-words words)))
+
+(defun random-sentence (words length)
+  (iterate
+    (for candidate = (random-sentence% words))
+    (finding candidate :such-that (<= (length candidate) length))))
+
+(defmacro -<> (value &body forms)
+  (reduce (lambda (val expression)
+            (subst val '<> expression))
+          forms
+          :initial-value value))
+
+(defun random-garbage (length)
+  (with-open-file (urandom "/dev/urandom" :element-type '(unsigned-byte 8))
+    (-<> urandom
+      (series:scan-stream <> #'read-byte)
+      (series:map-fn t #'code-char <>)
+      (series:choose-if #'safep <>)
+      (series:subseries <> 0 length)
+      (series:collect 'string <>))))
+
+
+;;;; User Interface -----------------------------------------------------------
+(defun run (length words)
+  (write-string
+    (if (zerop words)
+      (random-garbage length)
+      (random-sentence words length))))
+
+
+;;;; User Interface -----------------------------------------------------------
+(adopt:define-string *documentation*
+  "Generate a random password.")
+
+(defparameter *examples*
+  '(("Generate a random 24-character password:" .
+     "genpass --length 24")))
+
+(adopt:define-interface *ui*
+    (:name "genpass"
+     :usage "[OPTIONS]"
+     :summary "Generate a random password."
+     :documentation *documentation*
+     :examples *examples*)
+  ((help)
+   :documentation "display help and exit"
+   :manual "Display help and exit."
+   :long "help"
+   :short #\h
+   :reduce (constantly t))
+  ((length)
+   :documentation "ensure password is no longer than N characters (default 32)"
+   :long "length"
+   :short #\l
+   :parameter "N"
+   :initial-value 32
+   :reduce #'adopt:newest
+   :key #'parse-integer)
+  ((words)
+   :documentation "if non-zero, generate passphrases of N words instead of opaque strings (default 4)"
+   :long "words"
+   :short #\w
+   :parameter "N"
+   :initial-value 4
+   :reduce #'adopt:newest
+   :key #'parse-integer)
+  ((no-words words)
+   :documentation "shorthand for --words=0"
+   :long "no-words"
+   :short #\W
+   :reduce (constantly 0)))
+
+(defun toplevel ()
+  (handler-case
+      (multiple-value-bind (arguments options) (adopt:parse-options *ui*)
+        (when (gethash 'help options)
+          (adopt:print-usage-and-exit *ui*))
+        (when arguments
+          (error "Unrecognized command line arguments: ~S" arguments))
+        (run (gethash 'length options)
+             (gethash 'words options)))
+    (error (c) (adopt:print-error-and-exit c))))
--- a/lisp/lispindent.lisp	Wed Jan 02 14:02:48 2019 -0500
+++ b/lisp/lispindent.lisp	Thu Jan 10 20:16:53 2019 -0500
@@ -4,6 +4,12 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload '(:adopt) :silent t))
 
+(defpackage :lispindent
+  (:use :cl)
+  (:export :toplevel :*ui*))
+
+(in-package :lispindent)
+
 
 ;Dorai Sitaram
 ;Oct 8, 1999
--- a/lisp/search.lisp	Wed Jan 02 14:02:48 2019 -0500
+++ b/lisp/search.lisp	Thu Jan 10 20:16:53 2019 -0500
@@ -1,6 +1,11 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload '(:adopt :cl-ppcre) :silent t))
 
+(defpackage :search
+  (:use :cl)
+  (:export :toplevel :*ui*))
+
+(in-package :search)
 
 ;;;; Functionality ------------------------------------------------------------
 (defun make-scanner (pattern &key literal)
--- a/restic/excludes.txt	Wed Jan 02 14:02:48 2019 -0500
+++ b/restic/excludes.txt	Thu Jan 10 20:16:53 2019 -0500
@@ -1,7 +1,5 @@
 .cache
 cache2
-.hg
-.git
 /home/sjl/.dbus
 /home/sjl/src/dotfiles/vim/tmp
 /home/sjl/snap
--- a/stumpwmrc	Wed Jan 02 14:02:48 2019 -0500
+++ b/stumpwmrc	Thu Jan 10 20:16:53 2019 -0500
@@ -14,6 +14,7 @@
       *input-window-gravity* :center
       *debug-level* 0
       *resize-increment* 75
+      *new-frame-action* :empty
       *window-format* "(%n%m%20t)"
       *window-name-source* :title
       *shell-program* "/bin/bash")
--- a/vim/custom-dictionary.utf-8.add	Wed Jan 02 14:02:48 2019 -0500
+++ b/vim/custom-dictionary.utf-8.add	Thu Jan 10 20:16:53 2019 -0500
@@ -271,3 +271,4 @@
 deserializes
 healthchecks
 CACL
+shaders
--- a/vim/vimrc	Wed Jan 02 14:02:48 2019 -0500
+++ b/vim/vimrc	Thu Jan 10 20:16:53 2019 -0500
@@ -2651,6 +2651,10 @@
     " Keys for the Inspector
     au FileType vlime_inspector nnoremap <buffer> <2-LeftMouse> :call vlime#ui#inspector#InspectorSelect()<cr>
 
+    " Keys for the Preview
+    au FileType vlime_preview nnoremap <buffer> <localleader>p :call vlime#plugin#SetPackage()<cr>
+    au FileType vlime_preview nnoremap <buffer> <localleader>m1 :call vlime#plugin#ExpandMacro(vlime#ui#CurExpr(), "one")<cr>
+
     " Universal keys, for all kinds of Vlime windows
     au FileType lisp,vlime_repl,vlime_inspector,vlime_sldb,vlime_notes,vlime_xref,vlime_preview call MapVlimeKeys()