From: Chong Yidong Date: Sat, 8 Aug 2009 18:26:36 +0000 (+0000) Subject: * net/net-utils.el (net-utils-font-lock-keywords): New var. X-Git-Tag: emacs-pretest-23.1.90~1915 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ce299d55e7cd82a29aaca2c74bc0c19690bf3649;p=emacs.git * net/net-utils.el (net-utils-font-lock-keywords): New var. (nslookup-font-lock-keywords): Make it a variable. (net-utils-mode): New mode for viewing diagnostic network output. (net-utils-remove-ctrl-m-filter): Set inhibit-read-only. (net-utils-run-simple): New function. (ifconfig, iwconfig, netstat, arp, route): Use it. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index aba028d6ef0..a1b6dd53926 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2009-08-08 Yoni Rabkin + + * net/net-utils.el (net-utils-font-lock-keywords): New var. + (nslookup-font-lock-keywords): Make it a variable. + (net-utils-mode): New mode for viewing diagnostic network output. + (net-utils-remove-ctrl-m-filter): Set inhibit-read-only. + (net-utils-run-simple): New function. + (ifconfig, iwconfig, netstat, arp, route): Use it. + 2009-08-08 Dmitry Dzhus * progmodes/gdb-mi.el (gdb-read-memory-custom) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 7e7e5cd1bbf..f295803ff50 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -237,7 +237,7 @@ This variable is only used if the variable ;; Nslookup goodies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst nslookup-font-lock-keywords +(defvar nslookup-font-lock-keywords (list (list "^[A-Za-z0-9 _]+:" 0 'font-lock-type-face) (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>" @@ -259,6 +259,36 @@ This variable is only used if the variable 0 'font-lock-variable-name-face)) "Expressions to font-lock for nslookup.") +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; General network utilities mode +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar net-utils-font-lock-keywords + (list + ;; Dotted quads + (list + (mapconcat 'identity (make-list 4 "[0-9]+") "\\.") + 0 'font-lock-variable-name-face) + ;; Simple rfc4291 addresses + (list (concat + "\\( \\([[:xdigit:]]+\\(:\\|::\\)\\)+[[:xdigit:]]+\\)" + "\\|" + "\\(::[[:xdigit:]]+\\)") + 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 general network utilities.") + +(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)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -288,7 +318,6 @@ This variable is only used if the variable (skip-chars-backward ":;.,!?" pt) (point))))) - (defun net-utils-remove-ctrl-m-filter (process output-string) "Remove trailing control Ms." (let ((old-buffer (current-buffer)) @@ -296,17 +325,18 @@ This variable is only used if the variable (unwind-protect (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))) - - (save-excursion - ;; Insert the text, moving the process-marker. - (goto-char (process-mark process)) - (insert filtered-string) - (set-marker (process-mark process) (point))) + (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)))) @@ -322,6 +352,72 @@ This variable is only used if the variable (display-buffer buf) buf)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; General network utilities (diagnostic) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun net-utils-run-simple (buffer-name program-name args) + "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 + (net-utils-mode) + (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)) + +;;;###autoload +(defun ifconfig () + "Run ifconfig and display diagnostic output." + (interactive) + (net-utils-run-simple + (format "*%s*" ifconfig-program) + ifconfig-program + ifconfig-program-options)) + +(defalias 'ipconfig 'ifconfig) + +;;;###autoload +(defun iwconfig () + "Run iwconfig and display diagnostic output." + (interactive) + (net-utils-run-simple + (format "*%s*" iwconfig-program) + iwconfig-program + iwconfig-program-options)) + +;;;###autoload +(defun netstat () + "Run netstat and display diagnostic output." + (interactive) + (net-utils-run-simple + (format "*%s*" netstat-program) + netstat-program + netstat-program-options)) + +;;;###autoload +(defun arp () + "Run arp and display diagnostic output." + (interactive) + (net-utils-run-simple + (format "*%s*" arp-program) + arp-program + arp-program-options)) + +;;;###autoload +(defun route () + "Run route and display diagnostic output." + (interactive) + (net-utils-run-simple + (format "*%s*" route-program) + route-program + route-program-options)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Wrappers for external network programs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -357,60 +453,6 @@ If your system's ping continues until interrupted, you can try setting ping-program options))) -;;;###autoload -(defun ifconfig () - "Run ifconfig program." - (interactive) - (net-utils-run-program - "Ifconfig" - (concat "** Ifconfig ** " ifconfig-program " ** ") - ifconfig-program - ifconfig-program-options)) - -;; Windows uses this name. -;;;###autoload -(defalias 'ipconfig 'ifconfig) - -;;;###autoload -(defun iwconfig () - "Run iwconfig program." - (interactive) - (net-utils-run-program - "Iwconfig" - (concat "** Iwconfig ** " iwconfig-program " ** ") - iwconfig-program - iwconfig-program-options)) - -;;;###autoload -(defun netstat () - "Run netstat program." - (interactive) - (net-utils-run-program - "Netstat" - (concat "** Netstat ** " netstat-program " ** ") - netstat-program - netstat-program-options)) - -;;;###autoload -(defun arp () - "Run arp program." - (interactive) - (net-utils-run-program - "Arp" - (concat "** Arp ** " arp-program " ** ") - arp-program - arp-program-options)) - -;;;###autoload -(defun route () - "Run route program." - (interactive) - (net-utils-run-program - "Route" - (concat "** Route ** " route-program " ** ") - route-program - route-program-options)) - ;; FIXME -- Needs to be a process filter ;; (defun netstat-with-filter (filter) ;; "Run netstat program."