Re: improving network utility calls in lisp/net/net-utils.el

[David De La Harpe Golden]

Yoni Rabkin wrote:

> As an additional selling point I'll add that this would bring at least
> those two to look and behave like conventional Emacs pop-up windows(*).

I'm still not seeing any real connection to sync vs. async though, 
beyond it being unworkable to _naively_ leave buffer-read-only set on a 
buffer that's being async filled with process output?  That's not a 
great reason to leap to sync, though.

Assuming that anything in net-utils.el that's just run via 
net-utils-run-program rather than using a comint-derived mode like 
ftp-mode is effectively a simple one-shot output-only
command where your desired  treatment is appropriate, you could do 
something like the attached ?

i.r. Means you get a read-only popup output dismissable with "q", even
when the command is dawdling mid-output ?

I'm not sure you wouldn't want separate major mode and font locking
for the separate kinds of even simple network utility.  Of course,
the outputs of such utilities can vary platform to platform,
so going much beyond highlighting IP addresses and hostnames
might be on thin ice.






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