|
165
|
1 ;;; view-process-xemacs.el --- XEmacs specific code for view-process
|
|
|
2
|
|
|
3 ;; Copyright (C) 1995, 1996 Heiko Muenkel
|
|
|
4
|
|
|
5 ;; AUthor: Heiko Muenkel
|
|
|
6 ;; Keywords: processes
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your
|
|
|
13 ;; option) any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;; 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: Emacs 20.1
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; This file contains lisp code, which works only in the XEmacs.
|
|
|
30
|
|
|
31 ;; Installation:
|
|
|
32
|
|
|
33 ;; Put this file in one of your lisp load directories.
|
|
|
34 ;;
|
|
|
35
|
|
|
36 ;;; Code:
|
|
|
37
|
|
|
38 (provide 'view-process-xemacs)
|
|
|
39
|
|
|
40 ;;; variables
|
|
|
41
|
|
|
42 (defvar View-process-itimer-name "view-process"
|
|
|
43 "Name of the view process itimer.")
|
|
|
44
|
|
|
45
|
|
|
46 ;;; special keybindings
|
|
|
47
|
|
|
48 (define-key View-process-mode-map '(button2) 'View-process-mouse-kill)
|
|
|
49 (define-key View-process-mode-map '(button3) 'View-process-popup-menu)
|
|
|
50
|
|
|
51
|
|
|
52 ;;; menus
|
|
|
53
|
|
|
54 (if (not View-process-pulldown-menu)
|
|
|
55 (setq
|
|
|
56 View-process-pulldown-menu
|
|
|
57 '("View-process-pulldown-menu-name"
|
|
|
58 ["Rename Buffer" View-process-rename-current-output-buffer t]
|
|
|
59 ["Submit Bug Report" View-process-submit-bug-report t]
|
|
|
60 ["Quit" View-process-quit t]
|
|
|
61 ("Options"
|
|
|
62 ["Truncate Lines"
|
|
|
63 View-process-toggle-truncate-lines
|
|
|
64 :style toggle
|
|
|
65 :selected truncate-lines]
|
|
|
66 ["Motion Help"
|
|
|
67 View-process-toggle-motion-help
|
|
|
68 :style toggle
|
|
|
69 :selected View-process-motion-help]
|
|
|
70 ["Two Windows"
|
|
|
71 View-process-toggle-display-with-2-windows
|
|
|
72 :style toggle
|
|
|
73 :selected View-process-display-with-2-windows]
|
|
|
74 ["Hide Header"
|
|
|
75 View-process-toggle-hide-header
|
|
|
76 :style toggle
|
|
|
77 :selected View-process-hide-header
|
|
|
78 :active View-process-display-with-2-windows]
|
|
|
79 ["Digits Send Signals"
|
|
|
80 View-process-toggle-digit-bindings
|
|
|
81 :style toggle
|
|
|
82 :selected View-process-digit-bindings-send-signal]
|
|
|
83 )
|
|
|
84 )))
|
|
|
85
|
|
|
86
|
|
|
87 (if (not View-process-region-menu)
|
|
|
88 (setq
|
|
|
89 View-process-region-menu
|
|
|
90 '("PS Region Menu"
|
|
|
91 ["View Processes" view-processes nil]
|
|
|
92 ["New PS" View-process-status nil]
|
|
|
93 ["Update" View-process-status-update nil]
|
|
|
94 ("Periodic Output"
|
|
|
95 ["Start "
|
|
|
96 View-process-start-itimer
|
|
|
97 :style radio
|
|
|
98 :selected (not (get-itimer View-process-itimer-name))
|
|
|
99 :active nil]
|
|
|
100 ["Stop"
|
|
|
101 View-process-delete-itimer
|
|
|
102 :style radio
|
|
|
103 :selected (get-itimer View-process-itimer-name)
|
|
|
104 :active nil]
|
|
|
105 )
|
|
|
106 ("Send Signal"
|
|
|
107 ["SIGHUP"
|
|
|
108 (View-process-send-signal-to-processes-in-region "SIGHUP") t]
|
|
|
109 ["SIGTERM"
|
|
|
110 (View-process-send-signal-to-processes-in-region "SIGTERM") t]
|
|
|
111 ["SIGKILL"
|
|
|
112 (View-process-send-signal-to-processes-in-region "SIGKILL") t]
|
|
|
113 ["SIGSTOP"
|
|
|
114 (View-process-send-signal-to-processes-in-region "SIGSTOP") t]
|
|
|
115 ["SIGCONT"
|
|
|
116 (View-process-send-signal-to-processes-in-region "SIGCONT") t]
|
|
|
117 ["SIGQUIT"
|
|
|
118 (View-process-send-signal-to-processes-in-region "SIGQUIT") t]
|
|
|
119 "----"
|
|
|
120 ["Any Signal..." View-process-send-signal-to-processes-in-region t]
|
|
|
121 "----"
|
|
|
122 ["Alter Priority..." View-process-renice-processes-in-region t]
|
|
|
123 )
|
|
|
124 ("Mark"
|
|
|
125 ["Mark" View-process-mark-current-line nil]
|
|
|
126 ["Mark Childs" View-process-mark-childs-in-current-line nil]
|
|
|
127 ["Remark Last Marks" View-process-reset-last-marks nil]
|
|
|
128 "----"
|
|
|
129 ["Unmark" View-process-unmark-current-line nil]
|
|
|
130 ["Unmark All" View-process-unmark-all nil]
|
|
|
131 )
|
|
|
132 "----"
|
|
|
133 ["Sort" View-process-sort-region-by-current-field (looking-at "[^ ]")]
|
|
|
134 ["Reverse" View-process-reverse-region t]
|
|
|
135 ["Field Filter..."
|
|
|
136 View-process-filter-region-by-current-field
|
|
|
137 (looking-at "[^ ]")]
|
|
|
138 ["Exlude Field Filter..."
|
|
|
139 (progn (setq current-prefix-arg '(-1))
|
|
|
140 (call-interactively
|
|
|
141 'View-process-filter-region-by-current-field))
|
|
|
142 :keys "C-u -1 M-c f"
|
|
|
143 :active (looking-at "[^ ]")]
|
|
|
144 ["Line Filter..." View-process-filter-region t]
|
|
|
145 ["Exclude Line Filter..."
|
|
|
146 (progn (setq current-prefix-arg '(-1))
|
|
|
147 (call-interactively
|
|
|
148 'View-process-filter-region))
|
|
|
149 :keys "C-u -1 M-c g"
|
|
|
150 :active t]
|
|
|
151 "----"
|
|
|
152 ("Help"
|
|
|
153 ["PID and Command" View-process-show-pid-and-command nil]
|
|
|
154 ["Field Name" View-process-which-field-name nil]
|
|
|
155 ["Header Line" View-process-show-header-line nil]
|
|
|
156 ["Own PID" View-process-display-emacs-pid nil]
|
|
|
157 )
|
|
|
158 )
|
|
|
159 )
|
|
|
160 )
|
|
|
161
|
|
|
162 (if (not View-process-marked-menu)
|
|
|
163 (setq
|
|
|
164 View-process-marked-menu
|
|
|
165 '("PS Marked Menu"
|
|
|
166 ["View Processes" view-processes t]
|
|
|
167 ["New PS" View-process-status t]
|
|
|
168 ["Update" View-process-status-update t]
|
|
|
169 ("Periodic Output"
|
|
|
170 ["Start "
|
|
|
171 View-process-start-itimer
|
|
|
172 :style radio
|
|
|
173 :selected (not (get-itimer View-process-itimer-name))
|
|
|
174 :active nil]
|
|
|
175 ["Stop"
|
|
|
176 View-process-delete-itimer
|
|
|
177 :style radio
|
|
|
178 :selected (get-itimer View-process-itimer-name)
|
|
|
179 :active nil]
|
|
|
180 )
|
|
|
181 ("Send Signal"
|
|
|
182 ["SIGHUP" (View-process-send-signal-to-processes-with-mark "SIGHUP") t]
|
|
|
183 ["SIGTERM"
|
|
|
184 (View-process-send-signal-to-processes-with-mark "SIGTERM")
|
|
|
185 t]
|
|
|
186 ["SIGKILL"
|
|
|
187 (View-process-send-signal-to-processes-with-mark "SIGKILL")
|
|
|
188 t]
|
|
|
189 ["SIGSTOP"
|
|
|
190 (View-process-send-signal-to-processes-with-mark "SIGSTOP")
|
|
|
191 t]
|
|
|
192 ["SIGCONT"
|
|
|
193 (View-process-send-signal-to-processes-with-mark "SIGCONT")
|
|
|
194 t]
|
|
|
195 ["SIGQUIT"
|
|
|
196 (View-process-send-signal-to-processes-with-mark "SIGQUIT")
|
|
|
197 t]
|
|
|
198 "----"
|
|
|
199 ["Any Signal..." View-process-send-signal-to-processes-with-mark t]
|
|
|
200 "----"
|
|
|
201 ["Alter Priority..." View-process-renice-processes-with-mark t]
|
|
|
202 )
|
|
|
203 ("Mark"
|
|
|
204 ["Mark" View-process-mark-current-line t]
|
|
|
205 ["Mark Childs" View-process-mark-childs-in-current-line t]
|
|
|
206 ["Remark Last Marks" View-process-reset-last-marks t]
|
|
|
207 "----"
|
|
|
208 ["Unmark" View-process-unmark-current-line t]
|
|
|
209 ["Unmark All" View-process-unmark-all t]
|
|
|
210 )
|
|
|
211 "----"
|
|
|
212 ["Sort" View-process-sort-output-by-current-field (looking-at "[^ ]")]
|
|
|
213 ["Reverse" View-process-reverse-output t]
|
|
|
214 ["Field Filter..."
|
|
|
215 View-process-filter-output-by-current-field (looking-at "[^ ]")]
|
|
|
216 ["Exlude Field Filter..."
|
|
|
217 (progn (setq current-prefix-arg '(-1))
|
|
|
218 (call-interactively
|
|
|
219 'View-process-filter-output-by-current-field))
|
|
|
220 :keys "C-u -1 F"
|
|
|
221 :active (looking-at "[^ ]")]
|
|
|
222 ["Line Filter..." View-process-filter-output t]
|
|
|
223 ["Exclude Line Filter..."
|
|
|
224 (progn (setq current-prefix-arg '(-1))
|
|
|
225 (call-interactively
|
|
|
226 'View-process-filter-output))
|
|
|
227 :keys "C-u -1 G"
|
|
|
228 :active t]
|
|
|
229 "----"
|
|
|
230 ("Help"
|
|
|
231 ["PID and Command" View-process-show-pid-and-command t]
|
|
|
232 ["Field Name" View-process-which-field-name (looking-at "[^ ]")]
|
|
|
233 ["Header Line" View-process-show-header-line t]
|
|
|
234 ["Own PID" View-process-display-emacs-pid t]
|
|
|
235 )
|
|
|
236 )
|
|
|
237 )
|
|
|
238 )
|
|
|
239
|
|
|
240 (if (not View-process-non-region-menu)
|
|
|
241 (setq
|
|
|
242 View-process-non-region-menu
|
|
|
243 '("PS Non Region Menu"
|
|
|
244 ["View Processes" view-processes t]
|
|
|
245 ["New PS" View-process-status t]
|
|
|
246 ["Update" View-process-status-update t]
|
|
|
247 ("Periodic Output"
|
|
|
248 ["Start "
|
|
|
249 View-process-start-itimer
|
|
|
250 :style radio
|
|
|
251 :selected (not (get-itimer View-process-itimer-name))]
|
|
|
252 ["Stop"
|
|
|
253 View-process-delete-itimer
|
|
|
254 :style radio
|
|
|
255 :selected (get-itimer View-process-itimer-name)]
|
|
|
256 )
|
|
|
257 ("Send Signal"
|
|
|
258 ["SIGHUP" (View-process-send-signal-to-process-in-line "SIGHUP") t]
|
|
|
259 ["SIGTERM" (View-process-send-signal-to-process-in-line "SIGTERM") t]
|
|
|
260 ["SIGKILL" (View-process-send-signal-to-process-in-line "SIGKILL") t]
|
|
|
261 ["SIGSTOP" (View-process-send-signal-to-process-in-line "SIGSTOP") t]
|
|
|
262 ["SIGCONT" (View-process-send-signal-to-process-in-line "SIGCONT") t]
|
|
|
263 ["SIGQUIT" (View-process-send-signal-to-process-in-line "SIGQUIT") t]
|
|
|
264 "----"
|
|
|
265 ["Any Signal..." View-process-send-signal-to-process-in-line t]
|
|
|
266 "----"
|
|
|
267 ["Alter Priority..." View-process-renice-process-in-line t]
|
|
|
268 )
|
|
|
269 ("Mark"
|
|
|
270 ["Mark" View-process-mark-current-line t]
|
|
|
271 ["Mark Childs" View-process-mark-childs-in-current-line t]
|
|
|
272 ["Remark Last Marks" View-process-reset-last-marks t]
|
|
|
273 "----"
|
|
|
274 ["Unmark" View-process-unmark-current-line nil]
|
|
|
275 ["Unmark All" View-process-unmark-all nil]
|
|
|
276 )
|
|
|
277 "----"
|
|
|
278 ["Sort" View-process-sort-output-by-current-field (looking-at "[^ ]")]
|
|
|
279 ["Reverse" View-process-reverse-output t]
|
|
|
280 ["Field Filter..."
|
|
|
281 View-process-filter-output-by-current-field
|
|
|
282 (looking-at "[^ ]")]
|
|
|
283 ["Exlude Field Filter..."
|
|
|
284 (progn (setq current-prefix-arg '(-1))
|
|
|
285 (call-interactively
|
|
|
286 'View-process-filter-output-by-current-field))
|
|
|
287 :keys "C-u -1 F"
|
|
|
288 :active (looking-at "[^ ]")]
|
|
|
289 ["Line Filter..." View-process-filter-output t]
|
|
|
290 ["Exclude Line Filter..."
|
|
|
291 (progn (setq current-prefix-arg '(-1))
|
|
|
292 (call-interactively
|
|
|
293 'View-process-filter-output))
|
|
|
294 :keys "C-u -1 G"
|
|
|
295 :active t]
|
|
|
296 "----"
|
|
|
297 ("Help"
|
|
|
298 ["PID and Command" View-process-show-pid-and-command t]
|
|
|
299 ["Field Name" View-process-which-field-name (looking-at "[^ ]")]
|
|
|
300 ["Header Line" View-process-show-header-line t]
|
|
|
301 ["Own PID" View-process-display-emacs-pid t]
|
|
|
302 )
|
|
|
303 )
|
|
|
304 )
|
|
|
305 )
|
|
|
306
|
|
|
307 (defun View-process-popup-menu (event)
|
|
|
308 "Pops up a menu for the `View-process-mode'."
|
|
|
309 (interactive "e")
|
|
|
310 (mouse-set-point event)
|
|
|
311 (popup-menu
|
|
|
312 (cond ((View-process-region-active-p) View-process-region-menu)
|
|
|
313 (View-process-pid-mark-alist View-process-marked-menu)
|
|
|
314 (t View-process-non-region-menu))))
|
|
|
315
|
|
|
316 (defun View-process-install-pulldown-menu ()
|
|
|
317 "Installs a pulldown menu for the `View-process-mode'."
|
|
|
318 (if (and current-menubar
|
|
|
319 (not (assoc View-process-pulldown-menu-name current-menubar)))
|
|
|
320 (progn
|
|
|
321 (set-buffer-menubar (copy-sequence current-menubar))
|
|
|
322 (add-submenu nil
|
|
|
323 (cons View-process-pulldown-menu-name
|
|
|
324 (cdr View-process-pulldown-menu)))
|
|
|
325 (add-submenu (list View-process-pulldown-menu-name)
|
|
|
326 View-process-region-menu
|
|
|
327 "Submit Bug Report")
|
|
|
328 (add-submenu (list View-process-pulldown-menu-name)
|
|
|
329 View-process-marked-menu
|
|
|
330 "Submit Bug Report")
|
|
|
331 (add-submenu (list View-process-pulldown-menu-name)
|
|
|
332 View-process-non-region-menu
|
|
|
333 "Submit Bug Report")
|
|
|
334 )))
|
|
|
335
|
|
|
336
|
|
|
337 ;;; mode motion
|
|
|
338
|
|
|
339 (defun View-process-mode-motion-highlight-line (event)
|
|
|
340 "For use as the value of `mode-motion-hook' in the `View-process-mode'.
|
|
|
341 It highlights the line under the mouse and displays help messages during
|
|
|
342 mouse motion, if `View-process-motion-help' is non nil."
|
|
|
343 (if (and (event-point event)
|
|
|
344 (> (event-point event) View-process-header-end))
|
|
|
345 (progn
|
|
|
346 (mode-motion-highlight-line event)
|
|
|
347 (if (and View-process-motion-help
|
|
|
348 (not View-process-stop-motion-help))
|
|
|
349 (save-excursion
|
|
|
350 (mouse-set-point event)
|
|
|
351 (View-process-show-pid-and-command-or-field-name)
|
|
|
352 )))
|
|
|
353 (message "")
|
|
|
354 ))
|
|
|
355
|
|
|
356 (defun View-process-install-mode-motion ()
|
|
|
357 "Installs the `mode-motion-hook'."
|
|
|
358 (make-local-variable 'mode-motion-hook)
|
|
|
359 (setq mode-motion-hook 'View-process-mode-motion-highlight-line))
|
|
|
360
|
|
|
361 (defun View-process-toggle-motion-help (&optional arg)
|
|
|
362 "Change whether a help message is displayed during mouse motion.
|
|
|
363 With a positive ARG the variable 'View-process-motion-help' is set
|
|
|
364 to t and with a negative ARG it is set to nil."
|
|
|
365 (interactive "P")
|
|
|
366 (if arg
|
|
|
367 (if (>= (prefix-numeric-value arg) 0)
|
|
|
368 (setq View-process-motion-help t)
|
|
|
369 (setq View-process-motion-help nil))
|
|
|
370 (if View-process-motion-help
|
|
|
371 (setq View-process-motion-help nil)
|
|
|
372 (setq View-process-motion-help t))))
|
|
|
373
|
|
|
374 ; necessary for the Emacs 19
|
|
|
375 (defalias 'View-process-insert-and-inherit 'insert)
|
|
|
376
|
|
|
377 ;;; timer functions
|
|
|
378
|
|
|
379 (defun View-process-start-itimer ()
|
|
|
380 "Starts or restarts the itimer for updating the process output."
|
|
|
381 (interactive)
|
|
|
382 (if (get-itimer View-process-itimer-name)
|
|
|
383 (progn
|
|
|
384 (set-itimer-value (get-itimer View-process-itimer-name)
|
|
|
385 View-process-itimer-value)
|
|
|
386 (set-itimer-restart (get-itimer View-process-itimer-name)
|
|
|
387 View-process-itimer-value))
|
|
|
388 (start-itimer View-process-itimer-name
|
|
|
389 'View-process-status-itimer-function
|
|
|
390 View-process-itimer-value
|
|
|
391 View-process-itimer-value)))
|
|
|
392
|
|
|
393 (defun View-process-delete-itimer ()
|
|
|
394 "Stops (deletes) the view process itimer."
|
|
|
395 (interactive)
|
|
|
396 (if (get-itimer View-process-itimer-name)
|
|
|
397 (delete-itimer View-process-itimer-name)))
|
|
|
398
|
|
|
399
|
|
|
400 ;;; region
|
|
|
401
|
|
|
402 (defun View-process-region-active-p ()
|
|
|
403 "Returns t, if a region is active.
|
|
|
404 If `zmacs-regions' is nil, then this return always nil."
|
|
|
405 (if zmacs-regions
|
|
|
406 (mark)))
|
|
|
407
|
|
|
408
|
|
|
409 ;;; Misc
|
|
|
410
|
|
|
411 (defun View-process-return-current-command-key-as-string ()
|
|
|
412 "Returns the key, which invokes the current command as string."
|
|
|
413 (events-to-keys (this-command-keys)))
|
|
|
414
|
|
|
415 (defun View-process-redraw ()
|
|
|
416 "Dummy function. It does nothing in the XEmacs."
|
|
|
417 )
|
|
|
418
|
|
|
419
|
|
|
420 ;;; font-lock and colors
|
|
|
421
|
|
|
422 (defun View-process-install-font-lock ()
|
|
|
423 "Installs the `font-lock-mode', if `View-process-use-font-lock' is t."
|
|
|
424 (if View-process-use-font-lock
|
|
|
425 (font-lock-mode 1)))
|
|
|
426
|
|
|
427 (if (not (fboundp 'valid-color-name-p))
|
|
|
428 (defalias 'valid-color-name-p 'x-valid-color-name-p))
|
|
|
429
|
|
|
430 (defun View-process-search-color-in-color-list (color-list)
|
|
|
431 "Searches a valid color in the COLOR-LIST."
|
|
|
432 (cond ((not color-list) nil)
|
|
|
433 ((listp color-list)
|
|
|
434 (if (valid-color-name-p (car color-list))
|
|
|
435 (car color-list)
|
|
|
436 (View-process-search-color-in-color-list (cdr color-list))))))
|
|
|
437
|
|
|
438 (defun View-process-search-color (color)
|
|
|
439 "It returns a color, which could be displayed by the window manager.
|
|
|
440 COLOR is either a string with a color or a list with possible
|
|
|
441 colors."
|
|
|
442 (cond ((not color) nil)
|
|
|
443 ((stringp color)
|
|
|
444 (if (valid-color-name-p color) color nil))
|
|
|
445 ((listp color)
|
|
|
446 (View-process-search-color-in-color-list color))
|
|
|
447 (t nil)))
|
|
|
448
|
|
|
449 ;;; missing function window-pixel-edges in XEmacs < 19.12
|
|
|
450 ;;; Attention: This emulation is only valid, to test if a value
|
|
|
451 ;;; is 0 or not.
|
|
|
452 (if (not (fboundp 'window-pixel-edges))
|
|
|
453 (defalias 'window-pixel-edges 'window-edges))
|
|
|
454
|
|
|
455
|
|
|
456 ;;; Modeline
|
|
|
457
|
|
|
458 (if (fboundp 'set-specifier)
|
|
|
459
|
|
|
460 (defun view-process-switch-buffer-modeline (modeline-on)
|
|
|
461 "Switches the current modeline on, if MODELINE-ON is t.
|
|
|
462 Otherwise the modeline is switched off."
|
|
|
463 (set-specifier has-modeline-p (cons (current-buffer) modeline-on)))
|
|
|
464
|
|
|
465
|
|
|
466 (defun view-process-switch-buffer-modeline (modeline-on)
|
|
|
467 "Dummy function.
|
|
|
468 Sorry, the modeline can't be switched off in this emacs version.
|
|
|
469 You have to update at least to XEmacs 19.12."
|
|
|
470 )
|
|
|
471
|
|
|
472 )
|
|
|
473
|
|
|
474 ;;; view-process-xemacs.el ends here.
|
