;;; -*- lisp -*-
;;; #Date#: Thu Aug 24 13:11:02 2006

(in-package :stumpwm)

(format t "Plop~%")

(set-prefix-key (kbd "C-<"))

(load "/home/phil/local/stumpwm/mouse.lisp")
(load "/home/phil/local/stumpwm/save-restore.lisp")



;;(setf *foreground-color* "Yellow")
;;(setf *background-color* "Blue")
;;(setf *border-color* "Black")
;;
;;(update-colors-all-screens)
(set-fg-color "Yellow")
(set-bg-color "Blue")
(set-border-color "Black")


;;;; For dual screen: split in 2 screens and move all windows on the second screen.
;;(horiz-split-frame (first *screen-list*))
;;(focus-frame-sibling (first *screen-list*))
;;
;;(mapc (lambda (w)
;;	(pull-window-by-number (current-screen) (window-number w)))
;;      (sort-windows (current-screen)))



;;(defvar *maximized-frame-size* (make-frame :x 0 :y 0 :width 1024 :height 600))
;;; For a dual screen.
;;(defvar *maximized-frame-size* (make-frame :number -1 :x 1024 :y 0 :width 1024 :height 768))

(defvar *maximized-frame-size* (make-frame :number -1 :x 0 :y 0 :width 1024 :height 768))

(defvar *current-frame-size* (make-frame :number -1 :x 0 :y 0 :width 0 :height 0))
(defvar *current-maximized-frame* nil)



(defun maximize-frame (screen frame)
  (when *current-maximized-frame*
    (minimize-frame screen))
  (setf (frame-x *current-frame-size*) (frame-x frame)
	(frame-y *current-frame-size*) (frame-y frame)
	(frame-width *current-frame-size*) (frame-width frame)
	(frame-height *current-frame-size*) (frame-height frame))
  (setf *current-maximized-frame* frame)
  (setf (frame-x frame) (frame-x *maximized-frame-size*)
	(frame-y frame) (frame-y *maximized-frame-size*)
	(frame-width frame) (frame-width *maximized-frame-size*)
	(frame-height frame) (frame-height *maximized-frame-size*))
  (sync-frame-windows screen frame)
  (dolist (win (screen-mapped-windows screen))
    (hide-window win))
  (focus-frame screen frame))



(defun minimize-frame (screen)
  (when *current-maximized-frame*
    (setf (frame-x *current-maximized-frame*) (frame-x *current-frame-size*)
	  (frame-y *current-maximized-frame*) (frame-y *current-frame-size*)
	  (frame-width *current-maximized-frame*) (frame-width *current-frame-size*)
	  (frame-height *current-maximized-frame*) (frame-height *current-frame-size*))
    (sync-frame-windows screen *current-maximized-frame*)
    (setf *current-maximized-frame* nil)
    (dolist (frame (screen-frames screen))
      (when (frame-window frame)
	(unhide-window (frame-window frame))))
    (focus-frame screen (screen-current-frame screen))))

(defun toggle-minmax-frame (screen frame)
  (if *current-maximized-frame*
      (minimize-frame screen)
      (maximize-frame screen frame)))



(define-stumpwm-command "max" (screen)
  (maximize-frame screen (screen-current-frame screen)))

(define-stumpwm-command "min" (screen)
  (minimize-frame screen))

(define-stumpwm-command "toggle" (screen)
  (toggle-minmax-frame screen (screen-current-frame screen)))

(define-stumpwm-command "bdb" (screen)
  (setf (xlib:window-border (xlib:input-focus *display*))
	(xlib:screen-black-pixel (screen-number screen))))

(define-stumpwm-command "bdw" (screen)
  (setf (xlib:window-border (xlib:input-focus *display*))
	(xlib:screen-white-pixel (screen-number screen))))


(define-stumpwm-command "ce" (screen)
  (setup-win-gravity screen (frame-window (screen-current-frame screen)) :center))






(defun show-prompt ()
   (format *terminal-io* "~&~A> " (package-name *package*))
   (force-output *terminal-io*))  

