(defun contents-from-stream (stream &key length (min-size 256) max-extend)
  "
STREAM:     May be a binary or character, file or non-file stream.
LENGTH:     NIL, or the number of stream elements to read.
MIN-SIZE:   Minimum pre-allocated buffer size. If LENGTH is given, or STREAM
            has a FILE-LENGTH, then the MIN-SIZE is ignored.
MAX-EXTEND: NIL ==> double the buffer size, or double the buffer size until
            it is greater than MAX-EXTEND, and then increment by MAX-EXTEND.
RETURN:     A vector containing the elements read from the STREAM.
"
  (let* ((busize (or length (ignore-errors (file-length stream)) min-size))
         (eltype (stream-ELEMENT-TYPE stream))
         (initel (if (subtypep eltype (quote integer)) 0 #\Space))
         (buffer (make-ARRAY busize
                             :ELEMENT-TYPE eltype
                             :INITIAL-ELEMENT initel
                             :adjustable t :fill-pointer t))
         (start 0))
    (loop
       (let ((end (read-sequence buffer stream :start start)))
         (when (or (< end busize) (and length (= length end)))
           ;; we got eof, or have read enough
           (setf (fill-pointer buffer) end)
           (return-from contents-from-stream buffer))
         ;; no eof; extend the buffer
         (setf busize
               (if (or (null max-extend) (<= (* 2 busize) max-extend))
                   (* 2 busize)
                   (+ busize max-extend))
               start end))
       (adjust-array buffer busize :initial-element initel :fill-pointer t))))


(defun text-file-contents (path &key (if-does-not-exist :error)
                           (external-format :default))
  "
RETURN: The contents of the file at PATH as a LIST of STRING lines.
        or what is specified by IF-DOES-NOT-EXIST if it does not exist.
"
  (with-open-file (in path :direction :input
                      :if-does-not-exist if-does-not-exist
                      :external-format external-format)
    (if (streamp in)
        (contents-from-stream in :min-size 16384)
        in)))


(defun (setf text-file-contents) (new-contents path
                                  &key (if-does-not-exist :create)
                                  (if-exists :supersede)
                                  (external-format :default))
  "
RETURN: The NEW-CONTENTS, or if-exists or if-does-not-exist in case of error.
DO:     Store the NEW-CONTENTS into the file at PATH.  By default,
        that file is created or superseded; this can be changed with
        the keyword IF-DOES-NOT-EXIST or IF-EXISTS.
"
  (with-open-file (out path :direction :output
                       :if-does-not-exist if-does-not-exist
                       :if-exists if-exists
                       :external-format external-format)
    (if (streamp out)
        (write-sequence new-contents out)
        out)))


(defvar *absent* (cons (quote *absent*) nil))
(defmacro define-plist-field (name field &optional (offset (quote identity)))
 "
OFFSET: must be a symbol naming an accessor to find the plist in the record.
"
  `(progn
     (defun ,name (record)
       (let* ((value (getf (,offset record) (quote ,field) *absent*)))
         (if (eq value *absent*)
             (values nil nil)
             (values value t))))
     (defun (setf ,name) (new-value record)
       (setf (getf (,offset record) (quote ,field)) new-value))))

(define-plist-field frame-number        :number  cdr)
(define-plist-field frame-x             :x       cdr)
(define-plist-field frame-y             :y       cdr)
(define-plist-field frame-width         :width   cdr)
(define-plist-field frame-height        :height  cdr)
(define-plist-field frame-screen-width  :screenw cdr)
(define-plist-field frame-screen-height :screenh cdr)


(defun order-by-id (f) (frame-number f))
(defun order-by-x  (f) (frame-x      f))

(defun balance-frames (frames &optional (order-function (function order-by-x)))
  (let* ((frames  (sort frames
                        (function <)
                        :key order-function))
         (screen-width  (frame-screen-width  (first frames)))
         (screen-height (frame-screen-height (first frames)))
         (numframes     (length frames)))
    (loop
      :with width = (truncate screen-width numframes)
      :for x :from 0 :by width
      :for frame :in frames
      :do (setf (frame-x frame) x
                (frame-y frame) 0
                (frame-width frame) width
                (frame-height frame) screen-height))
    frames))



(defun margin-frames (frames right bottom)
  "
First frame should be sized with right and bottom margins.
"
  (flet ((main   (frames) (first  frames))
         (bottom (frames) (second frames))
         (right  (frames) (third  frames)))
    (let ((screen-width  (frame-screen-width  (main frames)))
          (screen-height (frame-screen-height (main frames))))
      (setf (frame-x      (main frames)) 0
            (frame-y      (main frames)) 0
            (frame-width  (main frames)) (- screen-width right)
            (frame-height (main frames)) (- screen-height bottom)
            (frame-x      (bottom frames)) 0
            (frame-y      (bottom frames)) (- screen-height bottom)
            (frame-width  (bottom frames)) (- screen-width right)
            (frame-height (bottom frames)) screen-height
            (frame-x      (right frames)) (- screen-width right)
            (frame-y      (right frames)) 0
            (frame-width  (right frames)) screen-width
            (frame-height (right frames)) screen-height)
      frames)))


(defvar *path* "~/.ratpoison/last-balanced")
(let* ((*print-pretty* nil)
       (input  (read-from-string
                (format nil "(~A)"
                        (substitute #\space #\,
                                    (text-file-contents
                                     *path*))))))
  (cond
    ((eq :order (caar input))
     (let ((order (let ((order (second (pop input))))
                    (if (member order (quote (order-by-x order-by-id)))
                        order
                        (quote order-by-x)))))
       (setf (text-file-contents *path*)
             (format nil "~(~{~S~^,~}~)"
                     (balance-frames input order)))))
    ((eq :margin (caar input))
     (pop input)
     (if (= 3 (length input))
         (setf (text-file-contents *path*)
               (format nil "~(~{~S~^,~}~)"
                       (margin-frames input 128 128)))
         (format *error-output* "Unexpected 4 frames for a margin operation in command file ~A" *path*)))
    (t
     (format *error-output* "Unexpected command file ~A" *path*))))






(defun renumber (old new &rest winums)
  (handler-case
      (let* ((old     (parse-integer old))
             (new     (parse-integer new))
             (winums  (mapcar (function parse-integer) winums))
             (focused (first winums)))
        (assert (member old winnums) () "No window number ~A" old)
        (ext:shell (format nil "ratpoison -c 'select ~A' -c 'number ~A' -c 'select ~A'"
                           old new (if (= old focused) new focused))))
    (error (err) (format *error-output* "~A" err))))

(renumber ext:*args*)
ViewGit