- (with-temp-buffer
- (condition-case nil
- (if (zerop (call-process
- proced-signal-function nil t nil
- signal (number-to-string (car process))))
- (setq count (1+ count))
- (proced-log (current-buffer))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures))
- (error ; catch errors from failed signals
- (proced-log (current-buffer))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures)))))))
- (if failures
- ;; Proced error message are not always very precise.
- ;; Can we issue a useful one-line summary in the
- ;; message area (using FAILURES) if only one signal failed?
- (proced-log-summary
- signal
- (format "%d of %d signal%s failed"
- (length failures) (length process-alist)
- (if (= 1 (length process-alist)) "" "s")))
- (proced-success-message "Sent signal to" count)))
- ;; final clean-up
- (run-hooks 'proced-after-send-signal-hook)))
+ (condition-case err
+ (unless (zerop (funcall
+ proced-signal-function (car process) signal))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed signals
+ (proced-log "%s\n" err)
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))
+ ;; use external system call
+ (let ((signal (format "-%s" signal)))
+ (dolist (process process-alist)
+ (with-temp-buffer
+ (condition-case nil
+ (unless (zerop (call-process
+ proced-signal-function nil t nil
+ signal (number-to-string (car process))))
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed signals
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))))
+ (if failures
+ ;; Proced error message are not always very precise.
+ ;; Can we issue a useful one-line summary in the
+ ;; message area (using FAILURES) if only one signal failed?
+ (proced-log-summary
+ (format "Signal %s" signal)
+ (format "%d of %d signal%s failed"
+ (length failures) (length process-alist)
+ (if (= 1 (length process-alist)) "" "s")))
+ (proced-success-message "Sent signal to" (length process-alist))))
+ ;; final clean-up
+ (run-hooks 'proced-after-send-signal-hook))
+
+(defun proced-renice (priority process-alist)
+ "Renice the processes in PROCESS-ALIST to PRIORITY.
+PROCESS-ALIST is an alist as returned by `proced-marked-processes'.
+Interactively, PROCESS-ALIST contains the marked processes.
+If no process is marked, it contains the process point is on,
+After renicing all processes in PROCESS-ALIST, this command runs
+the normal hook `proced-after-send-signal-hook'."
+ (interactive
+ (let ((process-alist (proced-marked-processes)))
+ (proced-with-processes-buffer process-alist
+ (list (read-number "New priority: ")
+ process-alist))))
+ (if (numberp priority)
+ (setq priority (number-to-string priority)))
+ (let (failures)
+ (dolist (process process-alist)
+ (with-temp-buffer
+ (condition-case nil
+ (unless (zerop (call-process
+ proced-renice-command nil t nil
+ priority (number-to-string (car process))))
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed renice
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))
+ (if failures
+ (proced-log-summary
+ (format "Renice %s" priority)
+ (format "%d of %d renice%s failed"
+ (length failures) (length process-alist)
+ (if (= 1 (length process-alist)) "" "s")))
+ (proced-success-message "Reniced" (length process-alist))))
+ ;; final clean-up
+ (run-hooks 'proced-after-send-signal-hook))