cgit.sxemacs.org Git - packages/blob - xemacs-packages/view-process/view-process-xemacs.el

   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 Children" View-process-mark-children-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        ["Exclude 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 Children" View-process-mark-children-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        ["Exclude 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 Children" View-process-mark-children-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        ["Exclude 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   "Pop up a menu for `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   "Install 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   "Install 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   "Start or restart 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   "Return 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   "Return 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 XEmacs."
 418   )
 419
 420
 421 ;;; font-lock and colors
 422
 423 (defun View-process-install-font-lock ()
 424   "Install `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   "Search 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   "Return a color, which can 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   "Switch 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.