tile-emacs-frame.el

(defvar frame-bar-pixel-num (cc-eval-when-compile
                              (case window-system ((ns) 23))))

(defvar desktop-taskbar-pixel-num (cc-eval-when-compile
                                    (case window-system ((ns) 22))))

(defun mkfparams (direction rframe &optional move)
  (let ((horizontalp (memq direction '(left right)))
        (fp/left (frame-parameter rframe 'left))
        (fp/top (frame-parameter rframe 'top))
        (fp/w (frame-parameter rframe 'width))
        (fp/h (frame-parameter rframe 'height))
        remp)
    (if horizontalp
        (let ((x-extra (+ (frame-fringe-width)
                          (* 2 (frame-border-width)))))
          (case direction
            ((left)
             (unless move
               (setq remp (abs fp/left)))
             (decf fp/left (frame-pixel-width rframe))
             (unless move
               (if (< remp fp/pw)
                   (setq fp/w (-> remp
                                (- x-extra)
                                (floor (frame-char-width)))
                         fp/left 0))))
            ((right)
             (incf fp/left (frame-pixel-width rframe))
             (unless move
               (setq remp (-> fp/left
                            (- (x-display-pixel-width))
                            abs)
                     fp/w (cdr (assoc 'width default-frame-alist))
                     fp/pw (-> fp/w (* (frame-char-width)) (+ x-extra)))
               (if (> fp/pw remp)
                   (setq fp/w (-> remp
                                (- x-extra)
                                (floor (frame-char-width)))))))))
      (let ((y-extra (+ frame-bar-pixel-num
                        (* 2 (frame-border-width)))))
        (incf fp/top frame-bar-pixel-num)
        (case direction
          ((up)
           (unless move
             (setq remp (-> fp/top
                          (- desktop-taskbar-pixel-num)
                          abs)))
           (decf fp/top (+ (frame-pixel-height rframe)
                           frame-bar-pixel-num))
           (unless move
             (if (< remp fp/ph)
                 (setq fp/h (-> remp
                              (- y-extra)
                              (floor (frame-char-height)))))))
          ((down)
           (incf fp/top (frame-pixel-height rframe))
           (unless move
             (setq remp (-> fp/top
                          (- (x-display-pixel-height))
                          abs)
                   fp/h (cdr (assoc 'height default-frame-alist))
                   fp/ph (-> fp/h (* (frame-char-height)) (+ y-extra)))
             (if (> fp/ph remp)
                 (setq fp/h (-> remp
                              (- y-extra)
                              (floor (frame-char-height))))))))))
    (list (cons 'left fp/left)
          (cons 'top fp/top)
          (cons 'width fp/w)
          (cons 'height fp/h))))

(defun tile-frame ()
  "Use optional argument MOVE if you want a frame to move."
  (interactive)
  (let (__ rframe params)
    (setq __ (arrow-event-handler
              (read-event #("Choose horizontal or vertical <->"
                            0 33 (face minibuffer-prompt)))))
    (if current-prefix-arg
        (setq params (mkfparams __ nil 'move))
      (setq rframe (selected-frame)
            params (mkfparams __ rframe)))
    (if (and (<= 0 (cdr (assoc 'left params)) (x-display-pixel-width))
             (<= 0 (cdr (assoc 'top params)) (x-display-pixel-height)))
        (if current-prefix-arg
            (modify-frame-parameters nil (mkfparams __ nil 'move))
          (make-frame (mkfparams __ rframe)))
      (message "No additional tile!."))))