phoe

;;; (ql:quickload :qtools)

(defmacro with-qimage-from-vector ((image-var vector width height) &body body)
  "Establishes a lexical environment, in which IMAGE-VAR is bound to a QImage
created from the ARGB contents of VECTOR, with width WIDTH and height HEIGHT."
  (with-gensyms (length v)
    `(let* ((,length (array-dimension ,vector 0))
            (,v (make-static-vector ,length :initial-contents vector)))
       (unwind-protect
            (with-finalizing

phoe

;;;; CL-FOX5 2017 © Michał "phoe" Herda
;;;; MIT license

;; (ql:quickload :fast-io)
;; (ql:quickload :cl-lzma)
;; (ql:quickload :alexandria)

;;; UTILS

(defun make-byte-array (n &rest options)

phoe

contrib/swank-arglists.lisp:1136:(defslimefun autodoc (raw-form &key print-right-margin)
contrib/swank-arglists.lisp:1185:(defslimefun complete-form (raw-form)
contrib/swank-arglists.lisp:1201:(defslimefun completions-for-keyword (keyword-string raw-form)
contrib/swank-asdf.lisp:335:(defslimefun who-depends-on (system)
contrib/swank-asdf.lisp:362:(defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
contrib/swank-asdf.lisp:385:(defslimefun list-all-systems-in-central-registry ()
contrib/swank-asdf.lisp:408:(defslimefun list-all-systems-known-to-asdf ()
contrib/swank-asdf.lisp:413:(defslimefun list-asdf-systems ()
contrib/swank-asdf.lisp:438:(defslimefun asdf-system-files (name)
contrib/swank-asdf.lisp:451:(defslimefun asdf-system-loaded-p (name)

phoe

(defun char-check ()
  "Print all codes for which (code-char a) returns nil and return their number.
  
If this returns nonzero, there is a hole in the code-chars,
so be careful.
If this returns 0, the implementation is effectively
NIL-proof in this case.
NIL-bearing so far:
CCL 1.11-r16635 on Win32, beginning at 55295. 2048 codes (D800-DFFF) under 1114112 have a (code-char code) -> nil.
NIL-proof so far:

phoe

00003b(:emacs-rex (swank:connection-info) "GATEWAY/INSTALL" t 1)
000A5A(:return (:ok (:pid 15237 :style :spawn :encoding (:coding-systems ("utf-8-unix" "iso-latin-1-unix")) :lisp-implementation (:type "SBCL" :name "sbcl" :version "1.3.14.debian" :program nil) :machine (:instance "origin" :type "X86-64" :version "Quad-Core AMD Opteron(tm) Processor 2374 HE") :features (:lparallel :lparallel.with-cltl2 :lparallel.with-cas :lparallel.with-stealing-scheduler cl-postgres.features:sbcl-ipv6-available cl-postgres.features:sbcl-available :flexi-streams :cl-ppcre :cl-who :esrap.can-handle-left-recursion :esrap.multiple-transforms :esrap.function-terminals :esrap.expression-start-terminals :esrap.lookbehind :esrap.lookahead :custom-hash-table-native :global-vars :split-sequence :declare-types :named-readtables :closer-mop :postmodern-use-mop :postmodern-thread-safe cffi-features:flat-namespace cffi-features:x86-64 cffi-features:unix :cffi cffi-sys::flat-namespace :fast-io-sv :fast-io :sbcl-uses-sb-rotate-byte :cl-fad :

phoe

(defun trim-number-to-string (n)
  (let* ((string (format "%3d" n))
         (length (length string))
         (substring (substring string (- length 3) length)))
    (format " %s" (propertize substring 'face 'linum))))

(setf linum-format 'trim-number-to-string)

phoe

(defun pprint-plist (*standard-output* list)
  "Pretty-prints a plist with newlines after each key-value pair.
This will break if not called at toplevel, but works well enough for my use case."
  (pprint-logical-block (*standard-output* list :prefix "(" :suffix ")")
    (loop for cell on list by #'cddr
          do (write (first cell))
             (write-char #\Space)
             (write (second cell))
             (when (cddr cell)
               (terpri *standard-output*)

phoe

;; unfinished - I'll think of finishing this some other time mayhaps

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; BKNR.MULTISTORE
;;;; © Michał "phoe" Herda 2017
;;;; bknr.multistore.lisp

(defpackage #:bknr.multistore
  (:shadowing-import-from #:closer-mop
                          #:standard-generic-function #:defmethod #:defgeneric

phoe

;; thanks, beach!

(defun split-list-if (predicate list)
  "Destructively splits the provided list into two lists: one contains the
elements of the original list that satisfy the predicate, the other contains
elements that do not satisfy the predicate. The order of the original elements
is preserved."
  (loop with result1 = '()
        with result2 = '()
        with rest = list

phoe

(let* ((list (list 1 2 3 4 5 6 7 8 9 0))
       (first list)
       (second (cdr list)))
  (do ((left list (cdr left))
       (right (cdr list) (cdr right)))
      ((and (null (cdr left))
            (null (cdr right))))
    (setf (cdr left) (cddr left)
          (cdr right) (cddr right)))
  (values first second))