xwem / lisp / xwem-clgen.el

  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
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
;;; xwem-clgen.el --- Generic model to manage clients.

;; Copyright (C) 2004 by Free Software Foundation, Inc.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;;         Steve Youngs  <steve@youngs.au.com>
;; Created: Sat Aug 28 14:31:39 MSD 2004
;; Keywords: xwem
;; X-CVS: $Id$

;; This file is part of XWEM.

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

;; XWEM 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 XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; Generic managing model.

;;; Code:

(require 'xwem-load)
(require 'xwem-manage)

;;; Customisation
(defgroup xwem-clgen nil
  "Group to customise management of generic clients."
  :prefix "xwem-clgen-"
  :group 'xwem-modes)

(defcustom xwem-clgen-other-strategy 'samewin
  "*Strategy used when searching for other client in window.
Possible values are:
  
  `samewin'   - Search for client managed in window.

  `sameframe-nonactive' - Search for nonactive client managed
                          in window's frame.

  `sameframe-any'       - Search for any client managed in window's
                          frame.

  `samemanda-nonactive' - Search for any nonactive client with same
                          manage entry as other client.

  `any-nonactive'       - Search for any nonactive client."
  :type '(choice (const :tag "Same Window" samewin)
                 (const :tag "Inactive in same frame" sameframe-nonactive)
                 (const :tag "Any in same frame" sameframe-any)
                 (const :tag "Inactive with same manda" samemanda-nonactive)
                 (const :tag "Any inactive" any-nonactive))
  :group 'xwem-clgen)

(defcustom xwem-clgen-other-on-split t
  "*Non-nil mean activate client in other window when doing window split."
  :type 'boolean
  :group 'xwem-clgen)

(defcustom xwem-clgen-other-split-type 'vertical
  "*Split type."
  :type '(choice (const :tag "Vertical" vertical)
                 (const :tag "Horizontal" horizontal))
  :group 'xwem-clgen)

(defcustom xwem-clgen-activate-new t
  "*Non-nil mean newly managed generic clients are activated in their windows."
  :type 'boolean
  :group 'xwem-clgen)

(defcustom xwem-clgen-select-new t
  "*Non-nil mean, select new clients managed in selected window.
This value overrides `xwem-clgen-activate-new' if window is selected."
  :type 'boolean
  :group 'xwem-clgen)

(defcustom xwem-clgen-allow-make-frame t
  "*Non-nil mean, clgen permited to make frame if there no frame where client can be managed."
  :type 'boolean
  :group 'xwem-clgen)

;;; Internal variables

;;;###autoload
(defvar xwem-clgen-map 
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "H-c H-o") 'xwem-clgen-toggle-other-on-split)
    map)
  "Local keymap for generic clients.")

;;; Macros
(defmacro xwem-cl-xparent (cl)
  `(xwem-cl-get-sys-prop ,cl 'parent-xwin))
(defsetf xwem-cl-xparent (cl) (parent)
  `(xwem-cl-put-sys-prop ,cl 'parent-xwin ,parent))

(defun xwem-clgen-other-client (cl &optional clients-list visible)
  "Search client other then CL in CLIENTS-LIST.
Default CLIENTS-LIST is win's clients where CL managed.
Note that at least one CL or CLIENTS-LIST should be non-nil, otherwise
nil will be returned."
  (when (or (and (xwem-cl-p cl) (xwem-win-p (xwem-cl-win cl)))
            clients-list)
    ;; XXX 
    (unless clients-list
      (setq clients-list (xwem-win-clients (xwem-cl-win cl))))
      
    ;; XXX sort clients by recency
    (setq clients-list
          (xwem-cl-list-sort-by-recency clients-list))

    (let (rcl notgoodcl)
      (while clients-list
        (when (and (not (eq (car clients-list) cl)) ; skip ourself
		   (not (eq (xwem-cl-state (car clients-list)) 'iconified))) ; skip iconfied
          (if (and (not (xwem-dummy-client-p (car clients-list))) ; exclude dummy clients
                   (or visible (not (xwem-win-cl-current-p (car clients-list)))))
              (progn
                (setq rcl (car clients-list))
                (setq clients-list nil))

            (when (and visible (null notgoodcl))
              (setq notgoodcl (car clients-list)))))
        (setq clients-list (cdr clients-list)))
    
      (or rcl notgoodcl))))

(define-xwem-deffered xwem-clgen-activate-other (cl win)
  "Activate other client in WIN.
Clients list is either WIN's clients list or CL's win clients list if
WIN's clients list is empty."
  (when (and (xwem-win-alive-p win)
             (not (xwem-cl-alive-p (xwem-win-cl win))))
    ;; WIN is valid and no clients yet managed in WIN
    (let ((ocl (xwem-clgen-other-client cl (xwem-win-clients win)))
          (need-select (or (and (xwem-cl-selected-p cl)
                                (not (xwem-cl-active-p cl)))
                           (xwem-cl-selected-p (xwem-dummy-client)))))
      (when (xwem-cl-alive-p ocl)
        (xwem-win-set-cl win ocl)
        (when (and (xwem-win-selected-p win) need-select)
          (xwem-select-client ocl)))

      ;; If OCL wasnt selected, try last or other client
      (when (and (xwem-win-selected-p win)
                 (not (xwem-cl-selected-p ocl))
                 need-select)
        (setq ocl (xwem-clgen-other-client
                   cl (xwem-frame-clients (xwem-win-frame win)) t))
        (if (xwem-cl-alive-p ocl)
            (xwem-select-client ocl)
          (xwem-select-some-client))))))
  
(defun xwem-clgen-other-on-split (sp-win nwin)
  "NWIN has been created as a result of split.
Probably we want to manage some client in newly created window."
  (xwem-clgen-activate-other (xwem-cl-selected) nwin))

;;; Othen-on-Split commands

;;;###autoload(autoload 'xwem-clgen-turn-on-other-on-split "xwem-clgen" "" t)
(define-xwem-command xwem-clgen-turn-on-other-on-split ()
  "Turn on `xwem-clgen-other-on-split' minor mode."
  (xwem-interactive)

  (setq xwem-clgen-other-on-split t)
  (add-hook 'xwem-win-split-hook 'xwem-clgen-other-on-split)

  (xwem-message 'info "Other on split minor mode is ON."))

;;;###autoload(autoload 'xwem-clgen-turn-off-other-on-split "xwem-clgen" "" t)
(define-xwem-command xwem-clgen-turn-off-other-on-split ()
  "Turn off `xwem-clgen-other-on-split' minor mode."
  (xwem-interactive)

  (setq xwem-clgen-other-on-split nil)
  (remove-hook 'xwem-win-split-hook 'xwem-clgen-other-on-split)

  (xwem-message 'info "Other on split minor mode is OFF."))

;;;###autoload(autoload 'xwem-clgen-toggle-other-on-split "xwem-clgen" "" t)
(define-xwem-command xwem-clgen-toggle-other-on-split (arg)
  "Toggle `xwem-clgen-other-on-split' minor mode.
Negative ARG turns it off, positive turns it on."
  (xwem-interactive "P")

  (if (numberp arg)
      (if (> arg 0)
	  (setq xwem-clgen-other-on-split nil)
	(setq xwem-clgen-other-on-split t)))

  (if xwem-clgen-other-on-split
      (xwem-clgen-turn-off-other-on-split)
    (xwem-clgen-turn-on-other-on-split)))

;;; Initialisation stuff
(defun xwem-clgen-init ()
  "Initialise clgen stuff."
  (xwem-message 'init "Initializing generic clients ...")

  (add-hook 'xwem-win-split-hook 'xwem-clgen-other-on-split)

  (xwem-message 'init "Initializing generic clients ... done"))

;;;; ---- Generic methods ----
(define-xwem-client-property expect-win generic
  "Expectance window."
  :type 'window
  :get 'xwem-cl-get-sys-prop
  :set 'xwem-cl-put-sys-prop)

;;;###autoload
(defun xwem-manage-generic (cl)
  "Manage method for generic clients."

  ;; Put this to notify `xwem-manage' that we will handle initial
  ;; state.
  (xwem-client-set-property cl 'skip-initial-state t)

  (let ((dwin (and (xwem-cl-was-expected-p cl)
                   (xwem-client-property cl 'expect-win))))
    (if dwin
        (xwem-client-set-property cl 'expect-win nil)
      (if (xwem-frame-alive-p (xwem-frame-selected))
          (setq dwin (xwem-win-selected))
        (when xwem-clgen-allow-make-frame
          ;; Selected window is kinda dead
          (xwem-frame-fit-screen (xwem-make-frame-1 'desktop))
          (setq dwin (xwem-win-selected)))))

    (unless (xwem-win-alive-p dwin)
      (error 'xwem-error "Can't manage in dead window"))

    ;; Create parent window.
    ;; NOTE:
    ;;   Some applications, such as mozilla, when running with
    ;;   -remote tries to find another mozilla instance to run
    ;;   in it, it seaches lowerest client, but it is not
    ;;   guarantied, because xwem frame holds many clients.
    (unless (xwem-cl-xparent cl)
      (setf (xwem-cl-xparent cl)
            (XCreateWindow (xwem-dpy) nil 0 0 1 1 0 nil nil nil
                           (make-X-Attr :override-redirect t :event-mask 0.0))))

    ;; Set CL's window
    (xwem-cl-set-win cl dwin)

    ;; Install local keymap
    (xwem-use-local-map xwem-clgen-map cl)

    ;; Select newly managed client, if needed
    (if (eql (xwem-cl-get-init-state cl) X-IconicState)
        (xwem-iconify cl)

      (when xwem-clgen-activate-new
        (xwem-win-set-cl (xwem-cl-win cl) cl))
      (when (and xwem-clgen-select-new
                 (xwem-win-selected-p dwin))
        (xwem-win-set-cl (xwem-cl-win cl) cl)
        (xwem-select-client cl)))
    ))

(defun xwem-clgen-refit (cl)
  "Refit generic client CL."
  (let* ((xwem-win (xwem-cl-win cl))
         (hthi (xwem-win-border-width xwem-win)))
    (when (and (xwem-cl-new-xgeom cl)
               (X-Geom-border-width (xwem-cl-new-xgeom cl)))
      ;; Border width changed
      (setf (X-Geom-border-width (xwem-cl-xgeom cl))
            (X-Geom-border-width (xwem-cl-new-xgeom cl))))

    (xwem-cl-correct-size-for-size cl
       (make-X-Geom :x (+ (xwem-win-x xwem-win) hthi)
                    :y (+ (xwem-win-y xwem-win) hthi)
                    :width (- (xwem-win-width xwem-win) (* 2 hthi))
                    :height (- (xwem-win-height xwem-win) (* 2 hthi))
                    :border-width (X-Geom-border-width (xwem-cl-xgeom cl))))))
  
(defun xwem-refit-generic (cl)
  "Refit method for generic client CL.
Correct CL geometry to fit into CL's window."
  (xwem-clgen-refit cl)
  (xwem-cl-apply-xgeom cl))

(define-xwem-deffered xwem-clgen-apply-state (cl)
  "Apply CL's state to life for generic client CL."
  (when (and (xwem-cl-p cl)
             (eq (xwem-cl-manage-type cl) 'generic))
    (cond ((eq (xwem-cl-state cl) 'active)
           (xwem-clgen-refit cl)
           (when (xwem-cl-frame cl)
             (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl)
                              (xwem-frame-xwin (xwem-cl-frame cl))
                              (X-Geom-x (xwem-cl-xgeom cl))
                              (X-Geom-y (xwem-cl-xgeom cl))))
           (xwem-cl-apply-xgeom-1 cl)
           (XLowerWindow (xwem-dpy) (xwem-cl-xwin cl))
           (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)))

          ((eq (xwem-cl-state cl) 'inactive)
           (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl) (xwem-cl-xparent cl) 0 0)
           (XLowerWindow (xwem-dpy) (xwem-cl-xwin cl))
           (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl)))

          ((eq (xwem-cl-state cl) 'iconified)
           (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl) (xwem-cl-xparent cl) 0 0)
           (XLowerWindow (xwem-dpy) (xwem-cl-xwin cl))
           (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl))))
    ))

(defun xwem-activate-generic (cl &optional type)
  "Activate method for CL."
  (cond ((eq type 'select)
         (xwem-select-window (xwem-cl-win cl)))

        ((eq type 'activate)
         (cond ((xwem-win-cl-current-p cl)
                (xwem-clgen-apply-state cl))

               ((xwem-win-alive-p (xwem-cl-win cl))
                (xwem-client-change-state cl 'inactive)
                (xwem-win-set-cl (xwem-cl-win cl) cl))))))

(defun xwem-deactivate-generic (cl &optional type)
  "Deactivate method for generic client CL."
  (cond ((eq type 'deactivate)
         (xwem-clgen-activate-other cl (xwem-cl-win cl))
         (xwem-clgen-apply-state cl))))

(defun xwem-iconify-generic (cl)
  "Iconify method for generic client CL."
  (xwem-win-rem-cl (xwem-cl-win cl) cl))

(defun xwem-withdraw-generic (cl)
  "Withdraw method for generic client CL."
  (let ((win (xwem-cl-win cl)))
    (when win
      (xwem-win-rem-cl win cl)
      (xwem-cl-set-win cl nil)

      ;; Activate other client in CL's window WIN
      ;; NOTE: Deffered
      (xwem-clgen-activate-other nil win))))

;;; Additional methods
(define-xwem-method on-type-change generic (cl &optional new)
  "Called when CL is about to change manda from generic."
  (xwem-cl-set-win cl nil))

(define-xwem-method on-kill generic (cl)
  "Called when CL is killed."
  (let ((win (xwem-cl-win cl)))
    ;; Destroy parent window
    (when (xwem-cl-xparent cl)
;; This XDestroyWindow causes some problems
;      (XDestroyWindow (xwem-dpy) (xwem-cl-xparent cl))
      (setf (xwem-cl-xparent cl) nil))

    ;; Activate other client in WIN
    (xwem-clgen-activate-other cl win)

    ;; Remove CL from WIN's clients list
    (when (xwem-win-alive-p win)
      (xwem-win-rem-cl win cl))
    ))

(define-xwem-method other-client generic (cl)
  "Method to return xwem generic client other then CL."
  (xwem-clgen-other-client cl))


(provide 'xwem-clgen)

;;;; On-load actions:
;; Register generic manage type.  Use APPEND because 'generic manage
;; type is most non-privileged and matches any client.
(define-xwem-manage-model generic
  "Generic manage model.
Manage clients that no-one elso wants to manage."
  :match-spec '(eval t)
  :append t

  :manage-method 'xwem-manage-generic
  :activate-method 'xwem-activate-generic
  :deactivate-method 'xwem-deactivate-generic
  :refit-method 'xwem-refit-generic
  :iconify-method 'xwem-iconify-generic
  :withdraw-method 'xwem-withdraw-generic)

(if xwem-started
    (xwem-clgen-init)
  (add-hook 'xwem-before-init-wins-hook 'xwem-clgen-init))

;;; xwem-clgen.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.