home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / modes / view-process-xemacs.el.z / view-process-xemacs.el
Encoding:
Text File  |  1998-05-21  |  14.3 KB  |  476 lines
  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 (featurep 'menubar)
  319.        current-menubar 
  320.        (not (assoc View-process-pulldown-menu-name current-menubar)))
  321.       (progn
  322.     (set-buffer-menubar (copy-sequence current-menubar))
  323.     (add-submenu nil
  324.              (cons View-process-pulldown-menu-name
  325.                (cdr View-process-pulldown-menu)))
  326.     (add-submenu (list View-process-pulldown-menu-name)
  327.              View-process-region-menu
  328.              "Submit Bug Report")
  329.     (add-submenu (list View-process-pulldown-menu-name)
  330.              View-process-marked-menu
  331.              "Submit Bug Report")
  332.     (add-submenu (list View-process-pulldown-menu-name)
  333.              View-process-non-region-menu
  334.              "Submit Bug Report")
  335.     )))
  336.  
  337.  
  338. ;;; mode motion
  339.  
  340. (defun View-process-mode-motion-highlight-line (event)
  341.   "For use as the value of `mode-motion-hook' in the `View-process-mode'.
  342. It highlights the line under the mouse and displays help messages during
  343. mouse motion, if `View-process-motion-help' is non nil."
  344.   (if (and (event-point event)
  345.        (> (event-point event) View-process-header-end))
  346.       (progn
  347.     (mode-motion-highlight-line event)
  348.     (if (and View-process-motion-help
  349.          (not View-process-stop-motion-help))
  350.         (save-excursion
  351.         (mouse-set-point event)
  352.         (View-process-show-pid-and-command-or-field-name)
  353.         )))
  354.     (message "")
  355.     ))
  356.  
  357. (defun View-process-install-mode-motion ()
  358.   "Installs the `mode-motion-hook'."
  359.   (make-local-variable 'mode-motion-hook)
  360.   (setq mode-motion-hook 'View-process-mode-motion-highlight-line))
  361.  
  362. (defun View-process-toggle-motion-help (&optional arg)
  363.   "Change whether a help message is displayed during mouse motion.
  364. With a positive ARG the variable 'View-process-motion-help' is set
  365. to t and with a negative ARG it is set to nil."
  366.   (interactive "P")
  367.   (if arg
  368.       (if (>= (prefix-numeric-value arg) 0)
  369.       (setq View-process-motion-help t)
  370.     (setq View-process-motion-help nil))
  371.     (if View-process-motion-help
  372.     (setq View-process-motion-help nil)
  373.       (setq View-process-motion-help t))))
  374.  
  375. ; necessary for the Emacs 19
  376. (defalias 'View-process-insert-and-inherit 'insert)
  377.  
  378. ;;; timer functions
  379.  
  380. (defun View-process-start-itimer ()
  381.   "Starts or restarts the itimer for updating the process output."
  382.   (interactive)
  383.   (if (get-itimer View-process-itimer-name)
  384.       (progn 
  385.     (set-itimer-value (get-itimer View-process-itimer-name) 
  386.               View-process-itimer-value)
  387.     (set-itimer-restart (get-itimer View-process-itimer-name)
  388.                 View-process-itimer-value))
  389.     (start-itimer View-process-itimer-name
  390.           'View-process-status-itimer-function
  391.           View-process-itimer-value
  392.           View-process-itimer-value)))
  393.  
  394. (defun View-process-delete-itimer ()
  395.   "Stops (deletes) the view process itimer."
  396.   (interactive)
  397.   (if (get-itimer View-process-itimer-name)
  398.       (delete-itimer View-process-itimer-name)))
  399.  
  400.  
  401. ;;; region
  402.  
  403. (defun View-process-region-active-p ()
  404.   "Returns t, if a region is active.
  405. If `zmacs-regions' is nil, then this return always nil."
  406.   (if zmacs-regions
  407.       (mark)))
  408.  
  409.  
  410. ;;; Misc
  411.  
  412. (defun View-process-return-current-command-key-as-string ()
  413.   "Returns the key, which invokes the current command as string."
  414.   (events-to-keys (this-command-keys)))
  415.  
  416. (defun View-process-redraw ()
  417.   "Dummy function. It does nothing in the XEmacs."
  418.   )
  419.  
  420.  
  421. ;;; font-lock and colors
  422.  
  423. (defun View-process-install-font-lock ()
  424.   "Installs the `font-lock-mode', if `View-process-use-font-lock' is t."
  425.   (if View-process-use-font-lock
  426.       (font-lock-mode 1)))
  427.  
  428. (if (not (fboundp 'valid-color-name-p))
  429.     (defalias 'valid-color-name-p 'x-valid-color-name-p))
  430.  
  431. (defun View-process-search-color-in-color-list (color-list)
  432.   "Searches a valid color in the COLOR-LIST."
  433.   (cond ((not color-list) nil)
  434.     ((listp color-list)
  435.      (if (valid-color-name-p (car color-list))
  436.          (car color-list)
  437.        (View-process-search-color-in-color-list (cdr color-list))))))
  438.  
  439. (defun View-process-search-color (color)
  440.   "It returns a color, which could be displayed by the window manager.
  441. COLOR is either a string with a color or a list with possible
  442. colors."
  443.   (cond ((not color) nil)
  444.     ((stringp color)
  445.      (if (valid-color-name-p color) color nil))
  446.     ((listp color)
  447.      (View-process-search-color-in-color-list color))
  448.     (t nil)))
  449.   
  450. ;;; missing function window-pixel-edges in XEmacs < 19.12
  451. ;;; Attention: This emulation is only valid, to test if a value 
  452. ;;; is 0 or not.
  453. (if (not (fboundp 'window-pixel-edges))
  454.     (defalias 'window-pixel-edges 'window-edges))
  455.  
  456.  
  457. ;;; Modeline 
  458.  
  459. (if (fboundp 'set-specifier)
  460.  
  461. (defun view-process-switch-buffer-modeline (modeline-on)
  462.   "Switches the current modeline on, if MODELINE-ON is t.
  463. Otherwise the modeline is switched off."
  464.   (set-specifier has-modeline-p (cons (current-buffer) modeline-on)))
  465.  
  466.  
  467. (defun view-process-switch-buffer-modeline (modeline-on)
  468.   "Dummy function. 
  469. Sorry, the modeline can't be switched off in this emacs version.
  470. You have to update at least to XEmacs 19.12."
  471.   )
  472.  
  473. )
  474.  
  475. ;;; view-process-xemacs.el ends here.
  476.