Re: [patch] mailcap.el: Error in parsing mailcap entries

[Elias Oltmanns <oltmanns@uni-bonn.de>]

[-- Attachment #1: Type: text/plain, Size: 1578 bytes --]

First of all, sorry for the duplicated posting. For some reason, the
first copy didn't show up in my gnus group buffer (no new messages
indicated for gmane.emacs.gnus.general). One wonders, whether this is
another bug in gnus or in the inner workings of the OP.

Elias Oltmanns <oltmanns@uni-bonn.de> wrote:
[...]
> Additionally, I'd like to have the tests performed in
> mailcap-mailcap-entry-passes-test incorporated into the caching
> system.

In fact, mailcap-mailcap-entry-passes-test seems to be flawed anyway.
If I haven't missed something, a line like
application/zip; /usr/bin/file-roller '%s'; test=test -n "$DISPLAY" -a -e /usr/bin/unzip
from my /etc/mailcap is preevaluated by
mailcap-mailcap-entry-passes-test ignoring everything after "$DISPLAY"
in the test clause. Since the actual test clause is discarded
afterwards and replaced by the result of the test of the DISPLAY
variable, the existence of /usr/bin/unzip is never checked. Besides,
mailcap-mailcap-entry-passes-test is the only function that evaluates
a "needsterm\(inal\)?" or "needsx11" clause in the mime-data. Since
this function is only applied to mailcap entries read from external
sources, a "needs\(x11\|term\{inal\}?\)" clause of any mailcap entry
in the default definition of the variable mailcap-mime-data is simly
ignored.

In an attempt to eliminate these flaws and to make the whole testing
business more consistent, i.e., integrating checks for $DISPLAY into
the caching mechanism, I'd like to ask for your comments on the patch
attached below (applying to current cvs).

Regards,

Elias


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: mailcap.el-2.patch --]
[-- Type: text/x-patch, Size: 4850 bytes --]

--- gnus/lisp/mailcap.el.orig	2006-07-30 11:07:30.000000000 +0200
+++ gnus/lisp/mailcap.el	2006-07-31 00:11:37.000000000 +0200
@@ -487,7 +487,6 @@
 						      (if (string= minor ".*")
 							  "*" minor))))
 			    (mailcap-parse-mailcap-extras save-pos (point))))
-	  (mailcap-mailcap-entry-passes-test info)
 	  (mailcap-add-mailcap-entry major minor info))
 	(beginning-of-line)))))
 
@@ -541,32 +540,6 @@
 	(skip-chars-forward " \";\n\t"))
       results)))
 