(add-hook *start-hook* #'show-prompt)

(add-hook *internal-loop-hook*
	  (lambda ()
	    (when (listen *terminal-io*)
	      (format t "~{~&~A~}~%"
		      (multiple-value-list
		       (ignore-errors
			 (eval (read *terminal-io*)))))
	      (clear-input *terminal-io*)
	      (show-prompt))))





;;; "Tile two windows horizontally."
(define-stumpwm-command "vt" (screen (win1 :number "Pull: ") (win2 :number "Pull: "))
  (pull-window-by-number screen win1) ; pull the first window
  (horiz-split-frame screen)           ; split the current frame
  (focus-frame-sibling screen)        ; get the sibling, and pull the second window
  (pull-window-by-number screen win2))


;;; "Tile two windows vertically."
(define-stumpwm-command "vt" (screen (win1 :number "Pull: ") (win2 :number "Pull: "))
  (pull-window-by-number screen win1) ; pull the first window
  (vert-split-frame screen)           ; split the current frame
  (focus-frame-sibling screen)        ; get the sibling, and pull the second window
  (pull-window-by-number screen win2))


;;; Exchange two windows in there frames.
(define-stumpwm-command "ex" (screen (win1 :number "Pull: ") (win2 :number "Pull: "))
  (pull-window-by-number screen win1)
  (focus-frame-sibling screen)
  (pull-window-by-number screen win2)
  (focus-frame-sibling screen))

(define-stumpwm-command "exchange1" (screen)
  (let ((n1 (window-number (frame-window (screen-current-frame screen)))))
    (focus-frame-sibling screen)
    (let ((n2 (window-number (frame-window (screen-current-frame screen)))))
      (pull-window-by-number screen n1)
      (focus-frame-sibling screen)
      (pull-window-by-number screen n2))))

;;(define-stumpwm-command "exchange" (screen)
;;  (labels ((find-window (frame-number)
;;	     (find-if (lambda (x)
;;			(= frame-number (frame-number (window-frame x))))
;;		      (screen-mapped-windows screen))))
;;    (let ((n1 (find-window (frame-number (screen-current-frame screen)))))
;;      (dbg n1))))

(define-stumpwm-command "exchange" (screen)
  (let ((n1 (frame-windows screen (screen-current-frame screen)))
	(w1 (frame-window (screen-current-frame screen))))
    (focus-frame-sibling screen)
    (let ((n2 (frame-windows screen (screen-current-frame screen)))
	  (w2 (frame-window (screen-current-frame screen))))
      (dolist (win n1)
	(pull-window-by-number screen (window-number win)))
      (frame-raise-window screen (screen-current-frame screen) w1)
      (focus-frame-sibling screen)
      (dolist (win n2)
	(pull-window-by-number screen (window-number win)))
      (frame-raise-window screen (screen-current-frame screen) w2))))


;;; Change in core.lisp
(defun max-width (font l &optional (max-char nil))
  "Return the width of the longest string in L using FONT."
  (loop for i in l
	maximize (xlib:text-width font
				  (if (numberp max-char)
				      (subseq i 0 (min (length i) max-char))
				      i))))


(defun setup-message-window (screen l &optional (pos-y 0) max-char)
  (let ((height (* (length l)
		   (+ (xlib:font-ascent (screen-font screen))
		      (xlib:font-descent (screen-font screen)))))
	(width (max-width (screen-font screen) l max-char)) ; PHIL
	(screen-width (xlib:drawable-width (xlib:screen-root (screen-number screen))))
	(win (screen-message-window screen)))
    ;; Now that we know the dimensions, raise and resize it.
    (xlib:map-window (screen-message-window screen))
    (setf (xlib:drawable-y win) pos-y
	  (xlib:drawable-height win) height
	  (xlib:drawable-x win) (- screen-width width
				   (* (xlib:drawable-border-width win) 2)
				   (* *message-window-padding* 2))
	  (xlib:drawable-width win) (+ width (* *message-window-padding* 2))
	  (xlib:window-priority win) :above)
    ;; Clear the window
    (xlib:clear-area win)))


(defun echo-string-list (screen strings &optional highlight (pos-y 0) (max-char 100))
  "Draw each string in l in the screen's message window. HIGHLIGHT is
the nth entry to highlight."
  (let* ((height (+ (xlib:font-descent (screen-font screen))
		    (xlib:font-ascent (screen-font screen))))
	 (gcontext (create-message-window-gcontext screen))
	 (message-win (screen-message-window screen)))
    (setup-message-window screen strings pos-y max-char)
    (loop for s in strings
	  ;; We need this so we can track the row for each element
	  for i from 0 to (length strings)
	  do (xlib:draw-image-glyphs message-win gcontext
				     *message-window-padding*
				     (+ (* i height)
					(xlib:font-ascent (screen-font screen)))
				     s)
	  when (and highlight
		    (= highlight i))
	  do (invert-rect screen message-win
			  0 (* i height)
			  (xlib:drawable-width message-win)
			  height)))
  (xlib:display-force-output *display*)
  ;; Set a timer to hide the message after a number of seconds
  (reset-timeout))


(defun pull-with-echo-windows (screen fmt pos-y &optional max-char)
  "Print a list of the windows to the screen."
  (let* ((wins (sort-windows screen))
	 (highlight (position (screen-current-window screen) wins :test #'xlib:window-equal))
	 (names (mapcar (lambda (w)
			  (format-expand *window-formatters* fmt w)) wins)))
    (if (null wins)
	(echo-string screen "No Managed Windows")
	(progn
	  (echo-string-list screen names highlight pos-y max-char)
	  (let ((win (parse-integer (or (read-one-line screen "Pull window: ") "")
				    :junk-allowed t)))
	    (when win
	      (pull-window-by-number screen win)))))))

(define-stumpwm-command "pull-with-echo-windows" (screen)
  (pull-with-echo-windows screen *window-format* 30 100))

;;(set-key-binding #\w '(:control) "pull-with-echo-windows")
;;(define-key *root-map* (kbd "C-w") "pull-with-echo-windows")






;;; core.lisp
;;; PHIL
(defun split-prop-frame-h (screen p prop1 prop2)
  "Return 2 new frames. The first one stealing P's number and window"
  (let* ((w1 (truncate (* prop1 (/ (frame-width p) (+ prop1 prop2)))))
	 (w2 (truncate (* prop2 (/ (frame-width p) (+ prop1 prop2)))))
	 (h (frame-height p))
	 (f1 (make-frame :number (frame-number p)
			 :x (frame-x p)
			 :y (frame-y p)
			 :width w1
			 :height h
			 :window (frame-window p)))
	 (f2 (make-frame :number (find-free-frame-number screen)
			 :x (+ (frame-x p) w1)
			 :y (frame-y p)
			 :width w2
			 :height h
			 :window nil)))
    (values f1 f2)))
;;; -PHIL


;;; PHIL
(defun split-prop-frame-v (screen p prop1 prop2)
  "Return 2 new frames. The first one stealing P's number and window"
  (let* ((w (frame-width p))
	 (h1 (truncate (* prop1 (/ (frame-height p) (+ prop1 prop2)))))
	 (h2 (truncate (* prop2 (/ (frame-height p) (+ prop1 prop2)))))
	 (f1 (make-frame :number (frame-number p)
			 :x (frame-x p)
			 :y (frame-y p)
			 :width w
			 :height h1
			 :window (frame-window p)))
	 (f2 (make-frame :number (find-free-frame-number screen)
			 :x (frame-x p)
			 :y (+ (frame-y p) h1)
			 :width w
			 :height h2
			 :window nil)))
    (values f1 f2)))
;;; -PHIL



;;; User.lisp
;;; PHIL : horiz split prop
(defun horiz-split-prop-frame (screen prop1 prop2)
  (minimize-frame screen)   ; PHIL
  (split-frame screen (lambda (f) (split-prop-frame-h screen f prop1 prop2)))
  (show-frame-indicator screen))

(define-stumpwm-command "hpsplit" (screen (prop1 :number "Prop 1: ") (prop2 :number "Prop 2: "))
  (horiz-split-prop-frame screen prop1 prop2))
;;; -PHIL

;;; PHIL : vert split prop
(defun vert-split-prop-frame (screen prop1 prop2)
  (minimize-frame screen)   ; PHIL
  (split-frame screen (lambda (f) (split-prop-frame-v screen f prop1 prop2)))
  (show-frame-indicator screen))

(define-stumpwm-command "vpsplit" (screen (prop1 :number "Prop 1: ") (prop2 :number "Prop 2: "))
  (vert-split-prop-frame screen prop1 prop2))
;;; -PHIL



;;; Focus next/previous frame

(defun focus-next-frame (screen)
  (minimize-frame screen)
  (let ((win-number 10000)
	(win-frame nil)
	(current-number (frame-number (screen-current-frame screen))))
    (dolist (f (screen-frames screen))
      (when (and (> (frame-number f) current-number)
		 (< (frame-number f) win-number))
	(setf win-number (frame-number f)
	      win-frame f)))
    (unless win-frame
      (dolist (f (screen-frames screen))
	(when (< (frame-number f) win-number)
	  (setf win-number (frame-number f)
		win-frame f))))
    (focus-frame screen win-frame)
    (show-frame-indicator screen)))

(define-stumpwm-command "next-frame" (screen)
  (focus-next-frame screen))


(define-stumpwm-command "previous-frame" (screen)
  (minimize-frame screen)
  (let ((win-number -1)
	(win-frame nil)
	(current-number (frame-number (screen-current-frame screen))))
    (dolist (f (screen-frames screen))
      (when (and (< (frame-number f) current-number)
		 (> (frame-number f) win-number))
	(setf win-number (frame-number f)
	      win-frame f)))
    (unless win-frame
      (dolist (f (screen-frames screen))
	(when (> (frame-number f) win-number)
	  (setf win-number (frame-number f)
		win-frame f))))
    (focus-frame screen win-frame)
    (show-frame-indicator screen)))


(define-stumpwm-command "move-to-next-frame" (screen)
  (let ((win (frame-window (screen-current-frame screen))))
    (focus-next-frame screen)
    (when win
      (pull-window-by-number screen (window-number win)))))


(define-stumpwm-command "move-window-to-frame" (screen (f :frame))
  (let ((win (frame-window (screen-current-frame screen))))
    (focus-frame screen f)
    (when win
      (pull-window-by-number screen (window-number win)))
    (show-frame-indicator screen)))


(define-stumpwm-command "delete-other-frames" (screen)
  (let ((win (frame-window (screen-current-frame screen))))
    (save-screen-layout screen "saved")
    (loop for i from 1 below (length (screen-frames screen)) do
	  (focus-frame-sibling screen)
	  (remove-split screen))
    (when win
      (pull-window-by-number screen (window-number win)))))

    




(define-key *root-map* (kbd "C-s") "vsplit")
(define-key *root-map* (kbd "C-w") "pull-with-echo-windows")

(define-key *root-map* (kbd "m") "exec links2 -g http://localhost:3333")
(define-key *root-map* (kbd "C-e") "exec emacsremote-Eterm")

(define-key *root-map* (kbd "C-<") "other")
(define-key *root-map* (kbd "<") "meta")

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

(define-key *root-map* (kbd "C-x") "exchange")

;;(define-key *root-map* (kbd "C-Right") "next-frame")
;;(define-key *root-map* (kbd "C-Left") "previous-frame")
;;
;;(define-key *root-map* (kbd "Right") "next-frame")
;;(define-key *root-map* (kbd "Left") "previous-frame")

(define-key *root-map* (kbd "Tab") "next-frame")
(define-key *root-map* (kbd "C-Tab") "previous-frame")
(define-key *root-map* (kbd "C-SPC") "next-frame")

(define-key *root-map* (kbd "C-,") "move-to-next-frame")

(define-key *root-map* (kbd "C-f") "move-window-to-frame")

(define-key *root-map* (kbd "C-r") "delete-other-frames")



;;; **************************************************

(defun find-closest-frame (ref-frame framelist closeness-func lower-bound-func
			   upper-bound-func)
  (loop for f in framelist
	with r = nil
	do (when (and
		  ;; Frame is on the side that we want.
		  (<= 0 (funcall closeness-func f))
		  ;; Frame is within the bounds set by the reference frame.
		  (or (<= (funcall lower-bound-func ref-frame)
			  (funcall lower-bound-func f)
			  (funcall upper-bound-func ref-frame))
		      (<= (funcall lower-bound-func ref-frame)
			  (funcall upper-bound-func f)
			  (funcall upper-bound-func ref-frame))
		      (<= (funcall lower-bound-func f)
			  (funcall lower-bound-func ref-frame)
			  (funcall upper-bound-func f)))
		  ;; Frame is closer to the reference and the origin than the
		  ;; previous match
		  (or (null r)
		      (< (funcall closeness-func f) (funcall closeness-func r))
		      (and (= (funcall closeness-func f) (funcall closeness-func r))
			   (< (funcall lower-bound-func f) (funcall lower-bound-func r)))))
	     (setf r f))
	finally (return r)))

(define-stumpwm-command "move-focus" (screen (dir :string "Direction: "))
  (minimize-frame screen)
  (destructuring-bind (perp-coord perp-span parall-coord parall-span)
      (cond
	((or (string= dir "left") (string= dir "right"))
	 (list #'frame-y #'frame-height #'frame-x #'frame-width))
	((or (string= dir "up") (string= dir "down"))
	 (list #'frame-x #'frame-width #'frame-y #'frame-height))
	(t
	 (echo-string screen "Valid directions: up, down, left, right")
	 '(nil nil nil nil)))
    (when perp-coord
      (let ((new-frame (find-closest-frame
			(screen-current-frame screen)
			(screen-frames screen)
			(if (or (string= dir "left") (string= dir "up"))
			    (lambda (f)
			      (- (funcall parall-coord (screen-current-frame screen))
				 (funcall parall-coord f) (funcall parall-span f)))
			    (lambda (f)
			      (- (funcall parall-coord f)
				 (funcall parall-coord (screen-current-frame screen))
				 (funcall parall-span (screen-current-frame screen)))))
			perp-coord
			(lambda (f)
			  (+ (funcall perp-coord f) (funcall perp-span
							     f))))))
	(when new-frame
	  (focus-frame screen new-frame))
	(show-frame-indicator screen)))))



;;(define-key *top-map* (kbd "M-Up")    "move-focus up"   )
;;(define-key *top-map* (kbd "M-Down")  "move-focus down" )
;;(define-key *top-map* (kbd "M-Left")  "move-focus left" )
;;(define-key *top-map* (kbd "M-Right") "move-focus right")
;;(sync-keys)  ; Not sure if this is necessary when defining keys before
;;					; any windows have been created.

(define-key *root-map* (kbd "C-Left") "move-focus left")
(define-key *root-map* (kbd "C-Right") "move-focus right")
(define-key *root-map* (kbd "C-Down") "move-focus down")
(define-key *root-map* (kbd "C-Up") "move-focus up")



;;;; PCD : CD Player
(define-stumpwm-command "play-cd" (screen)
  (declare (ignore screen))
  (run-shell-command "pcd play"))

(define-stumpwm-command "stop-cd" (screen)
  (declare (ignore screen))
  (run-shell-command "pcd stop"))

(define-stumpwm-command "toggle-cd" (screen)
  (declare (ignore screen))
  (run-shell-command "pcd toggle"))

(define-stumpwm-command "next-cd" (screen)
  (declare (ignore screen))
  (run-shell-command "pcd next"))

(define-stumpwm-command "previous-cd" (screen)
  (declare (ignore screen))
  (run-shell-command "pcd previous"))

(define-stumpwm-command "play-track-n-cd" (screen (n :number "Play track: "))
  (declare (ignore screen))
  (run-shell-command (format nil "pcd play ~A" n)))

(define-stumpwm-command "info-cd" (screen)
  (run-shell-command "pcd info > /tmp/stumpwm-cd-info")
  (sleep 0.5)
  (when (probe-file "/tmp/stumpwm-cd-info")
    (with-open-file (stream "/tmp/stumpwm-cd-info" :direction :input)
      (echo-string screen (read-line stream)))
    (delete-file "/tmp/stumpwm-cd-info")))

(define-stumpwm-command "more-info-cd" (screen)
  (run-shell-command "pcd more_info > /tmp/stumpwm-cd-info")
  (sleep 0.5)
  (when (probe-file "/tmp/stumpwm-cd-info")
    (with-open-file (stream "/tmp/stumpwm-cd-info" :direction :input)
      (let ((*timeout-wait* 20))
	(echo-string-list screen
			  (loop for line = (read-line stream nil nil)
				while line
				collect line))))
    (delete-file "/tmp/stumpwm-cd-info")))



(define-key *root-map* (kbd "Menu") "next-cd")
(define-key *root-map* (kbd "C-Menu") "play-cd")
(define-key *root-map* (kbd "Select") "previous-cd")
(define-key *root-map* (kbd "C-Select") "stop-cd")
(define-key *root-map* (kbd "Pause") "toggle-cd")
(define-key *root-map* (kbd "C-Pause") "play-track-n-cd")
(define-key *root-map* (kbd "Print") "info-cd")
(define-key *root-map* (kbd "C-Print") "more-info-cd")




;;; Battery info
(defun extract-battery-info (file field)
  (with-open-file (stream file :direction :input)
    (loop for line = (read-line stream nil nil)
	  while line do
	  (when (search field line)
	    (return (parse-integer (subseq line (1+ (length field))) :junk-allowed t))))))

(defun remaining-battery ()
  (extract-battery-info "/proc/acpi/battery/BAT1/state" "remaining capacity:"))

(defun full-battery-capacity ()
  (extract-battery-info "/proc/acpi/battery/BAT1/info" "last full capacity:"))


(define-stumpwm-command "show-battery" (screen)
  (let ((rem (remaining-battery))
	(full (full-battery-capacity)))
    (echo-string screen (format nil "Battery: ~AmAh / ~AmAh -> ~,1F%" rem full (/ rem full 0.01)))))


(define-stumpwm-command "run-top" (screen)
  (run-shell-command "top -b -n 1 > /tmp/stumpwm-top")
  (sleep 1)
  (when (probe-file "/tmp/stumpwm-top")
    (with-open-file (stream "/tmp/stumpwm-top" :direction :input)
      (let ((*timeout-wait* 20))
	(echo-string-list screen
			  (loop for line = (read-line stream nil nil)
				while line
				collect line))))
    (delete-file "/tmp/stumpwm-top")))


(define-key *root-map* (kbd "*") "show-battery")
(define-key *root-map* (kbd "C-*") "run-top")