;; --*- Mode: Lisp -*--

;;; 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)
      )
    nil)

#.(progn
    (ql:quickload :cffi)
    (ql:quickload :cffi-toolchain)
    nil)

#.(progn
    (push (format nil
                  "-I~a"
                  (namestring
                   (merge-pathnames (make-pathname
                                     :directory '(:relative
                                                  ".nix-profile"
                                                  "include"))
                                    (user-homedir-pathname))))
          cffi-toolchain:*cc-flags*)
    nil)

(push (merge-pathnames (make-pathname :directory '(:relative ".nix-profile" "lib"))
                       (user-homedir-pathname))
      cffi:*foreign-library-directories*)

#.(progn
    (require :sb-aclrepl)
    (when (and (interactive-stream-p *terminal-io*)
               (find-package 'sb-aclrepl))
      (push :aclrepl cl:*features*))
    (asdf:load-asd (truename "~/.sbcl.asd"))
    (ql:quickload :fwoar-sbcl)
    nil)

    #.(uiop:define-package :fwoar-user
          (:export :*term-size*)
        #.(append '(:mix :cl)
                  (mapcar #'package-name (package-use-list :cl-user))
                  '(:alexandria :serapeum :fw.lu)))

    (in-package :fwoar-user)

    (in-package :cl-user)

    (set-dispatch-macro-character #\# #\!
                                  (lambda (stream c n)
                                    (declare (ignore c n))
                                    (read-line stream)
                                    `(eval-when (:compile-toplevel :load-toplevel :execute)
                                       (pushnew :noscript *features*))))

    (eval-when (:compile-toplevel :load-toplevel :execute)
      (cffi:defcstruct winsize
          (ws_row :unsigned-short)
        (ws_col :unsigned-short)
        (ws_xpixel :unsigned-short)
        (ws_ypixel :unsigned-short))

      (defun get-term-size ()
        (flet ((ioctl-gwinsz (fd)
                 (cffi:with-foreign-object (ptr '(:pointer (:struct winsize)))
                   (let* ((res (osicat-posix:ioctl fd osicat-posix:tiocgwinsz ptr)))
                     (if (= res 0)
                         (cffi:with-foreign-slots ((ws_row ws_col) ptr (:struct winsize))
                           (list ws_row ws_col))
                         (format t "~&error~%"))))))
          (loop for x from 0 to 2
                for res = (handler-case (ioctl-gwinsz x)
                            (osicat-posix:enotty (c) c))
                finally (return res)))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (when (member "--linedit" sb-ext:*posix-argv* :test 'equal)
    (when (interactive-stream-p *terminal-io*)
      (trace sb-unix:unix-isatty)
      (when (= 1 (sb-unix:unix-isatty 0))
        #-(and darwin arm64)
        (destructuring-bind (height width) (get-term-size)
          (defparameter fwoar-user::*term-size* (list height width))
          (setf sb-ext:*posix-argv* (remove "--no-linedit" sb-ext:*posix-argv* :test 'equal)
                *print-right-margin* (- width 10))))
      (require :sb-aclrepl)
      (require :sb-introspect)

      (require :linedit)
      (funcall (intern "INSTALL-REPL" :linedit) :wrap-current t))))

#+aclrepl
(progn
  #-(and darwin arm64)
  (destructuring-bind (height width) (get-term-size)
    (declare (ignore height))
    (setf *print-right-margin* width))

  (setq sb-aclrepl:*max-history* 100)
  (sb-aclrepl:make-repl-fun)
  (setf (sb-aclrepl:alias "asdc")
        #'(lambda (sys) (asdf:operate 'asdf:compile-op sys)))
  (sb-aclrepl:alias "l" (sys) (asdf:operate 'asdf:load-op sys))
  (sb-aclrepl:alias "t" (sys) (asdf:operate 'asdf:test-op sys))
  ;; The 1 below means that two characaters ("up") are required
  (sb-aclrepl:alias ("up" 1 "Use package") (package) (use-package package))
  ;; The 0 below means only the first letter ("r") is required,
  ;; such as ":r base64"
  (sb-aclrepl:alias ("require" 0 "Require module") (sys) (require sys))
  (sb-aclrepl:alias ("ql" 1 "Quickload System") (sys) (ql:quickload sys))
  (sb-aclrepl:alias ("ef" 1 "Edit Function") (f) (ed (sb-introspect:definition-source-pathname
                                                      (car (sb-introspect:find-definition-sources-by-name
                                                            f :function)))))
  (setq cl:*features* (delete :aclrepl cl:*features*)))

(sb-ext:set-sbcl-source-location
 (merge-pathnames (make-pathname :directory '(:relative "sbcl-source")
                                 :defaults #1=(user-homedir-pathname))
                  #1#))

(defun asdf-cwd ()
  (push (truename #p".") asdf:*central-registry*))

#+(or)
(defun start-swank ()
  (load #P"~/.vim/bundle/slimv/slime/start-swank.lisp"))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (shadow 'load))

(defun load (pathspec &rest args)
  (restart-case (apply #'cl:load pathspec args)
    (retry () (apply #'load pathspec args))))

#+nil
(setf *print-case* :capitalize)

(pushnew `("SYS:SITE;**;*.*.*" ,(merge-pathnames
                                 (make-pathname :directory (list
                                                            :relative ".sbcl" "site"
                                                            :wild-inferiors)
                                                :name :wild
                                                :type :wild)
                                 (user-homedir-pathname)))
         (logical-pathname-translations "SYS")
         :test #'equal)

(mapcar (lambda (_)
          (load-logical-pathname-translations (pathname-name _)))
        (directory #p"SYS:SITE;*.translations"))