Index: lisp/net/net-utils.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/net-utils.el,v
retrieving revision 1.37
diff -U 8 -r1.37 net-utils.el
--- lisp/net/net-utils.el	5 Jan 2009 03:22:45 -0000	1.37
+++ lisp/net/net-utils.el	10 Apr 2009 20:04:52 -0000
@@ -255,16 +255,52 @@
        (mapconcat 'identity
                   (make-list 2 host-expression)
                   "\\.")
        "\\(\\." host-expression "\\)*"))
     0 'font-lock-variable-name-face))
   "Expressions to font-lock for nslookup.")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Miscellaneous one-shot network util output display mode
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst net-utils-font-lock-keywords
+  (list
+   (list "^[A-Za-z0-9 _]+:" 0 'font-lock-type-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 simple one-shot network utilities.")
+
+(define-derived-mode net-utils-mode special-mode "Network Util"
+  "Major mode for viewing output of simple one-shot network utilities."
+  (set
+   (make-local-variable 'font-lock-defaults)
+   '((net-utils-font-lock-keywords)))
+  (use-local-map net-utils-mode-map))
+
+(defun net-utils-mode-bury-buffer ()
+  "Wrapper around `bury-buffer' for pop-ups."
+  (interactive)
+  (if (one-window-p)
+      (bury-buffer)
+    (delete-window)))
+
+(define-key net-utils-mode-map "q" 'net-utils-mode-bury-buffer)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Utility functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; Simplified versions of some at-point functions from ffap.el.
 ;; It's not worth loading all of ffap just for these.
 (defun net-utils-machine-at-point ()
   (let ((pt (point)))
     (buffer-substring-no-properties
@@ -291,36 +327,39 @@
 
 (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))
-	  (setq moving (= (point) (process-mark process)))
+	  (let ((buffer-read-only nil)) ; allow insertion
+	    (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))))
+	    (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))))
 
 (defun net-utils-run-program (name header program args)
   "Run a network information program."
   (let ((buf (get-buffer-create (concat "*" name "*"))))
     (set-buffer buf)
-    (erase-buffer)
-    (insert header "\n")
+    (let ((buffer-read-only nil)) ; allow clear
+      (erase-buffer)
+      (insert header "\n"))
+    (net-utils-mode)
     (set-process-filter
      (apply 'start-process name buf program args)
      'net-utils-remove-ctrl-m-filter)
     (display-buffer buf)
     buf))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Wrappers for external network programs