-(defun mailcap-mailcap-entry-passes-test (info)
-  "Return non-nil iff mailcap entry INFO passes its test clause.
-Also return non-nil if no test clause is present."
-  (let ((test (assq 'test info))	; The test clause
-	status)
-    (setq status (and test (split-string (cdr test) " ")))
-    (if (and (or (assoc "needsterm" info)
-		 (assoc "needsterminal" info)
-		 (assoc "needsx11" info))
-	     (not (getenv "DISPLAY")))
-	(setq status nil)
-      (cond
-       ((and (equal (nth 0 status) "test")
-	     (equal (nth 1 status) "-n")
-	     (or (equal (nth 2 status) "$DISPLAY")
-		 (equal (nth 2 status) "\"$DISPLAY\"")))
-	(setq status (if (getenv "DISPLAY") t nil)))
-       ((and (equal (nth 0 status) "test")
-	     (equal (nth 1 status) "-z")
-	     (or (equal (nth 2 status) "$DISPLAY")
-		 (equal (nth 2 status) "\"$DISPLAY\"")))
-	(setq status (if (getenv "DISPLAY") nil t)))
-       (test nil)
-       (t nil)))
-    (and test (listp test) (setcdr test status))))
-
 ;;;
 ;;; The action routines.
 ;;;
@@ -641,34 +614,66 @@
   (let* ((test-info (assq 'test viewer-info))
 	 (test (cdr test-info))
 	 (otest test)
-	 (viewer (cdr (assoc 'viewer viewer-info)))
+	 (viewer (cdr (assq 'viewer viewer-info)))
 	 (default-directory (expand-file-name "~/"))
 	 status parsed-test cache result)
-    (cond ((setq cache (assoc test mailcap-viewer-test-cache))
-	   (cadr cache))
-	  ((not test-info) t)		; No test clause
-	  (t
-	   (setq
-	    result
-	    (cond
-	     ((not test) nil)		; Already failed test
-	     ((eq test t) t)		; Already passed test
-	     ((functionp test)		; Lisp function as test
-	      (funcall test type-info))
-	     ((and (symbolp test)	; Lisp variable as test
-		   (boundp test))
-	      (symbol-value test))
-	     ((and (listp test)		; List to be eval'd
-		   (symbolp (car test)))
-	      (eval test))
-	     (t
-	      (setq test (mailcap-unescape-mime-test test type-info)
-		    test (list shell-file-name nil nil nil
-			       shell-command-switch test)
-		    status (apply 'call-process test))
-	      (eq 0 status))))
-	   (push (list otest result) mailcap-viewer-test-cache)
-	   result))))
+    (if (setq cache (assq 'display viewer-info))
+	(if (cdr cache)
+	    (if (setq cache (assq 'display mailcap-viewer-test-cache))
+		(setq status (cadr cache))
+	      (push (list 'display (setq status (getenv "DISPLAY")))
+		    mailcap-viewer-test-cache))
+	  (setq status t))
+      (setq status (and test (stringp test) (split-string test " ")))
+      (if (or (assoc "needsterm" viewer-info)
+	      (assoc "needsterminal" viewer-info)
+	      (assoc "needsx11" viewer-info)
+	      (and (equal (nth 0 status) "test")
+		   (or (and (equal (nth 1 status) "-n")
+			    (or (equal (nth 2 status) "$DISPLAY")
+				(equal (nth 2 status) "\"$DISPLAY\"")))
+		       (and (equal (nth 1 status) "-z")
+			    (or (equal (nth 2 status) "$DISPLAY")
+				(equal (nth 2 status) "\"$DISPLAY\"")))
+		       (and (equal (nth 1 status) "\"$DISPLAY\"")
+			    (equal (nth 2 status) "!=")
+			    (equal (nth 3 status) "\"\"")))))
+	  (progn
+	    (nconc viewer-info (list (cons 'display t)))
+	    (setq
+	     status
+	     (if (setq cache (assq 'display mailcap-viewer-test-cache))
+		 (cadr cache)
+	       (push (list 'display (setq status (getenv "DISPLAY")))
+		     mailcap-viewer-test-cache))))
+	(nconc viewer-info (list (cons 'display nil)))
+	(setq status t)))
+    (when status
+      (cond ((setq cache (assoc test mailcap-viewer-test-cache))
+	     (cadr cache))
+	    ((not test-info) t)		; No test clause
+	    ((not test) nil)		; Already failed test
+	    (t
+	     (setq
+	      result
+	      (cond
+	       ((eq test t) t)		; Already passed test
+	       ((functionp test)		; Lisp function as test
+		(funcall test type-info))
+	       ((and (symbolp test)	; Lisp variable as test
+		     (boundp test))
+		(symbol-value test))
+	       ((and (listp test)		; List to be eval'd
+		     (symbolp (car test)))
+		(eval test))
+	       (t
+		(setq test (mailcap-unescape-mime-test test type-info)
+		      test (list shell-file-name nil nil nil
+				 shell-command-switch test)
+		      status (apply 'call-process test))
+		(eq 0 status))))
+	     (push (list otest result) mailcap-viewer-test-cache)
+	     result)))))
 
 (defun mailcap-add-mailcap-entry (major minor info)
   (let ((old-major (assoc major mailcap-mime-data)))