Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

115 lines (97 sloc) 3.893 kb
;; Copyright (C) 2003-2008 Shawn Betts
;;
;; This file is part of stumpwm.
;;
;; stumpwm 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 2, or (at your option)
;; any later version.
;; stumpwm 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 software; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
;; Commentary:
;;
;;; A resize minor mode. Something a bit better should probably be
;;; written. But it's an interesting way of doing it.
;;
;; Code:
(in-package #:stumpwm)
(export '(*resize-increment*
iresize
abort-iresize
exit-iresize))
(defvar *resize-backup* nil)
(defvar *resize-increment* 10
"Number of pixels to increment by when interactively resizing frames.")
(defun set-resize-increment (val)
(setf *resize-increment* val)
(update-resize-map))
(defun update-resize-map ()
(let ((m (or *resize-map* (setf *resize-map* (make-sparse-keymap)))))
(let ((i *resize-increment*))
(labels ((dk (m k c)
(define-key m k (format nil c i))))
(dk m (kbd "Up") "resize 0 -~D")
(dk m (kbd "C-p") "resize 0 -~D")
(dk m (kbd "p") "resize 0 -~D")
(dk m (kbd "k") "resize 0 -~D")
(dk m (kbd "Down") "resize 0 ~D")
(dk m (kbd "C-n") "resize 0 ~D")
(dk m (kbd "n") "resize 0 ~D")
(dk m (kbd "j") "resize 0 ~D")
(dk m (kbd "Left") "resize -~D 0")
(dk m (kbd "C-b") "resize -~D 0")
(dk m (kbd "b") "resize -~D 0")
(dk m (kbd "h") "resize -~D 0")
(dk m (kbd "Right") "resize ~D 0")
(dk m (kbd "C-f") "resize ~D 0")
(dk m (kbd "f") "resize ~D 0")
(dk m (kbd "l") "resize ~D 0")
(define-key m (kbd "RET") "exit-iresize")
(define-key m (kbd "C-g") "abort-iresize")
(define-key m (kbd "ESC") "abort-iresize")))))
(update-resize-map)
(defcommand (iresize tile-group) () ()
"Start the interactive resize mode. A new keymap specific to
resizing the current frame is loaded. Hit @key{C-g}, @key{RET}, or
@key{ESC} to exit."
(let ((frame (tile-group-current-frame (current-group))))
(if (atom (tile-group-frame-head (current-group) (frame-head (current-group) frame)))
(message "There's only 1 frame!")
(progn
(when *resize-hides-windows*
(dolist (f (head-frames (current-group) (current-head)))
(clear-frame f (current-group))))
(message "Resize Frame")
(push-top-map *resize-map*)
(draw-frame-outlines (current-group) (current-head)))
;; (setf *resize-backup* (copy-frame-tree (current-group)))
)))
(defun resize-unhide ()
(clear-frame-outlines (current-group))
(when *resize-hides-windows*
(let ((group (current-group))
(head (current-head)))
(dolist (f (head-frames group head))
(sync-frame-windows group f))
(dolist (w (reverse (head-windows group head)))
(setf (frame-window (window-frame w)) w)
(raise-window w))
(when (current-window)
(focus-window (current-window))))))
(defcommand (abort-iresize tile-group) () ()
"Exit from the interactive resize mode."
(resize-unhide)
(message "Abort resize")
;; TODO: actually revert the frames
(pop-top-map))
(defcommand (exit-iresize tile-group) () ()
"Exit from the interactive resize mode."
(resize-unhide)
(message "Resize Complete")
(pop-top-map))
Jump to Line
Something went wrong with that request. Please try again.