.sbclrc

;;; The following lines added by ql:add-to-init-file:
#-quicklisp
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
                                       (user-homedir-pathname))))
  (when (probe-file quicklisp-init)
    (load quicklisp-init)))

(defun quickload-silent (&rest args)
  (with-output-to-string (*standard-output* nil)
    (apply #'ql:quickload args)))
(defun dep-load (&rest pkgs)
  (dolist (pkg pkgs)
    (quickload-silent pkg)))

(dep-load
 :cl-ppcre
 :cl-interpol
 :cl-fad
 :osicat
 :iterate
 "jsown"
 "alexandria"
 :lquery
 )

(named-readtables:in-readtable :interpol-syntax)
;;;
(setf sb-impl::*default-external-format* :utf-8)
;;;
(defmacro comment (&rest ignored)
  nil)
;;;
(defmacro alias-fn (to fn)
  `(setf (fdefinition ',to) #',fn))

(defmacro alias-macro (to macro)
  "Aliases macros. Note that redefining the original will not update the alias, and you need to redefine the alias as well."
  `(setf (macro-function ',to) (macro-function ',macro)))

(alias-macro when-let alexandria:when-let)
;;;
(defun empty-str-to-nil (str)
  ;; @duplicateCode/02a88ee7dd8a3c6ecfcdf7f1fc2f3827
  (when (and str (not (string= str "")))
    str))
;;;
(defun concat (&rest strings)
  "@example (concat \"hi \" \"hmm \" \"()\")"
  (apply #'concatenate 'string strings))

(alias-fn emptyp SB-SEQUENCE:EMPTYP)

(defun ec (&rest things)
  (cond
    ((emptyp things) (format t "~%"))
    (t (loop for thing in things do
      (format t "~a~%" thing)))))
(comment
 (ec)
 (ec "Hello" "Jungle" '(1 2 3) "hoo!"))
;;;
(eval-when (:compile-toplevel :execute :load-toplevel)
  (defparameter *repl-mode* nil)
  (comment
   (setq *repl-mode* t)))
;;;
(alias-fn argv-get uiop:command-line-arguments) ;; get CLI arguments
(alias-fn getenv uiop:getenv)
(alias-fn getenvp uiop:getenvp)
;;;
;; this hack did not work:
;; (defun json-parse (&rest args)
;;   (quickload-silent "jsown")
;;   (apply #'jsown:parse)
;;   )
(alias-fn json-parse jsown:parse)

;; (defun json-get (&rest args)
;;   (quickload-silent "jsown")
;;   (apply #'jsown:val-safe)
;;   )
(alias-fn json-get jsown:val-safe)
;;;
(defstruct cmd-result
  out
  outrs
  err
  retcode
  prc)

(defun brishz-ll (&key (session "") (input nil) (executable "/usr/local/bin/brishzq.zsh") (failure_expected "") args)
  "brishz low-level API."
  (let* (
         (out (make-array '(0) :element-type 'extended-char ;; 'character
                               :fill-pointer 0 :adjustable t))
         (err (make-array '(0) :element-type 'extended-char
                               :fill-pointer 0 :adjustable t))
         (input (cond
                  ((stringp input)
                   ;; @placeholder convert input to a stream
                   (make-string-input-stream input))
                  (t input)))
         (res
           (with-output-to-string (out-stream out)
             (with-output-to-string (err-stream err)
               (run-program executable args
                            :output out-stream :error err-stream
                            :input input
                            :environment (list
                                          (format nil "brishz_session=~a" session)
                                          (format nil "brishz_failure_expected=~a" failure_expected)
                                          (format nil "brishz_in=~a"
                                                  (if input
                                                      "MAGIC_READ_STDIN"
                                                      ""))))))))
    (make-cmd-result :out out
                     ;; @todo1 make this a method of cmd-result, not a cached property
                     :outrs (string-right-trim
                             '(#\Newline)
                             ;; '(#\Space #\Tab #\Newline)
                             out) :err err :retcode (process-exit-code res) :prc res)))

(defun brishz (&rest args)
  (brishz-ll :args args))

(defun brishz-outrs (&rest args)
  (cmd-result-outrs (apply #'brishz args)))

(defun brishz-bool (&rest args)
  (= 0 (cmd-result-retcode (brishz-ll :args args :failure_expected "y"))))

(defun brishz-fast (&rest args)
  (brishz-ll :args args :executable "/usr/local/bin/brishz.dash"))

(comment
 (with-input-from-string (i (format nil "1. bat~%2.fruit~%3. end"))
   (brishz-ll :args '("eval" "ec hi ; cat >&2") :session "emacs" :input i))

 (brishz-ll :args '("eval" "ec '{}hi[]' ; cat >&2") :session "emacs" :input "wow “The wizards?”")

 (brishz "eval" "ec hi ; ecerr warning ; return 56"))

(defun boolsh (str)
  (and
   str
   (not
    (or
     (equalp str "")
     (equalp str "n")
     (equalp str "no")
     (equalp str "0")))))

(defun boolsh-env (env_var &optional default)
  "This treats empty strings as not given. Use `getenvp' otherwise."

  (or
   (boolsh
    (or
     (empty-str-to-nil
      (getenv env_var))
     default))))

(defun boolsh-env-y (env_var)
  (boolsh-env env_var T))

(comment
 (boolsh "no")
 (boolsh-env "nonexistent_7191")
 (boolsh-env-y "nonexistent_7191")
 (boolsh-env-y "NODEJS_CHECK_SIGNATURES"))
;;;
;; (describe #\LEFT_DOUBLE_QUOTATION_MARK)
;;;
(defun mbp-p ()
  (brishz-bool "isMBP"))

(defun server-p ()
  (brishz-bool "isServer"))
;;;
(defun listify-if-not (possible-lst)
  (cond
    ((listp possible-lst) possible-lst)
    (t (list possible-lst))))
(comment
  (listify-if-not 89)
  (listify-if-not (list 1 2)))
;;;
(defun pandoc-normalize-whitespace (str)
  ;; @duplicateCode/ed0e38095407ff82d0f12a431c3c10a2
  (substitute #\Space #\NO-BREAK_SPACE str))

(defun pandoc-org-trim-extra (str)
  ;; @duplicateCode/4674af46b8f4fbbf90274bc262198216
  ;; \h not supported here
  (string-trim
   (list #\Space #\Newline)
   (ppcre::regex-replace-all
    ;; #?/(?:\n|\A)\h*(?:(?::PROPERTIES:(?:.|\n)*?:END:)|(?:<<.*?>>))\h*/
    "(?:\\n|\\A)\\s*(?:(?::PROPERTIES:(?:.|\\n)*?:END:)|(?:<<.*?>>))"

    str "")))

(defun org-trim-forced-newlines (str)
  ;; @duplicateCode/1102efd8dd0367b8dc12d7e3678dca59
  (ppcre:regex-replace-all "\\\\" str ""))
;;;
(defun html2org (html)
  (cmd-result-outrs (brishz-ll :args '("html2org" "/dev/stdin") :input html)))

(defun org-quote-write (&key content (out_stream *standard-output*))
  (when content
    (format out_stream
            "#+BEGIN_QUOTE~%~a~%#+END_QUOTE~%"
            content)))

(defun org-example-write (&key (headers nil) content (out_stream *standard-output*))
  (let* ((headers (empty-str-to-nil headers)))
    (when content
      (format out_stream
              "#+BEGIN_EXAMPLE~a~%~a~%#+END_EXAMPLE~%"
              (cond
                (headers
                 (concat " " headers))
                (t ""))
              content))))

(defun org-properties-write (&key
                               (keys)
                               (accessor)
                               (out_stream *standard-output*)
                               (folded_p t))
  (format out_stream ":PROPERTIES:~%")
  (dolist (p keys)
    (let ((vals (listify-if-not (funcall accessor p)))
          (plus_char ""))
      (loop for val in vals
            while (and val (not (equalp val "")))
            do
               (progn
                 (format out_stream "~a"
                         (concatenate 'string
                                      ":" p plus_char ": "
                                      val ;; @assumes val contains no newlines
                                      (string #\newline)))
                 (setq plus_char "+")))))
  (when folded_p
    (format out_stream ":visibility: folded~%"))
  (format out_stream ":END:~%"))

(defun org-link-create (url &optional title)
  (cond
    (title
     (concatenate 'string
                  "[[" url "]["
                  (org-title-escape title)
                  "]]"))
    (t
     (concatenate 'string
                  "[[" url "]]"))))

(defun org-link-write (&key url (title nil) (out_stream *standard-output*))
  (format out_stream "~a" (org-link-create url title)))

(comment
  (defun org-title-escape (str)
    (substitute #\} #\]
                (substitute #\{ #\[ str)))

  (defun org-title-escape (str)
    (cmd-result-outrs
     (brishz-ll :args '("str2orgtitle")
                :input str))
    ))

(defun org-title-escape (str)
  (ppcre:regex-replace-all "\\\\*\\]"
                           (ppcre:regex-replace-all "\\\\*\\[" str "{")
                           "}"))

(defun org-link-escape (str)
  (ppcre:regex-replace-all "(?<!\\\\)\\]" ;; negative lookbehind
                           (ppcre:regex-replace-all "(?<!\\\\)\\[" str "\\[")
                           "\\]"))

(comment
 (org-title-escape "Hi! [981][]")
 (org-link-escape "Hi! [981][]"))
;;;
(defun symlinkp (some-pathname)
  ;; @SBCLOnly
  ;; osicat:file-kind does not work when the path contains a trailing slash :|
  (ignore-errors
   (sb-posix:s-islnk (sb-posix:stat-mode (sb-posix:lstat (pathname some-pathname))))))
;;;
(eval-when (:compile-toplevel :execute :load-toplevel)
  (defun zip-lists (&rest alist-of-lists)
    ;; if the number of lists is less than call-arguments-limit (minimum = 50)
    (apply #'mapcar #'list alist-of-lists)
    ;; (let ((lol '((1 2 3)
    ;;              (a b c)
    ;;              ("a" "b" "c"))))
    ;;   (loop :with result := '()
    ;;         :while (some (function identity) lol)
    ;;         :do (let ((elements (mapcar (function first) lol)))
    ;;               (push elements result)
    ;;               (setf lol (mapcar (function rest) lol)))
    ;;         :finally (return result)))
    ;; --> ((3 c "c") (2 b "b") (1 a "a"))
    ;; you can replace some by every if you want to stop on the shortest list, instead of the longuest.  mapcar and the other map functions in CL stop on the shortest.

    ))
(comment
 (zip-lists '(1 2 3) '(a b c) '(9 8 7)))
;;;
(defun arger (dest &rest args)
  (apply #'concat (loop for arg in args collect (format dest "arg: ~s~%" arg))))
(comment
 (arger nil 1 2 3))
;;;
(defmacro run-on-each-macro (m &rest args)
  `(progn ,@(loop for arg in
                  args collect `(,m ,arg))))
(alias-macro re-m run-on-each-macro)
(comment
 (run-on-each-macro princ 1 5 4)
 (let ((lst (list 1 2 3 "hi")))
   (eval `(run-on-each-macro prin1 ,@lst))

   ;; (mapcar (lambda (x) (run-on-each-macro prin1 x)) lst)
   )
 )
(comment
 (defmacro tmp-print-me (atom)
   `(prin1 ,atom))
 (tmp-print-me "hi")

 (let ((lst (list 1 2 3 "hi")))
   (mapcar (lambda (x) (tmp-print-me x)) lst)
   ;; (mapcar 'tmp-print-me lst)
   )
 )

(defmacro run-on-each-macro-zip ((&rest cmd) &rest arg-lists)
  "Zips the arg-lists together and applies `cmd' on this list.
`_' can be used in the `cmd' to mark the place where args should be inserted."
  `(progn ,@(loop for args in
                           (apply #'zip-lists arg-lists)
                           ;; arg-lists
                  collect
                  (let* ((absent-placeholder t)
                         (cmd-complete
                           (apply #'append
                                  (mapcar
                                   (lambda (a)
                                     (cond
                                       ((equalp a '_)
                                        (progn
                                          (setq absent-placeholder nil)
                                          args))
                                       (t (list a))))
                                   cmd)))
                         (cmd-complete
                           (cond
                             (absent-placeholder (append cmd-complete args))
                             (t cmd-complete))))
                    `(,@cmd-complete)))))
(alias-macro re-mz run-on-each-macro-zip)
(comment
 (append (list 1 2)
         (list 3 4))
 (re-mz (arger t) (1 2 3) (0 2 0) ("a" "b" "c"))
 (re-mz (arger t "start" _ "end") (1 2 3) (0 2 0) ("a" "b" "c"))
 )
;;;
(defmacro var-to-int (var &optional (default 0))
  `(progn
     ;; (format t "macro begin: ~s~%" ,var)
     (setq ,var (or (ignore-errors (parse-integer ,var)) ,default))
     ;; (format t "macro end: ~d~%" ,var)
     ))
(comment
 (let ((a "1")
       (b "2")
       (c nil))
   (re-m var-to-int a b c)
   (prin1 (list a b c))
   (re-mz (var-to-int _ nil) (a b c))
   (prin1 (list a b c))))
;;;
(defmacro labeled (&body body)
  (let* ((body-str (format nil "~s" body)))
    `(progn
       (let* ((val (progn ,body))
             (val-str (format nil "~s" val))
             (val-str
               (with-input-from-string (s val-str)
                 (apply #'concat
                        (loop for line = (read-line s nil)
                              while line collect
                                         (format nil "~t~s~%" line))))))
         (format t "~a~t=>~%~t~s" ,body-str val)
         val))))
(comment
 (labeled * 8 7)
 (labeled concat "Hi " "Li" (format nil "~%In the Jungle, ...")))
;;;
(defmacro letd (bindings &body body)
  "@warn it seems that we can't set the value of a special variable created by `defparameter' globally, so use (unintern 'var_name_here) to remove the variable first."
  `(let* ,bindings
     ,@(when *repl-mode*
         (loop :for b :in bindings
               :for symbol = (if (consp b)
                                 (first b)
                                 b)
               :for name = (symbol-name symbol)

               ;; the symbol-value of a symbol is global
               :collect `(setf (symbol-value ',(intern name)
                                             ;; you can use (concat "some_prefix" name) if reusing the original names is causing problems
                                             ) ,symbol)))
     ,@body))

(comment
 (letd ((a12 "3")
        (b6 (concat a12 "|>")))
   (concat b6)))
;;;
(alias-fn s-starts-with-p uiop:string-prefix-p)
;;;
(alias-fn nil-p null)
;;;
(defun lispexec-compression-get ()
  (let ((argv (argv-get)))
    (when (>= (length argv) 1)
      (parse-integer (elt argv 0))))
  ;; For "html_links_textualize.lispexe":
  ;; using `:executable nil` did not change the size at all
  ;; compression level 0: no noticeable compression (44MB)
  ;; compression level 1-3: 13MB
  ;; compression level 4: 12MB
  ;; compression level 9: 12MB
  ;; overall, the faster compilation and startup of the lower levels is worth it
  )

(defun lispexe-save-and-die (&key
                               name (toplevel nil)
                               (compression (lispexec-compression-get)))
  (cond
    (toplevel
     (sb-ext:save-lisp-and-die name :toplevel toplevel :executable t :compression compression))
    (t
     (sb-ext:save-lisp-and-die name :executable t :compression compression))))
;;;
(defun path-unabbrev (path)
    (brishz-outrs "path-unabbrev" path))

(comment
  (path-unabbrev "~cod/python/ddg2json"))
;;;
(defun month-number-to-name (number)
  (brishz-outrs "month-number-to-name"
                (princ-to-string number)))

(comment
 (month-number-to-name 6)
 (princ-to-string 6)
 (princ-to-string "6")
 (month-number-to-name "6"))
;;;
(defun rget (regex text)
  (let ((res (nth-value 1
                        (ppcre:scan-to-strings regex text))))
    (when res
      (elt
       res
       0))))

(comment
 (rget "(\\d{4})" "30 April 2014")
 (rget "(\\d{4})" "30 April 201"))
;;;
(defun s-truncate (len s &optional ellipsis)
  "If S is longer than LEN, cut it down and add ELLIPSIS to the end.

The resulting string, including ellipsis, will be LEN characters
long.

When not specified, ELLIPSIS defaults to ‘...’.

Ported from s.el's [help:s-truncate]."
  ;; (declare (pure t) (side-effect-free t))
  (unless ellipsis
    (setq ellipsis "..."))
  (if (> (length s) len)
      (concat (subseq s 0 (- len (length ellipsis))) ellipsis)
      s))

(comment
 (s-truncate 6 "A123456789")
 (s-truncate 699 "A123456789"))
;;;