(package-install 'perspective)
(setq persp-suppress-no-prefix-key-warning t)
(persp-mode)

(package-install 'rotate)

(package-install 'window-numbering)
(window-numbering-mode)

(package-install 'resize-window)
(require 'resize-window)

(setq fit-window-to-buffer-horizontally t)

(defun my-fit-window-to-buffer ()
  (interactive)
  (fit-window-to-buffer)
  (resize-window--enlarge-horizontally))

(setq *auto-light-mode* nil)

(defun toggle-auto-light-mode ()
  (interactive)
  (set-frame-parameter
   nil 'screen-gamma
   (if *auto-light-mode*
       2.2
     3.1))
  (setq *auto-light-mode* (not *auto-light-mode*)))

(def-my-command my-window-comand
     '((?/ "[/] vertical splitter" split-window-horizontally)
       (?- "[-] horoziontal splitter" split-window-vertically)
       (?b "[b]alance windows" balance-windows)
       (?t "[t]ransparency" transparency)
       (?l "[l]ightmode toggle" toggle-auto-light-mode)
       (?k "[k]ill window" delete-window)
       (?m "[m]aximise window" delete-other-windows)
       (?R "[R]otate window" rotate-window)
       (?r "[r]esize widnows" resize-window)
       (?f "[f]it window" my-fit-window-to-buffer)
       (?p "font [p]itch shift" variable-pitch-mode)
       (?v "[v]isual line mode" visual-line-mode)
       (?w "[w]riteroom mode" writeroom-mode)))

(def-my-command my-buffer-command
  '((?b "switch [b]uffers" ivy-switch-buffer)
    (?s "[s]ave buffer" save-buffer)
    (?S "[S]ave all buffers" save-some-buffers)
    (?k "[k]ill buffer" kill-buffer)))

(def-my-command my-perspective-command
  '((?s "[s]witch perspective" persp-switch)
    (?k "[k]ill perspective" persp-kill)
    (?d "[d]rop buffer" persp-remove-buffer)
    (?n "re[n]ame perspective" persp-rename)
    (?a "[a]dd buffer" persp-add-buffer)))

(package-install 'autothemer) ;; for custom themes

;(load "~/.emacs.d/shanty-themes.el")

(setq my-installed-themes
      '(sketch-themes
        tao-theme
        brutalist-theme))

(dolist (package my-installed-themes)
  (when (not (package-installed-p package)) 
    (package-install package)))

(setq *my-themes*
      '(brutalist
        brutalist-dark
        sketch-white
        sketch-black
        tao-yang
        tao-yin))

(when (car custom-enabled-themes)
  (disable-theme (car custom-enabled-themes)))

(load-theme (first *my-themes*) t)

(defun my-theme-string ()
  (if (car custom-enabled-themes)
      (format "%s is current" (car custom-enabled-themes))
    ""))

(defun my-theme-cycler ()
  (interactive)
  (let ((still-cycling t))
    (message (format "%s [n]ext or [p]evious. Anything else to quit."
                     (my-theme-string)))
    (while still-cycling
      (let ((char (read-key)))
        (cond
         ((eq char ?n) (my-theme-command-next))
         ((eq char ?p) (my-theme-command-previous))
         (t (setq still-cycling nil))))
      (message (format  "%s [n]ext or [p]evious. Anything else to quit."
                        (my-theme-string))))))

(defun my-theme-command-next ()
  (interactive)
  (let* ((active-theme (car custom-enabled-themes))
         (next-theme (cadr (cl-member active-theme *my-themes*))))
    (when active-theme (disable-theme active-theme))
    (if next-theme (load-theme next-theme t)
      (load-theme (car *my-themes*) t))
    (setq cursor-type 'box)
    (setq-default cursor-type 'box)))

(defun my-theme-command-previous ()
  (interactive)
  (let* ((active-theme (car custom-enabled-themes))
         (themes (reverse *my-themes*))
         (next-theme (cadr (cl-member active-theme themes))))
    (when active-theme (disable-theme active-theme))
    (if next-theme (load-theme next-theme t)
      (load-theme (car themes) t))
    (setq cursor-type 'box)
    (setq-default cursor-type 'box)))

;; halloweenie - a Halloween emacs color theme.
;; Copyright (C) 2021  Colin Okay
;; 
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; 
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;; Spooky times all.


(require 'autothemer)

(autothemer-deftheme
 halloweenie "Ghost, Ghouls, and worst of all: Pumpkin Spice"
 ((((class color) (min-colors #xFFFFFF)))

  (halloweenie-pitch "#1c1c1c")
  (halloweenie-night "#1f213a")
  (halloweenie-blood "#a2270d")
  (halloweenie-potion "#832ea1")
  (halloweenie-slime "#15ed0a")
  (halloweenie-jackolantern "#FF9430")
  (halloweenie-spellglow "#d478e0")   
  (halloweenie-bone "#E8E7D5")        
  (halloweenie-rot "#6Bc980")         
  (halloweenie-ghost "#C1CAE8")       
  (halloweenie-shine "#70c2ca")       
  (halloweenie-cateyes "#ffde38")
  (halloweenie-evileyes "#FF1F1F"))    

 ((default                      (:foreground halloweenie-bone :background halloweenie-pitch) :weight 'semi-bold)
  (error                        (:foreground halloweenie-evileyes :weight 'semi-bold))
  (cursor                       (:background halloweenie-slime))
  (region                       (:background "black"))
  (hl-line                      (:background halloweenie-night))
  (link                         (:background halloweenie-potion))
  (mode-line                    (:background halloweenie-jackolantern :foreground halloweenie-pitch))
  (mode-line-emphasis           (:foreground halloweenie-pitch :weight 'bold))
  (font-lock-comment-face       (:foreground halloweenie-slime))
  (font-lock-string-face        (:foreground halloweenie-rot))
  (font-lock-type-face          (:foreground halloweenie-cateyes :weight 'ultra-bold))
  (font-lock-constant-face      (:foreground halloweenie-evileyes :weight 'extra-bold))
  (font-lock-variable-name-face ( :weight 'bold :foreground halloweenie-spellglow))

  (font-lock-function-name-face (:foreground halloweenie-spellglow :weight 'bold :slant 'italic))
  (font-lock-builtin-face       (:foreground halloweenie-jackolantern :weight 'semi-bold))
  (font-lock-keyword-face       (:foreground halloweenie-jackolantern :weight 'extra-bold))

  ;; org
  (org-todo                    (:weight 'bold :foreground halloweenie-evileyes))
  (org-done                    (:weight 'bold :foreground halloweenie-rot ))

  ;; doom modeline

 (doom-modeline-project-dir
  (:foreground halloweenie-pitch :weight 'bold ))
 (doom-modeline-project-root-dir
  (:foreground halloweenie-blood :weight 'bold))

 ;; persp

 (persp-selected-face
  (:foreground halloweenie-blood :weight 'bold :slant 'italic))))


(provide-theme 'halloweenie)

(package-install 'pdf-tools)
(pdf-tools-install)

(defun my-pdf-annot-at-position (pos)
  "Return annotation at POS in the selected window.

POS should be an absolute image position as a cons \(X . Y\).
Alternatively POS may also be an event position, in which case
`posn-window' and `posn-object-x-y' is used to find the image
position.

Return nil, if no annotation was found."
  (let (window)
    (when (posnp pos)
      (setq window (posn-window pos)
            pos (posn-object-x-y pos)))
    (save-selected-window
      (when window (select-window window 'norecord))
      (let* ((annots (pdf-annot-getannots (pdf-view-current-page)))
             (size (pdf-view-image-size))
             (rx (/ (car pos) (float (car size))))
             (ry (/ (cdr pos) (float (cdr size))))
             (rpos (cons rx ry)))
        (cl-some (lambda (a)
                   (and (cl-some
                         (lambda (e)
                           (pdf-util-edges-inside-p e rpos))
                         (pdf-annot-get-display-edges a))
                        a))
                 annots)))))

(defun my-pdf-annot-add-text-annotation ()
  (interactive)
  (let ((annot
         (or (my-pdf-annot-at-position '(0 . 0))
             (pdf-annot-add-text-annotation '(0 . 0)))))
    (pdf-annot-edit-contents annot)))

(def-my-command my-pdf-view-mod-command
  '((?/ "[/] search pdf" pdf-occur)
    (?l "[l]ist annotations" pdf-annot-list-annotations)
    (?m "[m]idnight mode" pdf-view-midnight-minor-mode)
    (?n "add [n]ote" my-pdf-annot-add-text-annotation)))

(package-install 'crdt)

(require 'cl-lib)
(package-install 'projectile)
(projectile-mode +1)
(setq projectile-project-search-path '("~/projects/"))
(setq projectile-indexing-method 'native)
(setq org-duration-format 'h:mm)

(def-my-command my-projectile-command
  '((?/ "[/] search project" projectile-ag)
    (?r "[r]eplace in project" projectile-replace)
    (?b "project [b]uffers" projectile-ibuffer)
    (?o "[o]pen a project" projectile-switch-project)
    (?g "ma[g]it" magit-status)
    (?j "[j]ump to file" projectile-find-file-dwim)))

(package-install 'company)
(add-hook 'after-init-hook 'global-company-mode)

(package-install 'paredit)
(package-install 'slime)
(package-install 'slime-company)

(setq slime-contribs
      '(slime-fancy slime-company slime-fuzzy slime-asdf))

(defvar my-current-slime-name "sbcl")
(setq sbcl-command "sbcl --dynamic-space-size 4096")
(setq inferior-lisp-program sbcl-command)

(defmacro start-slime-with (str name)
  `(lambda ()
    (interactive)
    (setq inferior-lisp-program ,str)
    (setq my-current-slime-name ,name)
    (my-switch-to-slime)))

(defun slime-in-this-layout-p (name)
  (cl-find-if (lambda (buffer)
                (string-search (format "slime-repl %s" name)
                               (or (buffer-name buffer) "")))
              (persp-buffers (persp-curr))))

(defun my-switch-to-slime ()
  (interactive)
  (let ((buff (slime-in-this-layout-p my-current-slime-name)))
    (if buff (switch-to-buffer-other-window buff)
      (slime))))

(def-my-command my-lisp-switch-command
  `((?' "['] repl" my-switch-to-slime)
    (?s "[s]bcl" ,(start-slime-with sbcl-command "sbcl"))
    (?e "[e]cl" ,(start-slime-with "ecl" "ecl"))
    ;(?c "[c]cl" ,(start-slime-with "~/lisp/ccl/lx86cl64" "ccl"))
    ))

(def-my-command my-lisp-mode-command
  '((?' "['] open slime repl" my-switch-to-slime)
    (?c "[c]ompile form" slime-compile-defun)
    (?l "[l]oad file" slime-load-file)
    (?< "[<] list callers" slime-list-callers)
    (?> "[>] list callees" slime-list-callees)
    (?s "[s]ymbol describe" slime-describe-symbol)
    (?S "[S]ync package" slime-sync-package-and-default-directory)
    (?d "[d]ocumentation" slime-documentation)
    (?\t "[TAB] inspect-presentation" slime-inspect-presentation-at-point)
    (?B "Open CLTL2 [B]ook" open-cltl2)
    (?b "[b]rows system" slime-browse-system)
    (?h "[h]yperspec lookup" hyperspec-lookup)))

(defun open-cltl2 ()
  (interactive)
  (eww "file:///usr/share/doc/cltl/clm/clm.html"))

(with-eval-after-load 'lisp-mode
  (progn
    (setq common-lisp-hyperspec-root "file:///usr/share/doc/hyperspec/")))

(slime-setup '(slime-fancy slime-company))

(setq slime-company-completion 'fuzzy
      slime-company-after-completion 'slime-company-just-one-space)

(autoload 'enable-paredit-mode "paredit" "Turn on pseudo-structural editing of Lisp code." t)
(add-hook 'emacs-lisp-mode-hook       #'enable-paredit-mode)
(add-hook 'eval-expression-minibuffer-setup-hook #'enable-paredit-mode)
(add-hook 'lisp-mode-hook             #'enable-paredit-mode)
(add-hook 'lisp-interaction-mode-hook #'enable-paredit-mode)
(add-hook 'scheme-mode-hook           #'enable-paredit-mode)
(add-hook 'clojure-mode-hook          #'paredit-mode)


(defun space-for-delimiter-after-$-p (delimiter endp)
  (not (char-equal ?$ (char-before (point))))) 

(defun space-for-delimiter-after-@-p (delimiter endp)
  (not (char-equal ?@ (char-before (point)))))

(defun space-for-delimiter-after-p-p (delimiter endp)
  (not (char-equal ?P (char-before (point)))))


(setq paredit-space-for-delimiter-predicates
      (list 'space-for-delimiter-after-$-p
            'space-for-delimiter-after-@-p
            'space-for-delimiter-after-p-p))


(add-hook 'lisp-mode-hook 'linum-mode)

(setq +coalton-package-template+
      "
(defpackage #:%s
  (:import-from
   #:common-lisp
   #:describe
   #:disassemble)
  (:use
   #:coalton
   #:coalton-prelude)
  (:local-nicknames
   (#:types #:coalton-library/types)
   (#:hash #:coalton-library/hash)
   (#:bits #:coalton-library/bits)
   (#:math #:coalton-library/math)
   (#:char #:coalton-library/char)
   (#:string #:coalton-library/string)
   (#:tuple #:coalton-library/tuple)
   (#:optional #:coalton-library/optional)
   (#:list #:coalton-library/list)
   (#:result #:coalton-library/result)
   (#:cell #:coalton-library/cell)
   (#:vector #:coalton-library/vector)
   (#:slice #:coalton-library/slice)
   (#:hashtable #:coalton-library/hashtable)
   (#:st #:coalton-library/monad/state)
   (#:free #:coalton-library/monad/free)
   (#:iter #:coalton-library/iterator)
   (#:sys #:coalton-library/system)))

(named-readtables:in-readtable coalton:coalton)

(in-package #:%s)

(coalton-toplevel 

)
")

(defun insert-coalton-defpackage (name)
  (interactive "sName: ")
  (insert
   (format +coalton-package-template+  name name)))

(message "HERE HERE HERE")