← Back to branch summary

~ubuntu-branches/ubuntu/karmic/sawfish-merlin-ugliness/karmic

« back to all changes in this revision

Viewing changes to pager.jl

  • 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

Show diffs side-by-side

added added

removed removed

Lines of Context:
pager.jl
1
1
;; merlin/pager.jl -- a bad pager
2
2
 
3
 
;; version -0.91.1
 
3
;; version -0.91.3
4
4
 
5
5
;; Copyright (C) 2000-2001 merlin <merlin@merlin.org>
6
6
 
179
179
              (set-input-focus window))))
180
180
         ((eq button 'button-3)
181
181
          (current-event-window window)
182
 
          (popup-window-menu window)))))
 
182
          (popup-window-menu window))))
 
183
    nil)
183
184
 
184
185
; BUG: If I click, then drag one pixel, then wait, then I
185
186
; lose the focus... Also, that first drag event doesn't
201
202
              (cons* (sawlet-config pager 'divisor)
202
203
                (cons+ (sawlet-get pager 'drag-xy)
203
204
                  (car (win-foo pager window 'win-border))))))
204
 
        (move-window-interactively window))))
 
205
        (move-window-interactively window)))
 
206
    nil)
205
207
 
206
208
  (define (win-button-release-handler pager event)
207
209
    (sawlet-put pager 'drag-win nil
208
 
      (lambda (win) (sawlet-put pager 'old-drag-win win))))
 
210
      (lambda (win) (sawlet-put pager 'old-drag-win win)))
 
211
    nil)
209
212
 
210
213
  (define (win-enter-notify-handler pager event)
211
214
    (let*
214
217
      (unless (sawlet-get pager 'drag-win)
215
218
        (let ((tooltips-enabled t))
216
219
          (display-tooltip-after-delay (window-name window) window))
217
 
        (call-hook 'enter-notify-hook (list window 'normal)))))
 
220
        (call-hook 'enter-notify-hook (list window 'normal))))
 
221
    nil)
218
222
 
219
223
  (define (win-leave-notify-handler pager event)
220
224
    (let*
221
225
        ((win (cdr (assq 'window event)))
222
226
         (window (x-window-get win 'window)))
223
227
      (unless (sawlet-get pager 'drag-win)
224
 
        (call-hook 'leave-notify-hook (list window 'normal)))))
 
228
        (call-hook 'leave-notify-hook (list window 'normal))))
 
229
    nil)
225
230
 
226
231
  (define (win-repaint pager win)
227
232
    (let*
234
239
      (x-draw-string win gc (cons 1 (font-ascent font)) title font)))
235
240
    
236
241
  (define (win-expose-handler pager event)
237
 
    (win-repaint pager (cdr (assq 'window event))))
 
242
    (win-repaint pager (cdr (assq 'window event)))
 
243
    nil)
238
244
 
239
245
  (define win-event-handlers
240
246
    `((button-press . ,win-button-press-handler)
288
294
                (height . ,(cdr dim)))))))))
289
295
 
290
296
  (define (after-add-window-eye pager window)
291
 
    (unless (or (window-get window 'ignored) (window-get window (sawlet-symbol pager 'win))) ;; HACK
 
297
    (unless
 
298
        (or (window-get window 'ignored)
 
299
            (dock-window-p window)
 
300
            (desktop-window-p window)
 
301
            (window-get window (sawlet-symbol pager 'win))) ;; HACK
292
302
      (let*
293
303
          ((border (win-foo pager window 'win-border))
294
304
           (win
386
396
 
387
397
  ;;;;
388
398
 
389
 
  (define (viewport-repaint pager)
390
 
    (x-clear-window (sawlet-get pager 'viewport)))
 
399
  (define (viewport-expose-handler pager)
 
400
    (x-clear-window (sawlet-get pager 'viewport))
 
401
    nil)
391
402
 
392
403
  (define (viewport-event-handler type window event)
393
404
    (let ((sawlet (x-window-get window 'sawlet)))
394
 
      (cond ((eq type 'expose) (viewport-repaint pager))
 
405
      (cond ((eq type 'expose) (viewport-expose-handler pager))
395
406
            ((eq type 'enter-notify) (window-enter-notify-handler pager event)))))
396
407
 
397
408
  (define pagers nil)
476
487
       viewport
477
488
       `((background . ,(sawlet-config pager 'viewport-background))
478
489
         (border-color . ,(cdr (sawlet-config pager 'viewport-border)))))
479
 
      (viewport-repaint pager))
 
490
      (viewport-expose-handler pager))
480
491
    (mapc
481
492
      (lambda (window)
482
493
        (let
486
497
      (managed-windows)))
487
498
 
488
499
  (define (window-expose-handler pager event)
489
 
    (x-clear-window (cdr (assq 'window event))))
 
500
    (x-clear-window (cdr (assq 'window event)))
 
501
    nil)
490
502
 
491
503
  (define (window-enter-notify-handler pager event)
492
504
    (let
493
505
        ((frame (sawlet-frame pager)))
494
506
      (unless (sawlet-get pager 'drag-win)
495
 
        (call-hook 'enter-notify-hook (list frame 'normal)))))
 
507
        (call-hook 'enter-notify-hook (list frame 'normal))))
 
508
    nil)
496
509
 
497
510
  (define (window-button-press-handler pager event)
498
511
    (let*
503
516
                     (cons* (cons x y) (sawlet-config pager 'divisor))
504
517
                     (screen-dimensions))))
505
518
      (when (eq button 'button-1)
506
 
        (set-screen-viewport (car viewport) (cdr viewport)))))
 
519
        (set-screen-viewport (car viewport) (cdr viewport))))
 
520
    nil)
507
521
 
508
522
  ;; a hack on sawfish.wm.viewport#set-viewport so I can ignore the myriand
509
523
  ;; move-windows...