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

#+(or)
(sb-ext:restrict-compiler-policy 'debug 3)
(sb-ext:restrict-compiler-policy 'safety 1)
#+(or)
(sb-ext:restrict-compiler-policy 'speed 0 1)

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

#.(handler-case
      (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)
    (error (c) (warn "error while loading fowar-sbcl: ~s" c)))

#.(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 '(:struct winsize))
               (let ((res (cffi:foreign-funcall-varargs "ioctl" (:int fd :ulong osicat-posix:tiocgwinsz) :pointer ptr :int)))
                 (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 (= 1 (sb-unix:unix-isatty 0))
    (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))))

  (when (member "--linedit" sb-ext:*posix-argv* :test 'equal)
    (when (interactive-stream-p *terminal-io*)
      (trace sb-unix:unix-isatty)
      (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*)))

#+(or)
(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"))