gistfile1.txt

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; masamune customization
;;;
;;; there are two types of customizations that must be taken into account, and
;;; eventually, one. the first, Emacs customizations, the second, for lisp.
;;; the corresponding files emacs-customizations.el and lisp-customizations.lisp
;;; get loaded at the end of the init process. think of it as a replacement
;;; for your .emacs and .sbclrc files.

(in-package #:mm)
(sb-ext:restrict-compiler-policy 'debug 3)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; interface to the SynPS/2 Synaptics TouchPad

(defun touchpad-id ()
  (let* ((a (->> (run-program "xinput --list" :output :string)
		 (string-downcase)
		 (split "\n" )
		 (some (lambda (s) (when (scan "touchpad" s) s)))))
	 (b (all-matches "\\d\\d" a)))
    (read-from-string (apply (curry #'subseq a) b))))

(defun touchpad-on? ()
  (= 1 (->> (run-program (format nil "xinput list-props ~A | grep \"Device Enabled\"" (touchpad-id)) :output :string)
	    (split "\\t")
	    (llast)
	    (read-from-string))))

(defun touchpad-off ()
  (run-program (format nil "xinput set-prop ~d \"Device Enabled\" 0" (touchpad-id))))

(defun touchpad-on ()
  (run-program (format nil "xinput set-prop ~d \"Device Enabled\" 1" (touchpad-id))))

(defun toggle-touchpad ()
  (if (touchpad-on?) (progn (touchpad-off) (stumpwm::banish))
    (touchpad-on)))

(in-package #:stumpwm)

(mode-line)

(defcommand invert-screen () ()
  "inverts the screen"
  (uiop:run-program "xcalib -invert -alter"))

(defcommand toggle-touchpad () ()
  "toggles a synaptics touchpad"
  (mm::toggle-touchpad))

(define-key *root-map* (kbd "C-f") "toggle-touchpad")

(setq *input-window-gravity* :center
      *message-window-gravity* :center
      *normal-border-width* 0
      *window-border-style* :none
      *transient-border-width* 0
      *top-level-error-action* :break)

(in-package #:drei-commands)

(set-key `(com-backward-kill-word ,*numeric-argument-marker*)
	 'deletion-table
	 '((#\Backspace :control)))

(in-package #:mm)

(setq mm::*system-information* nil)

(progn (setf mm::*habits* nil mmg::*focused-habit* nil)
       (captains-log-install)
       (programming-practice-install)
       (mathematics-practice-install)
       (communications-install)
       (quotes-install)
       (summarize-logs-install))




(defun* save-desktop ()
  (interactive)
  (desktop-save "~/.masamune/emacs-desktop-state/"))

(defun* load-desktop ()
  (interactive)
  (desktop-read "~/.masamune/emacs-desktop-state/"))

(add-hook 'org-mode-hook #'abbrev-mode)
(add-hook 'org-mode-hook #'flyspell-mode)
;; (add-hook 'org-mode-hook #'enriched-mode)
;; (add-hook 'org-mode-hook #'refill-mode)
(setq org-agenda-files '( ;"~/quicklisp/local-projects/advice-giver/readme.org" 
			 "~/lisp/org/agenda.org"
			 )
      org-agenda-span 'day
      enable-local-eval t
      custom-safe-themes t
      enable-local-variables :all)

(defun set-volume (n)
  (interactive "nVolume, 70 min, 0 max:")
  (shell-command-to-string (cl-format nil "amixer -c 0 -- sset Master playback -~ddB" n)))

(defun conkeror ()
  (interactive)
  (save-window-excursion
    (async-shell-command (cl-format nil "~a ~a" (expand-file-name "~/algol/xulrunner/xulrunner")
				    (expand-file-name "~/algol/conkeror/application.ini")))))

(defun gists () (interactive) (mm:open-url "http://gist.github.com"))

(defun fb ()
  (interactive)
  (mm:open-url "https://www.facebook.com/messages"))

(defun clim-docs ()
  (interactive)
  (mm:open-url "file:///home/francis/Documents/clim-ug.pdf"))

(defun ghub ()
  (interactive)
  (mm:open-url "http://github.com" t))

(defun math-hb ()
  (interactive)
  (browse-url "file:///home/francis/Documents/books/mathematics-handbook-bronshtein-semendyayev-musiol.pdf"))

(defun gmail ()
  (interactive)
  (mm:open-url "http://mail.google.com"))

(defun books ()
  (interactive)
  (find-file "~/Documents/books/"))

(defun proj ()
  (interactive)
  (find-file "~/quicklisp/local-projects/"))

(defun logs ()
  (interactive)
  (mm:open-url "http://log.bitcoin-assets.com/"))

(defun message-me-in (time)
  (interactive "sTime: ")
  (run-at-time time nil #'alert (read-from-minibuffer "Message: ")))

(defun message-me-in-persistant-message (time)
  (interactive "sTime: ")
  (run-at-time time nil #'alert (read-from-minibuffer "Message: ") t))

(defun create-new-buffer ()
  (interactive)
  (llet ((m (case major-mode
	      ('text-mode           major-mode)
	      ('emacs-lisp-mode     major-mode)
	      ('common-lisp-mode    major-mode)
	      ('lisp-mode          'lisp-mode)
	      ('inferior-lisp-mode 'lisp-mode)
	      ('slime-repl-mode    'lisp-mode)
	      ('sldb-mode          'lisp-mode)
	      (t  'emacs-lisp-mode)))
	 (cl-package (when (equal m 'lisp-mode)
	 	       (intern (slime-current-package)))))
    (switch-to-buffer (generate-new-buffer-name "*new*"))
    (eval `(,m))
    (when cl-package
      (beginning-of-buffer)
      (insert (downcase (s-replace "\\" "" (cat "(in-package " cl-package ")"))))
      (forward-sexp))
    (paredit-newline)
    (paredit-newline)
    (when (equal 'emacs-lisp-mode m) (emacs-lisp-mode 1))))

(defun split-to-new-buffer ()
  (interactive) (split-window-below) (create-new-buffer))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Maxima
;;; 
;;; getting started was easy, add thist stuff to the load path, move the TeX
;;; stuff from point A to point B and then you're up and running - I would like
;;; this to be part of my regular lisp proccess though. 

(add-to-list 'load-path "/home/francis/lisp/maxima-5.33.0/interfaces/emacs/imaxima")
(add-to-list 'Info-directory-list "/usr/local/share/info/")
(autoload 'imaxima "imaxima" "Image support for Maxima." t)
(autoload 'imath-mode "imath" "Interactive Math minor mode." t)

(require 'imaxima)
(require 'imath)
 
(defun maxima-docs ()
  (interactive)
  (info "/usr/local/share/info/maxima.info-1"))

(add-hook 'dired-load-hook (lambda () (load "dired-x")))
(add-hook 'dired-mode-hook 'dired-omit-mode)
(setq dired-recursive-deletes 'always)

;; 
;; ibuffer
;; 

(defadvice ibuffer (around ibuffer-fullscreen activate)
  (window-configuration-to-register :ibuffer-fullscreen)
  ad-do-it
  (delete-other-windows))
 
(defadvice ibuffer-quit (after ibuffer-restore-windows last)
  (jump-to-register :ibuffer-fullscreen)
  (kill-buffer* "*Ibuffer*"))
 
(ad-activate 'ibuffer)
(ad-activate 'ibuffer-quit)
 
;;; TODO, Wed Dec 04 2013, Francis Wolke
;;; Tie this into ibuffer-vc and add the reverse toggle. I should be able to
;;; toggle a group at a time (that is - an ibuffer-vc) group
 
;;; Ignore buffers
 
(defun current-buffer-ignored? () 
  (if (member 't (mapcar (lambda (s) (equal s (buffer-name))) ido-ignore-buffers))
      'true))
 
(define-ibuffer-op ibuffer-do-toggle-ignored ()
  "Ignore buffers - that is, prevent them from showing in `ido-mode'
completions"
  (:opstring "Ignore"
	     :active-opstring "Ignore"
	     :dangerous f
	     :complex f
	     :mark nil
	     :modifier-p f)
  (if (current-buffer-ignored?)
      (setq ido-ignore-buffers (remove (buffer-name buf) ido-ignore-buffers))
    (setq ido-ignore-buffers (cons (buffer-name buf) ido-ignore-buffers))))
 
(define-key ibuffer-mode-map (kbd "i") 'ibuffer-do-toggle-ignored) ;; update the ibuffer-mode-map
 
;; (defcustom ibuffer-ignored-char
;;   "The character to display for ignored buffers."
;;   :type 'character
;;   :group 'ibuffer)
 
(define-ibuffer-column ignored (:name "I" :inline t )
  (if (current-buffer-ignored?) "I" " "))
 
(setq ibuffer-formats '((mark
			 modified 
			 read-only
			 ignored
			 " "
			 (name 18 18 :left :elide)
			 " " 
			 (size 9 -1 :right)
			 " " 
			 (mode 16 16 :left :elide)
			 " " filename-and-process)
			(mark " " (name 16 -1) " " filename)))
 
(put 'set-goal-column 'disabled nil)

;; 
;; irc
;; 

(rcirc-track-minor-mode 1)
(setq rcirc-default-nick "gabriel_laddel")
(setq rcirc-omit-threshold 0)
(setq rcirc-omit-responses '("JOIN" "PART" "QUIT" "NICK" "AWAY"))
(setq rcirc-server-alist
      '(("irc.freenode.net" :channels
	 ("#symbo1ics"
	  "#forth"
	  "#masamune"
	  "#lisp"
	  "#lispkit"
	  ;; "#bitcoin-assets"
	  "#funtoo"
	  "#haskell"
	  "#conkeror"
	  "#machinelearning"
	  "##math"
	  "##statistics"))))

(defun b-a-finalize ()
  ;; XXX 2014-10-10T23:26:15-07:00 Gabriel Laddel
  ;; dependent on the functionality of `new-shell'
  (interactive)
  (with-current-buffer "*shell*"
    (comint-send-eof)
    (setq decrypted-result (some (lambda (o) (when (s-contains? "freenode" o) (s-trim o)))
				 (s-split "\n" (buffer-string-no-properties)))))
  (with-current-buffer "[email protected]"
    (end-of-buffer)
    (insert "everify " decrypted-result)
    (rcirc-send-input))
  (sleep-for 1)
  (with-current-buffer "#[email protected]"
    (end-of-buffer)
    (insert "/msg assbot !up")
    (rcirc-send-input))
  (run-at-time "2 seconds" nil
  	       (lambda () (dolist (k '("*shell*" "[email protected]" "[email protected]"))
  		       (kill-buffer* k)))))

(defun b-a-callback (&rest args)
  (llet ((decrypt-data (llast args))
	 (shell-name (buffer-name (new-shell)))
	 (decrypted-result))
    (with-current-buffer shell-name
      (end-of-buffer)
      (sleep-for 2)
      (insert "gpg --decrypt")
      (end-of-buffer)
      (call-interactively #'comint-send-input)
      (sleep-for 2)
      (insert decrypt-data)
      (call-interactively #'comint-send-input)
      ;; TODO: add hook for password-prompt
      )))

(defun b-a-auth ()
  (interactive)
  (if (buffer-around? "#[email protected]")
      (progn (with-current-buffer "#[email protected]"
	       (end-of-buffer)
	       (insert "/query gribble")
	       (rcirc-send-input))
	     (with-current-buffer "[email protected]"
	       (end-of-buffer)
	       (insert "eauth gabriel_laddel")
	       (rcirc-send-input)
	       (sleep-for 2)
	       (web-http-get #'b-a-callback
			     :url (s-trim (llast (filter (lambda (o) (s-contains? "http://" o))
							 (s-split "\n" (buffer-string-no-properties))))))))
    (error "not logged in!")))

;; 
;; older customizations
;; 

(defun current-theme ()
  "Symbol name of the current theme"
  (car (some #'custom-theme-enabled-p (custom-available-themes))))

(defun set-current-theme (theme)
  "disables the current theme and loads the specified theme"
  (disable-theme (current-theme))
  (load-theme theme)) 

(defalias 'file-as-sexps #'read-sexps-from)
(defalias 'slurp-sexps #'read-sexps-from)

(defun new-browser ()
  (interactive)
  (start-process "chrome" nil
		 "/usr/bin/google-chrome"
		 "--user-data-dir"
		 "file:///home/francis/Documents/books/"
		 "--remote-debugging-port=9222"
		 "--enable-experimental-extension-apis"))

(defun review-temp-buffers ()
  (interactive)
  (window-configuration-to-register :review-temp-buffers)
  (delete-other-windows)
  (loop for buffer in (buffer-list)
	when (and (s-matches? "*new*" (buffer-name buffer))
		  (progn (switch-to-buffer buffer)
			 (y-or-n-p "Kill buffer?")))
	do (kill-buffer buffer))
  (jump-to-register :review-temp-buffers))

(toggle-gui)
(set-current-theme 'leuven)
(shell-command-to-string "setxkbmap us -variant colemak -option ctrl:nocaps")
(set-frame-font "DejaVu Sans Mono-10" nil t)
(set-font-size 70)
(mm:define-key "C-c n" 'create-new-buffer)
(define-key dired-mode-map (kbd "C-c n") 'create-new-buffer)
(define-key org-mode-map (kbd "C-c n") 'create-new-buffer)
(define-key org-agenda-mode-map (kbd "C-c n") 'create-new-buffer)
;; (define-key shell-mode-map (kbd "C-c n") 'create-new-buffer)
(kill-buffer* "*scratch*")
(require 'ace-jump-mode)
(define-key lisp-mode-map (kbd "C-c SPC") 'ace-jump-mode)
(define-key emacs-lisp-mode-map (kbd "C-c SPC") 'ace-jump-mode)
(define-key slime-mode-map (kbd "C-c SPC") 'ace-jump-mode)
(load-desktop)