;; --*- 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)))
#.(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))
       (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
  (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" "sbcl")
                                  :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"))

(asdf:defsystem fwoar-sbcl
  :depends-on ((:require :sb-aclrepl)
               (:require :sb-introspect)
               :alexandria
               :cffi
               :fwoar-lisputils
               :linedit
               :osicat
               :serapeum))

;; --*- 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)))
#.(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))
       (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
  (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" "sbcl")
                                  :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"))

(asdf:defsystem fwoar-sbcl
  :depends-on ((:require :sb-aclrepl)
               (:require :sb-introspect)
               :alexandria
               :cffi
               :fwoar-lisputils
               :linedit
               :osicat
               :serapeum))