Mercurial > hg > xemacs-beta

comparison lisp/modes/view-process-xemacs.el @ 165:5a88923fcbfe r20-3b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b9
author cvs
date Mon, 13 Aug 2007 09:44:42 +0200
parents
children 41ff10fd062f
comparison
equal deleted inserted replaced
164:4e0740e5aab2 165:5a88923fcbfe
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.