-
Notifications
You must be signed in to change notification settings - Fork 0
/
ws-send-to.jl
146 lines (113 loc) · 5.16 KB
/
ws-send-to.jl
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
;;; ws-send-to.jl --- Workspace sending functions.
;; Copyright 1999,2000 by Dave Pearson <davep@davep.org>
;; $Revision: 1.9 $
;; ws-send-to.jl is free software distributed under the terms of the GNU
;; General Public Licence, version 2. For details see the file COPYING.
;;; Commentary:
;;
;; This sawfish <URL:http://sawmill.sourceforge.net/> module provides a
;; couple of functions that help modify the "Send window to" menu option in
;; the default `window-ops-menu' so that it offers a list of workspaces
;; alongside or instead of the usual next/previous options.
;;
;; To use this code simply drop it (or a compiled copy) into your load-path
;; and in your ~/.sawfishrc put:
;;
;; (require 'ws-send-to)
;;
;; After that you can control the actions of this code in the advanced
;; workspace section of the sawfish configuration manager.
;;; Thanks:
;;
;; Matt Kraai <kraai@ghs.com> for pointing out that the main function should
;; be added to `workspace-state-change-hook' to ensure that the menu is
;; always correct.
;;; Code:
;; Stuff we require.
(require 'menus) ; We need to ensure that
; `window-ops-menu' is defined.
;; Customise options.
(defgroup send-to "Send window to menu" :group workspace)
(defcustom ws-send-to-enabled nil
"Enable the explicit send-to menu?"
:type boolean
:group (workspace send-to)
:after-set (lambda () (ws-send-to)))
(defcustom ws-send-to-action 'replace
"How to add the explicit send-to menu."
:type symbol
:options (replace prepend append sub)
:group (workspace send-to)
:after-set (lambda () (ws-send-to)))
(defcustom ws-send-to-menu-prompt (_ "_Send window to")
"Text of the \"Send window to\" menu item."
:type string
:group (workspace send-to))
;; Non-customisable variables.
(defvar ws-send-to-original-menu nil
"The original send-to menu.")
;; Main code.
(defun ws-send-to-build-menu ()
"Build a send-to menu."
(letrec ((build-menu (lambda (ws)
(unless (zerop ws)
(cons (list (or (nth (1- ws) workspace-names)
(format nil (_ "Workspace %d") ws))
`(send-window-to-workspace-from-first
(current-event-window) ,(1- ws)))
(build-menu (1- ws)))))))
(reverse (build-menu (1+ (cdr (workspace-limits)))))))
(defun ws-send-to-set (thing)
"Set the \"Send window to\" menu to THING."
(let ((swt-menu (assoc ws-send-to-menu-prompt window-ops-menu)))
(when swt-menu
(setcdr swt-menu thing))))
(defun ws-send-to-replace-menu ()
"Make the \"Send window to\" menu item more explicit.
Calling this function modifies the \"Send window to\" menu so that it is a
list of workspaces. Selecting a workspace from that list sends the window to
that workspace.
Don't forget to set `workspace-names' to get meaningful menu options."
(ws-send-to-set (ws-send-to-build-menu)))
(defun ws-send-to-prepend-menu ()
"Prepend the explicit send-to options to the send-to menu.
Calling this function modifies the \"Send window to\" menu so that it begins
with a list of workspaces. Selecting a workspace from that list sends the
window to that workspace.
Don't forget to set `workspace-names' to get meaningful menu options."
(ws-send-to-set (append (ws-send-to-build-menu)
(list nil)
(cdr (copy-sequence ws-send-to-original-menu)))))
(defun ws-send-to-append-menu ()
"Append the explicit send-to options to the send-to menu.
Calling this function modifies the \"Send window to\" menu so that it ends
with a list of workspaces. Selecting a workspace from that list sends the
window to that workspace.
Don't forget to set `workspace-names' to get meaningful menu options."
(ws-send-to-set (append (cdr (copy-sequence ws-send-to-original-menu))
(list nil)
(ws-send-to-build-menu))))
(defun ws-send-to-sub-menu ()
"Add the explicit send-to options as a sub-menu of the send-to menu.
Calling this function modifies the \"Send window to\" menu so that it
contains a sub-menu which is a list of workspaces. Selecting a workspace
from that list sends the window to that workspace.
Don't forget to set `workspace-names' to get meaningful menu options."
(ws-send-to-set (append (cdr (copy-sequence ws-send-to-original-menu))
(list nil)
(list (cons (_ "Workspace") (ws-send-to-build-menu))))))
(defun ws-send-to-reset ()
"Reset the \"Send window to\" menu to its original value."
(when ws-send-to-original-menu
(ws-send-to-set (cdr ws-send-to-original-menu))))
(defun ws-send-to ()
(unless ws-send-to-original-menu
(let ((st-menu (assoc ws-send-to-menu-prompt window-ops-menu)))
(setq ws-send-to-original-menu (copy-sequence st-menu))))
(if ws-send-to-enabled
((symbol-value (intern (format nil "ws-send-to-%s-menu" ws-send-to-action))))
(ws-send-to-reset)))
;; Make sure the menu gets re-built if the workspace list changes.
(add-hook 'workspace-state-change-hook ws-send-to)
(provide 'ws-send-to)
;;; ws-send-to.el ends here