? net-utils-improved-utility-calls-2.patch ? net-utils-improved-utility-calls-3.patch ? net-utils-improved-utility-calls.patch ? net-utils.patch ? lisp/mail/subdirs.el ? lisp/nxml/char-name/subdirs.el Index: lisp/net/net-utils.el =================================================================== RCS file: /sources/emacs/emacs/lisp/net/net-utils.el,v retrieving revision 1.37 diff -u -r1.37 net-utils.el --- lisp/net/net-utils.el 5 Jan 2009 03:22:45 -0000 1.37 +++ lisp/net/net-utils.el 11 Apr 2009 08:33:43 -0000 @@ -260,6 +260,38 @@ "Expressions to font-lock for nslookup.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; General network utilities mode +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst 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))) + (use-local-map net-utils-mode-map)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -288,7 +320,6 @@ (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 +327,18 @@ (unwind-protect (let ((moving)) (set-buffer (process-buffer process)) - (setq moving (= (point) (process-mark 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))) + (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)))) @@ -323,6 +355,42 @@ 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)) + +(defmacro net-utils-defutil (fname program-name args) + (let ((doc (format "Run %s and display diagnostic output." + fname))) + `(defun ,fname () + ,doc + (interactive) + (net-utils-run-simple + (format "*%s*" ,program-name) + ,program-name + ,args)))) + +(net-utils-defutil ifconfig ifconfig-program ifconfig-program-options) +(net-utils-defutil iwconfig iwconfig-program iwconfig-program-options) +(net-utils-defutil netstat netstat-program netstat-program-options) +(net-utils-defutil arp arp-program arp-program-options) +(net-utils-defutil route route-program route-program-options) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Wrappers for external network programs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -357,60 +425,6 @@ 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."