[Emacs-diffs] emacs/lisp/net tramp-compat.el

[Michael Albinus]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Michael Albinus <albinus>       09/06/22 21:07:27

Modified files:
        lisp/net       : tramp-compat.el 

Log message:
        * net/tramp-compat.el (tramp-compat-split-string)
        (tramp-compat-process-running-p): New defuns.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/net/tramp-compat.el?cvsroot=emacs&r1=1.12&r2=1.13

Patches:
Index: tramp-compat.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/tramp-compat.el,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- tramp-compat.el     5 Jan 2009 03:22:49 -0000       1.12
+++ tramp-compat.el     22 Jun 2009 21:07:27 -0000      1.13
@@ -233,6 +233,57 @@
        (setq tree (cdr tree)))
       (nconc (nreverse result) tree))))
 
+(defun tramp-compat-split-string (string pattern)
+  "Like `split-string' but omit empty strings.
+In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
+This is, the first, empty, element is omitted.  In XEmacs, the first
+element is not omitted."
+  (delete "" (split-string string pattern)))
+
+(defun tramp-compat-process-running-p (process-name)
+  "Returns `t' if system process PROCESS-NAME is running for 
`user-login-name'."
+  (when (stringp process-name)
+    (cond
+     ;; GNU Emacs 22 on w32.
+     ((fboundp 'w32-window-exists-p)
+      (funcall (symbol-function 'w32-window-exists-p)
+              process-name process-name))
+
+     ;; GNU Emacs 23.
+     ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
+      (let (result)
+       (dolist (pid (funcall (symbol-function 'list-system-processes)) result)
+         (let ((attributes
+                (funcall (symbol-function 'process-attributes) pid)))
+           (when
+               (and (string-equal
+                     (cdr (assoc 'user attributes)) (user-login-name))
+                    ;; The returned command name could be truncated
+                    ;; to 15 characters.  Therefore, we cannot check
+                    ;; for `string-equal'.
+                    (string-match
+                     (concat "^" (regexp-quote (cdr (assoc 'comm attributes))))
+                     process-name))
+             (setq result t))))))
+
+     ;; Fallback, if there is no Lisp support yet.
+     (t (let ((default-directory
+               (if (file-remote-p default-directory)
+                   (tramp-compat-temporary-file-directory)
+                 default-directory))
+             (unix95 (getenv "UNIX95"))
+             result)
+         (setenv "UNIX95" "1")
+         (when (member
+                (user-login-name)
+                (tramp-compat-split-string
+                 (shell-command-to-string
+                  (format "ps -C %s -o user=" process-name))
+                 "[ \f\t\n\r\v]+"))
+           (setq result t))
+         (setenv "UNIX95" unix95)
+         result)))))
+
 (provide 'tramp-compat)
 
 ;;; TODO: