File: keymaps.jl

package info (click to toggle)
sawfish 1%3A1.3.5.2-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 11,636 kB
  • ctags: 1,327
  • sloc: lisp: 22,765; ansic: 15,810; sh: 10,203; makefile: 675; perl: 19
file content (209 lines) | stat: -rw-r--r-- 7,345 bytes parent folder | download
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
;; keymaps.jl -- the default keymaps
;; $Id: keymaps.jl,v 1.55 2003/01/12 20:30:50 jsh Exp $

;; Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>

;; This file is part of sawmill.

;; sawmill 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.

;; sawmill 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 sawmill; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

(define-structure sawfish.wm.keymaps

    (export custom-set-keymap)

    (open rep
	  rep.system
	  sawfish.wm.windows
	  sawfish.wm.events
	  sawfish.wm.custom)

  (defgroup bindings "Bindings"
    :layout keymaps)

;;; Customize support

  (define (customizable-command-p x)
    (or (symbolp x)
	(and (symbolp (car x)) (get (car x) 'custom-command-args))))

  (define (custom-get-keymap symbol)
    (cons 'keymap (mapcar (lambda (cell)
			    (cons (car cell) (event-name (cdr cell))))
			  (filter (lambda (cell)
				    (customizable-command-p (car cell)))
				  (cdr (symbol-value symbol))))))

  ;; can't just call out to custom-set-variable since we side-effect VALUE
  (define (custom-set-keymap symbol value)
    (custom-set
     (lambda ()
       (when (eq (car value) 'keymap)
	 (let
	     ((old-value (and (boundp symbol) (symbol-value symbol)))
	      (new-tail (delq nil (mapcar (lambda (cell)
					    (let
						((ev (condition-case nil
							 (lookup-event
							  (cdr cell))
						       (error nil))))
					      (and ev (cons (car cell) ev))))
					  (cdr value)))))

	   (when (eq old-value (variable-default-value symbol))
	     ;; protect the default-value, an ugly hack..
	     (put symbol 'custom-default-value
		  (copy-sequence (variable-default-value symbol))))

	   ;; add in any non-command bindings
	   (setq new-tail (nconc new-tail
				 (filter (lambda (cell)
					   (not (customizable-command-p
						 (car cell))))
					 (cdr old-value))))
	   (if (and old-value (eq (car old-value) 'keymap))
	       ;; hijack the old keymap to preserve eq-ness
	       (rplacd old-value new-tail)
	     (set symbol (cons 'keymap new-tail))))))
     symbol))

  (define-custom-setter 'custom-set-keymap custom-set-keymap)
  (put 'keymap 'custom-set 'custom-set-keymap)
  (put 'keymap 'custom-get custom-get-keymap)

;;; Options

  (defcustom global-keymap (bind-keys (make-keymap)
			     "W-Left" 'previous-workspace
			     "W-Right" 'next-workspace
			     "W-Tab" 'cycle-windows)
    "Keymap containing bindings active anywhere."
    :group bindings
    :type keymap
    :before-set (lambda () (ungrab-keymap global-keymap))
    :after-set (lambda () (grab-keymap global-keymap)))

  (defcustom window-keymap (bind-keys (make-keymap)
			     "W-Up" 'raise-window
			     "W-Down" 'lower-window
			     "W-Button3-Click1" 'raise-lower-window
			     "W-Button2-Click1" 'popup-window-menu
			     "W-Button1-Move" 'move-window-interactively
			     "Button1-Click1" 'raise-and-pass-through-click)
    "Keymap containing bindings active when a client window is focused."
    :group bindings
    :type keymap
    :before-set (lambda () (ungrab-keymap window-keymap))
    :after-set (lambda () (grab-keymap window-keymap)))

  (defcustom root-window-keymap (bind-keys (make-keymap)
				  "Button2-Click1" 'popup-root-menu)
    "Keymap containing bindings active when the pointer is in the root window
(or when no window is focused)."
    :group bindings
    :type keymap)

  (defcustom title-keymap (bind-keys (make-keymap)
			    "Button3-Off" 'raise-lower-window
			    "Button2-Move" 'resize-window-interactively
			    "Button1-Off2" 'toggle-window-shaded
			    "Button1-Move" 'move-window-interactively)
    "Keymap containing bindings active when the pointer is in the title of
a window. (Only mouse-bindings are evaluated in this map.)"
    :group bindings
    :type keymap)

  (defcustom border-keymap (bind-keys (make-keymap)
			     "Button3-Off" 'raise-lower-window
			     "Button2-Move" 'move-window-interactively
			     "Button1-Move" 'resize-window-interactively)
    "Keymap containing bindings active when the pointer is in the border of
a window. (Only mouse-bindings are evaluated in this map.)"
    :group bindings
    :type keymap)

  (defcustom close-button-keymap (bind-keys (make-keymap)
				   "Button3-Click1" 'popup-window-menu
				   "S-Button1-Off" 'delete-group
				   "Button1-Off" 'delete-window)
    "Keymap containing bindings active when the pointer is in the close button
of a window. (Only mouse-bindings are evaluated in this map.)"
    :group bindings
    :type keymap)

  (defcustom iconify-button-keymap (bind-keys (make-keymap)
				     "Button3-Click1" 'popup-window-menu
				     "Button1-Off" 'iconify-window)
    "Keymap containing bindings active when the pointer is in the iconify
button of a window. (Only mouse-bindings are evaluated in this map.)"
    :group bindings
    :type keymap)

  (defcustom maximize-button-keymap (bind-keys (make-keymap)
				      "Button3-Off" 'maximize-window-horizontally-toggle
				      "Button2-Off" 'maximize-window-vertically-toggle
				      "Button1-Off" 'maximize-window-toggle)
    "Keymap containing bindings active when the pointer is in the maximize
button of a window. (Only mouse-bindings are evaluated in this map.)"
    :group bindings
    :type keymap)

  (defcustom menu-button-keymap (bind-keys (make-keymap)
				  "Button3-Off" 'delete-window
				  "Button1-Click1" 'popup-window-menu)
    "Keymap containing bindings active when the pointer is in the menu button
of a window. (Only mouse-bindings are evaluated in this map.)"
    :group bindings
    :type keymap)

  (defcustom shade-button-keymap (bind-keys (make-keymap)
				   "Button1-Off" 'toggle-window-shaded)
    "Keymap containing bindings active when the pointer is in the shade button
of a window. (Only mouse-bindings are evaluated in this map.)"
    :group bindings
    :type keymap)

  (defvar pointer-motion-threshold 2
    "Distance in pixels pointer must move before generating motion events.")

  (defcustom wm-modifier-value (wm-modifier)
    "Modifier key(s) used for default shortcuts."
    :group bindings
    :type modifier-list
    :after-set (lambda ()
		 (ungrab-keymap global-keymap)
		 (ungrab-keymap window-keymap)
		 (set-wm-modifier wm-modifier-value)
		 (grab-keymap window-keymap)
		 (grab-keymap global-keymap)))

;;; Arrange for window-keymap to be set in each window

  (define (keymap-add-window w)
    (unless (window-get w 'keymap)
      (window-put w 'keymap window-keymap)))
  
  (add-hook 'add-window-hook keymap-add-window)

;; custom support for modifiers

  (define-custom-serializer 'modifier-list
			    (lambda (value)
			      (require 'sawfish.wm.util.decode-events)
			      (decode-modifier value)))

  (define-custom-deserializer 'modifier-list
			      (lambda (value)
				(require 'sawfish.wm.util.decode-events)
				(encode-modifier value))))