--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/modes/view-process-xemacs.el	Mon Aug 13 09:44:42 2007 +0200
@@ -0,0 +1,474 @@
+;;; view-process-xemacs.el --- XEmacs specific code for view-process
+
+;; Copyright (C) 1995, 1996 Heiko Muenkel
+
+;; AUthor: Heiko Muenkel
+;; Keywords: processes
+
+;; This file is part of XEmacs.
+
+;;  XEmacs 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.
+
+;;  XEmacs 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:  Emacs 20.1
+
+;;; Commentary:
+
+;;	This file contains lisp code, which works only in the XEmacs.
+
+;; Installation: 
+
+;;	Put this file in one of your lisp load directories.
+;;
+
+;;; Code:
+
+(provide 'view-process-xemacs)
+
+;;; variables
+
+(defvar View-process-itimer-name "view-process"
+  "Name of the view process itimer.")
+
+
+;;; special keybindings
+
+(define-key View-process-mode-map '(button2) 'View-process-mouse-kill)
+(define-key View-process-mode-map '(button3) 'View-process-popup-menu)
+
+
+;;; menus
+
+(if (not View-process-pulldown-menu)
+    (setq
+     View-process-pulldown-menu
+     '("View-process-pulldown-menu-name"
+       ["Rename Buffer" View-process-rename-current-output-buffer t]
+       ["Submit Bug Report" View-process-submit-bug-report t]
+       ["Quit" View-process-quit t]
+       ("Options"
+	["Truncate Lines" 
+	 View-process-toggle-truncate-lines 
+	 :style toggle
+	 :selected truncate-lines]
+	["Motion Help"
+	 View-process-toggle-motion-help
+	 :style toggle
+	 :selected View-process-motion-help]
+	["Two Windows"
+	 View-process-toggle-display-with-2-windows
+	 :style toggle
+	 :selected View-process-display-with-2-windows]
+	["Hide Header"
+	 View-process-toggle-hide-header
+	 :style toggle
+	 :selected View-process-hide-header
+	 :active View-process-display-with-2-windows]
+	["Digits Send Signals"
+	 View-process-toggle-digit-bindings
+	 :style toggle
+	 :selected View-process-digit-bindings-send-signal]
+	)
+       )))
+
+
+(if (not View-process-region-menu)
+    (setq 
+     View-process-region-menu
+     '("PS Region Menu"
+       ["View Processes" view-processes nil]
+       ["New PS" View-process-status nil]
+       ["Update" View-process-status-update nil]
+       ("Periodic Output"
+	["Start " 
+	 View-process-start-itimer 
+	 :style radio 
+	 :selected (not (get-itimer View-process-itimer-name))
+	 :active nil]	
+	["Stop" 
+	 View-process-delete-itimer 
+	 :style radio 
+	 :selected (get-itimer View-process-itimer-name)
+	 :active nil]
+	)
+       ("Send Signal"
+	["SIGHUP" 
+	 (View-process-send-signal-to-processes-in-region "SIGHUP") t]
+	["SIGTERM" 
+	 (View-process-send-signal-to-processes-in-region "SIGTERM") t]
+	["SIGKILL" 
+	 (View-process-send-signal-to-processes-in-region "SIGKILL") t]
+	["SIGSTOP" 
+	 (View-process-send-signal-to-processes-in-region "SIGSTOP") t]
+	["SIGCONT" 
+	 (View-process-send-signal-to-processes-in-region "SIGCONT") t]
+	["SIGQUIT" 
+	 (View-process-send-signal-to-processes-in-region "SIGQUIT") t]
+	"----"
+	["Any Signal..." View-process-send-signal-to-processes-in-region t]
+	"----"
+	["Alter Priority..." View-process-renice-processes-in-region t]
+	)
+       ("Mark"
+	["Mark" View-process-mark-current-line nil]
+	["Mark Childs" View-process-mark-childs-in-current-line nil]
+	["Remark Last Marks" View-process-reset-last-marks nil]
+	"----"
+	["Unmark" View-process-unmark-current-line nil]
+	["Unmark All" View-process-unmark-all nil]
+	)
+       "----"
+       ["Sort" View-process-sort-region-by-current-field (looking-at "[^ ]")]
+       ["Reverse" View-process-reverse-region t]
+       ["Field Filter..." 
+	View-process-filter-region-by-current-field 
+	(looking-at "[^ ]")]
+       ["Exlude Field Filter..." 
+	(progn (setq current-prefix-arg '(-1))
+	       (call-interactively 
+		'View-process-filter-region-by-current-field))
+	:keys "C-u -1 M-c f"
+	:active (looking-at "[^ ]")]	    
+       ["Line Filter..." View-process-filter-region t]
+       ["Exclude Line Filter..." 
+	(progn (setq current-prefix-arg '(-1))
+	       (call-interactively 
+		'View-process-filter-region))
+	:keys "C-u -1 M-c g"
+	:active t]
+       "----"
+       ("Help"
+	["PID and Command" View-process-show-pid-and-command nil]
+	["Field Name" View-process-which-field-name nil]
+	["Header Line" View-process-show-header-line nil]
+	["Own PID" View-process-display-emacs-pid nil]
+	)
+       )
+     )
+  )
+
+(if (not View-process-marked-menu)
+    (setq 
+     View-process-marked-menu
+     '("PS Marked Menu"
+       ["View Processes" view-processes t]
+       ["New PS" View-process-status t]
+       ["Update" View-process-status-update t]
+       ("Periodic Output"
+	["Start " 
+	 View-process-start-itimer 
+	 :style radio 
+	 :selected (not (get-itimer View-process-itimer-name))
+	 :active nil]
+	["Stop" 
+	 View-process-delete-itimer 
+	 :style radio 
+	 :selected (get-itimer View-process-itimer-name)
+	 :active nil]
+	)
+       ("Send Signal"
+	["SIGHUP" (View-process-send-signal-to-processes-with-mark "SIGHUP") t]
+	["SIGTERM" 
+	 (View-process-send-signal-to-processes-with-mark "SIGTERM") 
+	 t]
+	["SIGKILL" 
+	 (View-process-send-signal-to-processes-with-mark "SIGKILL") 
+	 t]
+	["SIGSTOP" 
+	 (View-process-send-signal-to-processes-with-mark "SIGSTOP") 
+	 t]
+	["SIGCONT" 
+	 (View-process-send-signal-to-processes-with-mark "SIGCONT") 
+	 t]
+	["SIGQUIT" 
+	 (View-process-send-signal-to-processes-with-mark "SIGQUIT") 
+	 t]
+	"----"
+	["Any Signal..." View-process-send-signal-to-processes-with-mark t]
+	"----"
+	["Alter Priority..." View-process-renice-processes-with-mark t]
+	)
+       ("Mark"
+	["Mark" View-process-mark-current-line t]
+	["Mark Childs" View-process-mark-childs-in-current-line t]
+	["Remark Last Marks" View-process-reset-last-marks t]
+	"----"
+	["Unmark" View-process-unmark-current-line t]
+	["Unmark All" View-process-unmark-all t]
+	)
+       "----"
+       ["Sort" View-process-sort-output-by-current-field (looking-at "[^ ]")]
+       ["Reverse" View-process-reverse-output t]
+       ["Field Filter..." 
+	View-process-filter-output-by-current-field (looking-at "[^ ]")]
+       ["Exlude Field Filter..." 
+	(progn (setq current-prefix-arg '(-1))
+	       (call-interactively 
+		'View-process-filter-output-by-current-field))
+	:keys "C-u -1 F"
+	:active (looking-at "[^ ]")]	    
+       ["Line Filter..." View-process-filter-output t]
+       ["Exclude Line Filter..." 
+	(progn (setq current-prefix-arg '(-1))
+	       (call-interactively 
+		'View-process-filter-output))
+	:keys "C-u -1 G"
+	:active t]	    
+       "----"
+       ("Help"
+	["PID and Command" View-process-show-pid-and-command t]
+	["Field Name" View-process-which-field-name (looking-at "[^ ]")]
+	["Header Line" View-process-show-header-line t]
+	["Own PID" View-process-display-emacs-pid t]
+	)
+       )
+     )
+  )
+
+(if (not View-process-non-region-menu)
+    (setq 
+     View-process-non-region-menu
+     '("PS Non Region Menu"
+       ["View Processes" view-processes t]
+       ["New PS" View-process-status t]
+       ["Update" View-process-status-update t]
+       ("Periodic Output"
+	["Start " 
+	 View-process-start-itimer 
+	 :style radio 
+	 :selected (not (get-itimer View-process-itimer-name))]
+	["Stop" 
+	 View-process-delete-itimer 
+	 :style radio 
+	 :selected (get-itimer View-process-itimer-name)]
+	)
+       ("Send Signal"
+	["SIGHUP" (View-process-send-signal-to-process-in-line "SIGHUP") t]
+	["SIGTERM" (View-process-send-signal-to-process-in-line "SIGTERM") t]
+	["SIGKILL" (View-process-send-signal-to-process-in-line "SIGKILL") t]
+	["SIGSTOP" (View-process-send-signal-to-process-in-line "SIGSTOP") t]
+	["SIGCONT" (View-process-send-signal-to-process-in-line "SIGCONT") t]
+	["SIGQUIT" (View-process-send-signal-to-process-in-line "SIGQUIT") t]
+	"----"
+	["Any Signal..." View-process-send-signal-to-process-in-line t]
+	"----"
+	["Alter Priority..." View-process-renice-process-in-line t]
+	)
+       ("Mark"
+	["Mark" View-process-mark-current-line t]
+	["Mark Childs" View-process-mark-childs-in-current-line t]
+	["Remark Last Marks" View-process-reset-last-marks t]
+	"----"
+	["Unmark" View-process-unmark-current-line nil]
+	["Unmark All" View-process-unmark-all nil]
+	)
+       "----"
+       ["Sort" View-process-sort-output-by-current-field (looking-at "[^ ]")]
+       ["Reverse" View-process-reverse-output t]
+       ["Field Filter..." 
+	View-process-filter-output-by-current-field 
+	(looking-at "[^ ]")]
+       ["Exlude Field Filter..." 
+	(progn (setq current-prefix-arg '(-1))
+	       (call-interactively 
+		'View-process-filter-output-by-current-field))
+	:keys "C-u -1 F"
+	:active (looking-at "[^ ]")]	    
+       ["Line Filter..." View-process-filter-output t]
+       ["Exclude Line Filter..." 
+	(progn (setq current-prefix-arg '(-1))
+	       (call-interactively 
+		'View-process-filter-output))
+	:keys "C-u -1 G"
+	:active t]	    
+       "----"
+       ("Help"
+	["PID and Command" View-process-show-pid-and-command t]
+	["Field Name" View-process-which-field-name (looking-at "[^ ]")]
+	["Header Line" View-process-show-header-line t]
+	["Own PID" View-process-display-emacs-pid t]
+	)
+       )
+     )
+  )
+
+(defun View-process-popup-menu (event)
+  "Pops up a menu for the `View-process-mode'."
+  (interactive "e")
+  (mouse-set-point event)
+  (popup-menu
+   (cond ((View-process-region-active-p) View-process-region-menu)
+	 (View-process-pid-mark-alist View-process-marked-menu)
+	 (t View-process-non-region-menu))))
+
+(defun View-process-install-pulldown-menu ()
+  "Installs a pulldown menu for the `View-process-mode'."
+  (if (and current-menubar 
+	   (not (assoc View-process-pulldown-menu-name current-menubar)))
+      (progn
+	(set-buffer-menubar (copy-sequence current-menubar))
+	(add-submenu nil
+		     (cons View-process-pulldown-menu-name
+			   (cdr View-process-pulldown-menu)))
+	(add-submenu (list View-process-pulldown-menu-name)
+		     View-process-region-menu
+		     "Submit Bug Report")
+	(add-submenu (list View-process-pulldown-menu-name)
+		     View-process-marked-menu
+		     "Submit Bug Report")
+	(add-submenu (list View-process-pulldown-menu-name)
+		     View-process-non-region-menu
+		     "Submit Bug Report")
+	)))
+
+
+;;; mode motion
+
+(defun View-process-mode-motion-highlight-line (event)
+  "For use as the value of `mode-motion-hook' in the `View-process-mode'.
+It highlights the line under the mouse and displays help messages during
+mouse motion, if `View-process-motion-help' is non nil."
+  (if (and (event-point event)
+	   (> (event-point event) View-process-header-end))
+      (progn
+	(mode-motion-highlight-line event)
+	(if (and View-process-motion-help
+		 (not View-process-stop-motion-help))
+	    (save-excursion
+		(mouse-set-point event)
+		(View-process-show-pid-and-command-or-field-name)
+		)))
+    (message "")
+    ))
+
+(defun View-process-install-mode-motion ()
+  "Installs the `mode-motion-hook'."
+  (make-local-variable 'mode-motion-hook)
+  (setq mode-motion-hook 'View-process-mode-motion-highlight-line))
+
+(defun View-process-toggle-motion-help (&optional arg)
+  "Change whether a help message is displayed during mouse motion.
+With a positive ARG the variable 'View-process-motion-help' is set
+to t and with a negative ARG it is set to nil."
+  (interactive "P")
+  (if arg
+      (if (>= (prefix-numeric-value arg) 0)
+	  (setq View-process-motion-help t)
+	(setq View-process-motion-help nil))
+    (if View-process-motion-help
+	(setq View-process-motion-help nil)
+      (setq View-process-motion-help t))))
+
+; necessary for the Emacs 19
+(defalias 'View-process-insert-and-inherit 'insert)
+
+;;; timer functions
+
+(defun View-process-start-itimer ()
+  "Starts or restarts the itimer for updating the process output."
+  (interactive)
+  (if (get-itimer View-process-itimer-name)
+      (progn 
+	(set-itimer-value (get-itimer View-process-itimer-name) 
+			  View-process-itimer-value)
+	(set-itimer-restart (get-itimer View-process-itimer-name)
+			    View-process-itimer-value))
+    (start-itimer View-process-itimer-name
+		  'View-process-status-itimer-function
+		  View-process-itimer-value
+		  View-process-itimer-value)))
+
+(defun View-process-delete-itimer ()
+  "Stops (deletes) the view process itimer."
+  (interactive)
+  (if (get-itimer View-process-itimer-name)
+      (delete-itimer View-process-itimer-name)))
+
+
+;;; region
+
+(defun View-process-region-active-p ()
+  "Returns t, if a region is active.
+If `zmacs-regions' is nil, then this return always nil."
+  (if zmacs-regions
+      (mark)))
+
+
+;;; Misc
+
+(defun View-process-return-current-command-key-as-string ()
+  "Returns the key, which invokes the current command as string."
+  (events-to-keys (this-command-keys)))
+
+(defun View-process-redraw ()
+  "Dummy function. It does nothing in the XEmacs."
+  )
+
+
+;;; font-lock and colors
+
+(defun View-process-install-font-lock ()
+  "Installs the `font-lock-mode', if `View-process-use-font-lock' is t."
+  (if View-process-use-font-lock
+      (font-lock-mode 1)))
+
+(if (not (fboundp 'valid-color-name-p))
+    (defalias 'valid-color-name-p 'x-valid-color-name-p))
+
+(defun View-process-search-color-in-color-list (color-list)
+  "Searches a valid color in the COLOR-LIST."
+  (cond ((not color-list) nil)
+	((listp color-list)
+	 (if (valid-color-name-p (car color-list))
+	     (car color-list)
+	   (View-process-search-color-in-color-list (cdr color-list))))))
+
+(defun View-process-search-color (color)
+  "It returns a color, which could be displayed by the window manager.
+COLOR is either a string with a color or a list with possible
+colors."
+  (cond ((not color) nil)
+	((stringp color)
+	 (if (valid-color-name-p color) color nil))
+	((listp color)
+	 (View-process-search-color-in-color-list color))
+	(t nil)))
+  
+;;; missing function window-pixel-edges in XEmacs < 19.12
+;;; Attention: This emulation is only valid, to test if a value 
+;;; is 0 or not.
+(if (not (fboundp 'window-pixel-edges))
+    (defalias 'window-pixel-edges 'window-edges))
+
+
+;;; Modeline 
+
+(if (fboundp 'set-specifier)
+
+(defun view-process-switch-buffer-modeline (modeline-on)
+  "Switches the current modeline on, if MODELINE-ON is t.
+Otherwise the modeline is switched off."
+  (set-specifier has-modeline-p (cons (current-buffer) modeline-on)))
+
+
+(defun view-process-switch-buffer-modeline (modeline-on)
+  "Dummy function. 
+Sorry, the modeline can't be switched off in this emacs version.
+You have to update at least to XEmacs 19.12."
+  )
+
+)
+
+;;; view-process-xemacs.el ends here.