]> code.delx.au - gnu-emacs/blobdiff - lisp/net/net-utils.el
Update copyright year to 2015
[gnu-emacs] / lisp / net / net-utils.el
index b69c571ddf54727adbd12354fe2b5ecdaa682db1..28aa43117da3fcfd64f20b4e1c6384cd1319b917 100644 (file)
@@ -1,7 +1,6 @@
 ;;; net-utils.el --- network functions
 
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
 
 ;; Author:  Peter Breton <pbreton@cs.umb.edu>
 ;; Created: Sun Mar 16 1997
   :group 'comm
   :version "20.3")
 
-(defcustom net-utils-remove-ctl-m
-  (member system-type (list 'windows-nt 'msdos))
-  "If non-nil, remove control-Ms from output."
-  :group 'net-utils
-  :type  'boolean)
-
 (defcustom traceroute-program
   (if (eq system-type 'windows-nt)
       "tracert"
@@ -82,7 +75,7 @@
 ;; On GNU/Linux and Irix, the system's ping program seems to send packets
 ;; indefinitely unless told otherwise
 (defcustom ping-program-options
-  (and (memq system-type (list 'linux 'gnu/linux 'irix))
+  (and (memq system-type '(gnu/linux irix))
        (list "-c" "4"))
   "Options for the ping program.
 These options can be used to limit how many ICMP packets are emitted."
@@ -287,7 +280,8 @@ This variable is only used if the variable
 (define-derived-mode net-utils-mode special-mode "NetworkUtil"
   "Major mode for interacting with an external network utility."
   (set (make-local-variable 'font-lock-defaults)
-       '((net-utils-font-lock-keywords))))
+       '((net-utils-font-lock-keywords)))
+  (setq-local revert-buffer-function #'net-utils--revert-function))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Utility functions
@@ -320,25 +314,17 @@ This variable is only used if the variable
 
 (defun net-utils-remove-ctrl-m-filter (process output-string)
   "Remove trailing control Ms."
-  (let ((old-buffer (current-buffer))
-       (filtered-string output-string))
-    (unwind-protect
-       (let ((moving))
-         (set-buffer (process-buffer process))
-         (let ((inhibit-read-only t))
-           (setq moving (= (point) (process-mark process)))
-
-           (while (string-match "\r" filtered-string)
-             (setq filtered-string
-                   (replace-match "" nil nil filtered-string)))
-
-           (save-excursion
-             ;; Insert the text, moving the process-marker.
-             (goto-char (process-mark process))
-             (insert filtered-string)
-             (set-marker (process-mark process) (point))))
-         (if moving (goto-char (process-mark process))))
-      (set-buffer old-buffer))))
+  (with-current-buffer (process-buffer process)
+    (save-excursion
+      (let ((inhibit-read-only t)
+            (filtered-string output-string))
+        (while (string-match "\r" filtered-string)
+          (setq filtered-string
+                (replace-match "" nil nil filtered-string)))
+        ;; Insert the text, moving the process-marker.
+        (goto-char (process-mark process))
+        (insert filtered-string)
+        (set-marker (process-mark process) (point))))))
 
 (defun net-utils-run-program (name header program args)
   "Run a network information program."
@@ -356,20 +342,38 @@ This variable is only used if the variable
 ;; General network utilities (diagnostic)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defun net-utils-run-simple (buffer-name program-name args)
+;; Todo: This data could be saved in a bookmark.
+(defvar net-utils--revert-cmd nil)
+
+(defun net-utils-run-simple (buffer program-name args &optional nodisplay)
   "Run a network utility for diagnostic output only."
-  (interactive)
-  (when (get-buffer buffer-name)
-    (kill-buffer buffer-name))
-  (get-buffer-create buffer-name)
-  (with-current-buffer buffer-name
+  (with-current-buffer (if (stringp buffer) (get-buffer-create buffer) buffer)
+    (let ((proc (get-buffer-process (current-buffer))))
+      (when proc
+        (set-process-filter proc nil)
+        (delete-process proc)))
+    (let ((inhibit-read-only t))
+      (erase-buffer))
     (net-utils-mode)
+    (setq-local net-utils--revert-cmd
+                `(net-utils-run-simple ,(current-buffer)
+                                       ,program-name ,args nodisplay))
     (set-process-filter
-     (apply 'start-process (format "%s" program-name)
-           buffer-name program-name args)
-     'net-utils-remove-ctrl-m-filter)
-    (goto-char (point-min)))
-  (display-buffer buffer-name))
+         (apply 'start-process program-name
+                (current-buffer) program-name args)
+         'net-utils-remove-ctrl-m-filter)
+    (unless nodisplay (display-buffer (current-buffer)))))
+
+(defun net-utils--revert-function (&optional ignore-auto noconfirm)
+  (message "Reverting `%s'..." (buffer-name))
+  (apply (car net-utils--revert-cmd) (cdr net-utils--revert-cmd))
+  (let ((proc (get-buffer-process (current-buffer))))
+    (when proc
+      (set-process-sentinel
+       proc
+       (lambda (process event)
+         (when (string= event "finished\n")
+           (message "Reverting `%s' done" (process-buffer process))))))))
 
 ;;;###autoload
 (defun ifconfig ()
@@ -430,9 +434,8 @@ This variable is only used if the variable
         (if traceroute-program-options
             (append traceroute-program-options (list target))
           (list target))))
-    (net-utils-run-program
+    (net-utils-run-simple
      (concat "Traceroute" " " target)
-     (concat "** Traceroute ** " traceroute-program " ** " target)
      traceroute-program
      options)))
 
@@ -492,6 +495,11 @@ If your system's ping continues until interrupted, you can try setting
 
 (autoload 'comint-mode "comint" nil t)
 
+(defvar nslookup-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\t" 'completion-at-point)
+    map))
+
 ;; Using a derived mode gives us keymaps, hooks, etc.
 (define-derived-mode nslookup-mode comint-mode "Nslookup"
   "Major mode for interacting with the nslookup program."
@@ -501,8 +509,6 @@ If your system's ping continues until interrupted, you can try setting
   (setq comint-prompt-regexp nslookup-prompt-regexp)
   (setq comint-input-autoexpand t))
 
-(define-key nslookup-mode-map "\t" 'comint-dynamic-complete)
-
 ;;;###autoload
 (defun dns-lookup-host (host)
   "Lookup the DNS information for HOST (name or IP address)."
@@ -558,6 +564,12 @@ If your system's ping continues until interrupted, you can try setting
                   (list host)))
     (pop-to-buffer buf)))
 
+(defvar ftp-mode-map
+  (let ((map (make-sparse-keymap)))
+    ;; Occasionally useful
+    (define-key map "\t" 'completion-at-point)
+    map))
+
 (define-derived-mode ftp-mode comint-mode "FTP"
   "Major mode for interacting with the ftp program."
   (setq comint-prompt-regexp ftp-prompt-regexp)
@@ -573,9 +585,6 @@ If your system's ping continues until interrupted, you can try setting
     (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
              nil t)))
 
-;; Occasionally useful
-(define-key ftp-mode-map "\t" 'comint-dynamic-complete)
-
 (defun smbclient (host service)
   "Connect to SERVICE on HOST via SMB."
   (interactive
@@ -889,5 +898,4 @@ from SEARCH-STRING.  With argument, prompt for whois server."
 
 (provide 'net-utils)
 
-;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
 ;;; net-utils.el ends here