File: iresize.lisp

package info (click to toggle)
stumpwm 1:20110819.gitca08e08-2
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,948 kB
  • sloc: lisp: 14,330; sh: 179; makefile: 112
file content (114 lines) | stat: -rw-r--r-- 3,893 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
;; 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))