« back to all changes in this revision
Viewing changes to wmresize.jl
- browse files at revision 3
- compare with another revision
- download diff
- download tarball
- view history from revision 3
- Committer: Bazaar Package Importer
- Author(s): Christian Marillat
- Date: 2004-07-28 15:21:44 UTC
- mfrom: (1.2.1 upstream) (2.1.1 warty)
- Revision ID: james.westby@ubuntu.com-20040728152144-1b1tm5ak371o1pe9
Tags: 1.3.1-1
* New upstream relase.
* Remove old dependency on sawfish-gnome and sawfish2
* Remove old dependency on sawfish-gnome and sawfish2
added
removed
wmresize.jl
1
;; contrib/wmresize.jl -- wm-like resize/move boxes
2
3
;; version 0.1
4
5
;; Copyright (C) 2002 Jindrich Makovicka <makovick@kmlinux.fjfi.cvut.cz>
6
7
;; http://merlin.org/sawfish/
8
9
;; This is free software; you can redistribute it and/or modify it
10
;; under the terms of the GNU General Public License as published by
11
;; the Free Software Foundation; either version 2, or (at your option)
12
;; any later version.
13
14
;; This is distributed in the hope that it will be useful, but
15
;; WITHOUT ANY WARRANTY; without even the implied warranty of
16
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
;; GNU General Public License for more details.
18
19
;; You should have received a copy of the GNU General Public License
20
;; along with sawfish; see the file COPYING. If not, write to
21
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
23
;;;;;;;;;;;;;;;;;;
24
;; INSTALLATION ;;
25
;;;;;;;;;;;;;;;;;;
26
27
;; Create a directory ~/.sawfish/lisp/contrib and then put this file there:
28
;; mkdir -p ~/.sawfish/lisp/contrib
29
;; mv wmresize.jl ~/.sawfish/lisp/contrib
30
31
;; Then add to your .sawfishrc:
32
;; (require 'contrib.wmresize)
33
34
;; Then restart sawfish and go to Customize->Move/Resize and select
35
;; the dimension animation mode.
36
37
;; The appearance of the animation mode can be customized under
38
;; Customize->Move/Resize->Ugliness.
39
40
(define-structure contrib.wmresize
41
42
(export)
43
44
(open
45
rep
46
rep.system
47
sawfish.wm
48
sawfish.wm.custom
49
sawfish.wm.util.x
50
sawfish.wm.util.window-outline)
51
52
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53
;; move-resize basic ugliness settings
54
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
55
56
(defgroup move-ugliness "Ugliness" :group move)
57
58
(defcustom ugly-move-resize-dim-font default-font
59
"Font for move/resize dimension marks."
60
:type font
61
:group (move move-ugliness))
62
63
(defcustom ugly-dim-text-shift 0
64
"Y-axis position correction for dimension text."
65
:type number
66
:range (-100 . 100)
67
:group (move move-ugliness))
68
69
(defcustom ugly-dim-offset 3
70
"Dimension offset."
71
:type number
72
:range (0 . 100)
73
:group (move move-ugliness))
74
75
(defcustom ugly-dim-width 16
76
"Dimension width."
77
:type number
78
:range (0 . 100)
79
:group (move move-ugliness))
80
81
(defcustom ugly-dim-arrow-size (cons 4 8)
82
"Dimension arrow size."
83
:type (pair (labelled "Width:" (number 0 100)) (labelled "Length:" (number 0 100)))
84
:group (move move-ugliness))
85
86
(if (not (memq 'dimension (custom-get-options 'move-outline-mode)))
87
(custom-add-option 'move-outline-mode 'dimension))
88
(if (not (memq 'dimension (custom-get-options 'resize-outline-mode)))
89
(custom-add-option 'resize-outline-mode 'dimension))
90
91
(define (draw-dim-outline x y width height)
92
(require 'sawfish.wm.util.x)
93
(require 'sawfish.wm.fonts)
94
(let ((gc (x-create-root-xor-gc))
95
(wtext (format nil "%d" width))
96
(htext (format nil "%d" height))
97
(htwidth) (wtwidth) (dim) (halfdim)
98
(off ugly-dim-offset)
99
(halfdimoff) (w-orig-y) (h-orig-x)
100
(arrw (car ugly-dim-arrow-size)) (arrl (cdr ugly-dim-arrow-size))
101
(fheight (font-height ugly-move-resize-dim-font))
102
)
103
104
(x-draw-rectangle 'root gc (cons x y) (cons width height))
105
106
(setq wtwidth (text-width wtext ugly-move-resize-dim-font))
107
(setq htwidth (text-width htext ugly-move-resize-dim-font))
108
(setq dim ugly-dim-width)
109
(setq halfdim (round (/ dim 2)))
110
(setq halfdimoff (+ halfdim off))
111
112
;; check where to draw (top/bottom, left/right)
113
(if (> (+ dim off) y) (setq w-orig-y (+ y height dim (* off 2))) (setq w-orig-y y) )
114
(if (> (+ dim off) x) (setq h-orig-x (+ x width dim (* off 2))) (setq h-orig-x x) )
115
116
;; horizontal dimension
117
(if (or (> (+ wtwidth 2 (* arrl 2)) width) (> w-orig-y (screen-height))) (setq wtwidth 0)
118
(x-draw-line 'root gc (cons x (- w-orig-y off)) (cons x (- w-orig-y off dim)) )
119
(x-draw-line 'root gc (cons (+ x width -1) (- w-orig-y off)) (cons (+ x width -1) (- w-orig-y off dim)) )
120
121
(x-draw-string 'root gc (cons
122
(round (+ x (- (/ width 2) (/ wtwidth 2))))
123
(round (+ (- w-orig-y halfdimoff) (/ fheight 2) ugly-dim-text-shift))) wtext ugly-move-resize-dim-font)
124
125
(x-draw-line 'root gc
126
(cons x (- w-orig-y halfdimoff))
127
(cons (round (+ x (- (/ width 2) (/ wtwidth 2) 2) ) ) (- w-orig-y halfdimoff) )
128
)
129
130
(x-draw-line 'root gc
131
(cons (round (+ x (+ (/ width 2) (/ wtwidth 2) 2 ) ) ) (- w-orig-y halfdimoff) )
132
(cons (+ x width) (- w-orig-y halfdimoff))
133
)
134
135
(x-draw-line 'root gc (cons (+ x arrl) (- w-orig-y (+ halfdimoff arrw)))
136
(cons x (- w-orig-y halfdimoff)))
137
(x-draw-line 'root gc (cons (+ x arrl) (- w-orig-y (- halfdimoff arrw)))
138
(cons x (- w-orig-y halfdimoff)))
139
(x-draw-line 'root gc (cons (- (+ x width) arrl) (- w-orig-y (+ halfdimoff arrw)))
140
(cons (+ x width) (- w-orig-y (+ halfdim off))))
141
(x-draw-line 'root gc (cons (- (+ x width) arrl) (- w-orig-y (- halfdimoff arrw)))
142
(cons (+ x width) (- w-orig-y halfdimoff)))
143
144
)
145
146
;; vertical dimension
147
(if (or (> (+ fheight 2 (* arrl 2)) height) (> h-orig-x (screen-width))) (setq fheight 0)
148
(x-draw-line 'root gc (cons (- h-orig-x off dim) y) (cons (- h-orig-x off) y) )
149
(x-draw-line 'root gc (cons (- h-orig-x off dim) (+ y height)) (cons (- h-orig-x off) (+ y height)) )
150
151
(x-draw-string 'root gc (cons
152
(round (- h-orig-x (/ htwidth 2) halfdimoff))
153
(round (+ y (/ height 2) (/ fheight 2) ugly-dim-text-shift))) htext ugly-move-resize-dim-font)
154
155
(x-draw-line 'root gc
156
(cons (- h-orig-x halfdimoff) y)
157
(cons (- h-orig-x halfdimoff) (round (+ y (- (/ height 2) (/ fheight 2) 2 ) ) ) )
158
)
159
160
(x-draw-line 'root gc
161
(cons (- h-orig-x halfdimoff) (round (+ y (+ (/ height 2) (/ fheight 2) 2 ) ) ) )
162
(cons (- h-orig-x halfdimoff) (+ y height))
163
)
164
165
(x-draw-line 'root gc (cons (- h-orig-x (+ halfdimoff arrw)) (+ y arrl)) (cons (- h-orig-x halfdimoff) y))
166
(x-draw-line 'root gc (cons (- h-orig-x (- halfdimoff arrw)) (+ y arrl)) (cons (- h-orig-x halfdimoff) y))
167
(x-draw-line 'root gc (cons (- h-orig-x (+ halfdimoff arrw)) (- (+ y height) arrl))
168
(cons (- h-orig-x halfdimoff) (+ y height)))
169
(x-draw-line 'root gc (cons (- h-orig-x (- halfdimoff arrw)) (- (+ y height) arrl))
170
(cons (- h-orig-x halfdimoff) (+ y height)))
171
)
172
173
(x-destroy-gc gc)))
174
175
(define-window-outliner 'dimension draw-dim-outline))
Loggerhead is a web-based interface for Breezy
Version: 2.0.1