# HG changeset patch # User Peter Breton # Date 970638217 0 # Node ID 2e9fda397ea2dcc60d4386c8de39969f8e73d1b5 # Parent 034d1bf7a606c943ee80f2f170dfc67b090456bf * net/net-utils.el (nslookup-font-lock-keywords, ftp-font-lock-keywords, smbclient-font-lock-keywords): Only set if window-system is non-nil (net-utils-run-program): Returns buffer. (network-connection-reconnect): Added this function. diff -r 034d1bf7a606 -r 2e9fda397ea2 lisp/net/net-utils.el --- a/lisp/net/net-utils.el Wed Oct 04 05:40:27 2000 +0000 +++ b/lisp/net/net-utils.el Wed Oct 04 05:43:37 2000 +0000 @@ -3,7 +3,7 @@ ;; Author: Peter Breton ;; Created: Sun Mar 16 1997 ;; Keywords: network communications -;; Time-stamp: <1999-11-13 10:19:01 pbreton> +;; Time-stamp: <2000-10-04 01:32:16 pbreton> ;; This file is part of GNU Emacs. @@ -25,13 +25,13 @@ ;;; Commentary: ;; ;; There are three main areas of functionality: -;; +;; ;; * Wrap common network utility programs (ping, traceroute, netstat, ;; nslookup, arp, route). Note that these wrappers are of the diagnostic ;; functions of these programs only. -;; +;; ;; * Implement some very basic protocols in Emacs Lisp (finger and whois) -;; +;; ;; * Support connections to HOST/PORT, generally for debugging and the like. ;; In other words, for doing much the same thing as "telnet HOST PORT", and ;; then typing commands. @@ -39,7 +39,7 @@ ;; PATHS ;; ;; On some systems, some of these programs are not in normal user path, -;; but rather in /sbin, /usr/sbin, and so on. +;; but rather in /sbin, /usr/sbin, and so on. ;;; Code: @@ -57,15 +57,15 @@ :version "20.3" ) -(defcustom net-utils-remove-ctl-m +(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) +(defcustom traceroute-program + (if (eq system-type 'windows-nt) "tracert" "traceroute") "Program to trace network hops to a destination." @@ -87,7 +87,7 @@ ;; On Linux and Irix, the system's ping program seems to send packets ;; indefinitely unless told otherwise -(defcustom ping-program-options +(defcustom ping-program-options (and (memq system-type (list 'linux 'gnu/linux 'irix)) (list "-c" "4")) "Options for the ping program. @@ -96,7 +96,7 @@ :type '(repeat string) ) -(defcustom ipconfig-program +(defcustom ipconfig-program (if (eq system-type 'windows-nt) "ipconfig" "ifconfig") @@ -106,7 +106,7 @@ ) (defcustom ipconfig-program-options - (list + (list (if (eq system-type 'windows-nt) "/all" "-a")) "Options for ipconfig-program." @@ -120,7 +120,7 @@ :type 'string ) -(defcustom netstat-program-options +(defcustom netstat-program-options (list "-a") "Options for netstat-program." :group 'net-utils @@ -133,14 +133,14 @@ :type 'string ) -(defcustom arp-program-options +(defcustom arp-program-options (list "-a") "Options for arp-program." :group 'net-utils :type '(repeat string) ) -(defcustom route-program +(defcustom route-program (if (eq system-type 'windows-nt) "route" "netstat") @@ -149,7 +149,7 @@ :type 'string ) -(defcustom route-program-options +(defcustom route-program-options (if (eq system-type 'windows-nt) (list "print") (list "-r")) @@ -227,51 +227,54 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst nslookup-font-lock-keywords - (progn - (require 'font-lock) - (list - (list nslookup-prompt-regexp 0 font-lock-reference-face) - (list "^[A-Za-z0-9 _]+:" 0 font-lock-type-face) - (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>" - 1 font-lock-keyword-face) - ;; Dotted quads - (list - (mapconcat 'identity - (make-list 4 "[0-9]+") - "\\.") - 0 font-lock-variable-name-face) - ;; Host names - (list - (let ((host-expression "[-A-Za-z0-9]+")) - (concat - (mapconcat 'identity - (make-list 2 host-expression) - "\\.") - "\\(\\." host-expression "\\)*") - ) - 0 font-lock-variable-name-face) - )) - "Expressions to font-lock for nslookup.") + (and window-system + (progn + (require 'font-lock) + (list + (list nslookup-prompt-regexp 0 font-lock-reference-face) + (list "^[A-Za-z0-9 _]+:" 0 font-lock-type-face) + (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>" + 1 font-lock-keyword-face) + ;; Dotted quads + (list + (mapconcat 'identity + (make-list 4 "[0-9]+") + "\\.") + 0 font-lock-variable-name-face) + ;; Host names + (list + (let ((host-expression "[-A-Za-z0-9]+")) + (concat + (mapconcat 'identity + (make-list 2 host-expression) + "\\.") + "\\(\\." host-expression "\\)*") + ) + 0 font-lock-variable-name-face) + ))) + "Expressions to font-lock for nslookup.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; FTP goodies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst ftp-font-lock-keywords - (progn - (require 'font-lock) - (list - (list ftp-prompt-regexp 0 font-lock-reference-face)))) + (and window-system + (progn + (require 'font-lock) + (list + (list ftp-prompt-regexp 0 font-lock-reference-face))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; smbclient goodies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst smbclient-font-lock-keywords - (progn - (require 'font-lock) - (list - (list smbclient-prompt-regexp 0 font-lock-reference-face)))) + (and window-system + (progn + (require 'font-lock) + (list + (list smbclient-prompt-regexp 0 font-lock-reference-face))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utility functions @@ -311,7 +314,7 @@ (let ((moving)) (set-buffer (process-buffer process)) (setq moving (= (point) (process-mark process))) - + (while (string-match "\r" filtered-string) (setq filtered-string (replace-match "" nil nil filtered-string))) @@ -323,17 +326,18 @@ (set-marker (process-mark process) (point))) (if moving (goto-char (process-mark process)))) (set-buffer old-buffer)))) - + (defmacro net-utils-run-program (name header program &rest args) "Run a network information program." ` (let ((buf (get-buffer-create (concat "*" ,name "*")))) (set-buffer buf) (erase-buffer) (insert ,header "\n") - (set-process-filter + (set-process-filter (apply 'start-process ,name buf ,program ,@args) 'net-utils-remove-ctrl-m-filter) - (display-buffer buf))) + (display-buffer buf) + buf)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Wrappers for external network programs @@ -343,7 +347,7 @@ (defun traceroute (target) "Run traceroute program for TARGET." (interactive "sTarget: ") - (let ((options + (let ((options (if traceroute-program-options (append traceroute-program-options (list target)) (list target)))) @@ -357,11 +361,11 @@ ;;;###autoload (defun ping (host) "Ping HOST. -If your system's ping continues until interrupted, you can try setting +If your system's ping continues until interrupted, you can try setting `ping-program-options'." - (interactive + (interactive (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point)))) - (let ((options + (let ((options (if ping-program-options (append ping-program-options (list host)) (list host)))) @@ -385,7 +389,7 @@ ;; This is the normal name on most Unixes. ;;;###autoload -(defalias 'ifconfig 'ipconfig) +(defalias 'ifconfig 'ipconfig) ;;;###autoload (defun netstat () @@ -435,7 +439,7 @@ "Lookup the DNS information for HOST." (interactive (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point)))) - (let ((options + (let ((options (if nslookup-program-options (append nslookup-program-options (list host)) (list host)))) @@ -462,10 +466,10 @@ ) ;; Using a derived mode gives us keymaps, hooks, etc. -(define-derived-mode +(define-derived-mode nslookup-mode comint-mode "Nslookup" "Major mode for interacting with the nslookup program." - (set + (set (make-local-variable 'font-lock-defaults) '((nslookup-font-lock-keywords))) (setq local-abbrev-table nslookup-mode-abbrev-table) @@ -495,8 +499,8 @@ (list (progn (require 'ffap) - (read-from-minibuffer - "Lookup host: " + (read-from-minibuffer + "Lookup host: " (or (ffap-string-at-point 'machine) ""))))) (net-utils-run-program "Dig" @@ -506,15 +510,15 @@ " ** ")) dig-program (list host) - )) + )) ;; This is a lot less than ange-ftp, but much simpler. ;;;###autoload (defun ftp (host) "Run ftp program." - (interactive + (interactive (list - (read-from-minibuffer + (read-from-minibuffer "Ftp to Host: " (net-utils-machine-at-point)))) (require 'comint) (let ((buf (get-buffer-create (concat "*ftp [" host "]*")))) @@ -528,24 +532,24 @@ (switch-to-buffer-other-window buf) )) -(define-derived-mode +(define-derived-mode ftp-mode comint-mode "FTP" "Major mode for interacting with the ftp program." - (set + (set (make-local-variable 'font-lock-defaults) '((ftp-font-lock-keywords))) - + (make-local-variable 'comint-prompt-regexp) (setq comint-prompt-regexp ftp-prompt-regexp) - + (make-local-variable 'comint-input-autoexpand) (setq comint-input-autoexpand t) - + ;; Already buffer local! (setq comint-output-filter-functions (list 'comint-watch-for-password-prompt)) - + (setq local-abbrev-table ftp-mode-abbrev-table) (abbrev-mode t) ) @@ -560,9 +564,9 @@ (defun smbclient (host service) "Connect to SERVICE on HOST via SMB." - (interactive + (interactive (list - (read-from-minibuffer + (read-from-minibuffer "Connect to Host: " (net-utils-machine-at-point)) (read-from-minibuffer "SMB Service: "))) (require 'comint) @@ -581,42 +585,42 @@ (defun smbclient-list-shares (host) "List services on HOST." - (interactive + (interactive (list - (read-from-minibuffer + (read-from-minibuffer "Connect to Host: " (net-utils-machine-at-point)) )) (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host)))) (set-buffer buf) (comint-mode) - (comint-exec - buf - "smbclient-list-shares" - smbclient-program + (comint-exec + buf + "smbclient-list-shares" + smbclient-program nil (list "-L" host) ) (smbclient-mode) (switch-to-buffer-other-window buf))) - -(define-derived-mode + +(define-derived-mode smbclient-mode comint-mode "smbclient" "Major mode for interacting with the smbclient program." - (set + (set (make-local-variable 'font-lock-defaults) '((smbclient-font-lock-keywords))) - + (make-local-variable 'comint-prompt-regexp) (setq comint-prompt-regexp smbclient-prompt-regexp) - + (make-local-variable 'comint-input-autoexpand) (setq comint-input-autoexpand t) - + ;; Already buffer local! (setq comint-output-filter-functions (list 'comint-watch-for-password-prompt)) - + (setq local-abbrev-table smbclient-mode-abbrev-table) (abbrev-mode t) ) @@ -630,7 +634,7 @@ ;; Full list is available at: ;; ftp://ftp.isi.edu/in-notes/iana/assignments/port-numbers -(defvar network-connection-service-alist +(defvar network-connection-service-alist (list (cons 'echo 7) (cons 'active-users 11) @@ -659,7 +663,7 @@ This list in not complete.") ;; Workhorse macro -(defmacro run-network-program (process-name host port +(defmacro run-network-program (process-name host port &optional initial-string) ` (let ((tcp-connection) @@ -667,9 +671,9 @@ ) (setq buf (get-buffer-create (concat "*" ,process-name "*"))) (set-buffer buf) - (or + (or (setq tcp-connection - (open-network-stream + (open-network-stream ,process-name buf ,host @@ -680,7 +684,7 @@ (set-marker (process-mark tcp-connection) (point-min)) (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter) (and ,initial-string - (process-send-string tcp-connection + (process-send-string tcp-connection (concat ,initial-string "\r\n"))) (display-buffer buf))) @@ -723,9 +727,9 @@ (setq regexps (cdr regexps))) (when regexps (setq user-and-host user)) - (run-network-program - process-name - host + (run-network-program + process-name + host (cdr (assoc 'finger network-connection-service-alist)) user-and-host))) @@ -804,7 +808,7 @@ (completing-read "Whois server name: " whois-server-list nil nil "whois.") server-name))) - (run-network-program + (run-network-program "Whois" host (cdr (assoc 'whois network-connection-service-alist)) @@ -828,22 +832,22 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Using a derived mode gives us keymaps, hooks, etc. -(define-derived-mode +(define-derived-mode network-connection-mode comint-mode "Network-Connection" "Major mode for interacting with the network-connection program." ) (defun network-connection-mode-setup (host service) (let ((network-abbrev-table - (or + (or (assoc service network-connection-service-abbrev-alist) (and (rassoc service network-connection-service-alist) - (assoc + (assoc (elt (rassoc service network-connection-service-alist) 0) network-connection-service-abbrev-alist))))) (make-local-variable 'network-connection-host) (setq network-connection-host host) - (make-local-variable 'network-connection-service) + (make-local-variable 'network-connection-service) (setq network-connection-service service) (and network-abbrev-table (setq local-abbrev-table (cdr network-abbrev-table)) @@ -853,17 +857,17 @@ ;;;###autoload (defun network-connection-to-service (host service) "Open a network connection to SERVICE on HOST." - (interactive + (interactive (list (read-from-minibuffer "Host: " (net-utils-machine-at-point)) - (completing-read "Service: " - (mapcar - (function + (completing-read "Service: " + (mapcar + (function (lambda (elt) (list (symbol-name (car elt))))) network-connection-service-alist)))) - (network-connection - host + (network-connection + host (cdr (assoc (intern service) network-connection-service-alist))) ) @@ -882,7 +886,7 @@ (buf (get-buffer-create (concat "*" process-name "*"))) ) (or (zerop portnum) (setq service portnum)) - (make-comint + (make-comint process-name (cons host service)) (set-buffer buf) @@ -891,6 +895,27 @@ (pop-to-buffer buf) )) +(defun network-connection-reconnect () + "Reconnect a network connection, preserving the old input ring." + (interactive) + (let ((proc (get-buffer-process (current-buffer))) + (old-comint-input-ring comint-input-ring) + (host network-connection-host) + (service network-connection-service) + ) + (if (not (or (not proc) + (eq (process-status proc) 'closed))) + (message "Still connected") + (goto-char (point-max)) + (insert (format "Reopening connection to %s\n" host)) + (network-connection host + (if (numberp service) + service + (cdr (assoc service network-connection-service-alist)))) + (and old-comint-input-ring + (setq comint-input-ring old-comint-input-ring)) + ))) + (provide 'net-utils) ;;; net-utils.el ends here