From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Tassilo Horn Newsgroups: gmane.emacs.bugs Subject: bug#23184: 25.0.92; User-friendly way to override doc-view-mode as MIME viewer Date: Sat, 09 Apr 2016 10:57:04 +0200 Message-ID: <87h9fbuplr.fsf@gnu.org> References: <87shz4pi13.fsf@iki.fi> <878u0nj0au.fsf@gnu.org> <83zit3i8rn.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1460192297 6710 80.91.229.3 (9 Apr 2016 08:58:17 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 9 Apr 2016 08:58:17 +0000 (UTC) Cc: tlikonen@iki.fi, 23184@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Apr 09 10:58:16 2016 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1aooiZ-0002La-Uv for geb-bug-gnu-emacs@m.gmane.org; Sat, 09 Apr 2016 10:58:12 +0200 Original-Received: from localhost ([::1]:59664 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aooiZ-0005vr-7l for geb-bug-gnu-emacs@m.gmane.org; Sat, 09 Apr 2016 04:58:11 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:57736) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aooiU-0005sV-5E for bug-gnu-emacs@gnu.org; Sat, 09 Apr 2016 04:58:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aooiQ-0004xq-Ti for bug-gnu-emacs@gnu.org; Sat, 09 Apr 2016 04:58:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:42813) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aooiQ-0004xl-Pc for bug-gnu-emacs@gnu.org; Sat, 09 Apr 2016 04:58:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1aooiQ-0005WH-CS for bug-gnu-emacs@gnu.org; Sat, 09 Apr 2016 04:58:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tassilo Horn Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 09 Apr 2016 08:58:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 23184 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 23184-submit@debbugs.gnu.org id=B23184.146019223621162 (code B ref 23184); Sat, 09 Apr 2016 08:58:02 +0000 Original-Received: (at 23184) by debbugs.gnu.org; 9 Apr 2016 08:57:16 +0000 Original-Received: from localhost ([127.0.0.1]:55150 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1aoohf-0005VG-Qr for submit@debbugs.gnu.org; Sat, 09 Apr 2016 04:57:16 -0400 Original-Received: from out5-smtp.messagingengine.com ([66.111.4.29]:59027) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1aoohd-0005V7-Lz for 23184@debbugs.gnu.org; Sat, 09 Apr 2016 04:57:13 -0400 Original-Received: from compute5.internal (compute5.nyi.internal [10.202.2.45]) by mailout.nyi.internal (Postfix) with ESMTP id A37EA20D6B for <23184@debbugs.gnu.org>; Sat, 9 Apr 2016 04:57:11 -0400 (EDT) Original-Received: from frontend1 ([10.202.2.160]) by compute5.internal (MEProxy); Sat, 09 Apr 2016 04:57:11 -0400 DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d= messagingengine.com; h=cc:content-type:date:from:in-reply-to :message-id:mime-version:references:subject:to:x-sasl-enc :x-sasl-enc; s=smtpout; bh=JcDOt9yroCgDB0mpGNS9nDnAWEg=; b=R8bYL qBwIIeMDxkNGusAcYqw9Rfk3T8CVawsD4AjHNwxdVCA4fP2lMvhE9guTJZWpGSec FMpdXDyPWB26Dw0b8FoZEpbXZuQNHwRJAcMjVRyfH2AUHd9wSzSYEq3rc09ivSaO sGoi02SuZCoiLc/LN6k9qtneXyuPS5ui8Hm+3w= X-Sasl-enc: ThUgZoeTp+8fhMh6mIA3RUy3pjgYJTlEVFuKkLRxpWOK 1460192231 Original-Received: from thinkpad-t440p (unknown [2.161.254.14]) by mail.messagingengine.com (Postfix) with ESMTPA id 9D8D8C00013; Sat, 9 Apr 2016 04:57:10 -0400 (EDT) In-Reply-To: <83zit3i8rn.fsf@gnu.org> (Eli Zaretskii's message of "Sat, 09 Apr 2016 09:41:32 +0300") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.0.92 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:116259 Archived-At: Eli Zaretskii writes: >> From: Tassilo Horn >> Date: Fri, 08 Apr 2016 22:46:49 +0200 >> Cc: 23184@debbugs.gnu.org >> >> (In case I'd implement that, should that go only into master or >> emacs-25?) > > It should go to master. Thanks. Ok. Does that approach look sensible? --8<---------------cut here---------------start------------->8--- 1 file changed, 102 insertions(+), 29 deletions(-) lisp/net/mailcap.el | 131 ++++++++++++++++++++++++++++++++++++++++------------ modified lisp/net/mailcap.el @@ -58,6 +58,59 @@ mailcap-print-command " ") "Shell command (including switches) used to print PostScript files.") +(defun mailcap--get-user-mime-data (sym) + (let ((val (default-value sym)) + res) + (dolist (entry val) + (setq res (cons (list (cdr (assq 'viewer entry)) + (cdr (assq 'type entry)) + (cdr (assq 'test entry))) + res))) + (nreverse res))) + +(defun mailcap--set-user-mime-data (sym val) + (let (res) + (dolist (entry val) + (setq res (cons `((viewer . ,(car entry)) + (type . ,(cadr entry)) + ,@(when (caddr entry) + `((test . ,(caddr entry))))) + res))) + (set-default sym (nreverse res)))) + +(defcustom mailcap-user-mime-data nil + "A list of viewers preferred for different MIME types. +The elements of the list are alists of the following structure + + ((viewer . VIEWER) + (type . MIME-TYPE) + (test . TEST)) + +where VIEWER is either a lisp command, e.g., a major-mode, or a +string containing a shell command for viewing files of the +defined MIME-TYPE. In case of a shell command, %s will be +replaced with the file. + +MIME-TYPE is a regular expression being matched against the +actual MIME type. It is implicitly surrounded with ^ and $. + +TEST is an lisp form which is evaluated in order to test if the +entry should be chosen. The `test' entry is optional. + +When selecting a viewer for a given MIME type, the first viewer +in this list with a matching MIME-TYPE and successful TEST is +selected. Only if none matches, the standard `mailcap-mime-data' +is consulted." + :type '(repeat + (list + (choice (function :tag "Function or mode") + (string :tag "Shell command")) + (regexp :tag "MIME Type") + (sexp :tag "Test (optional)"))) + :get #'mailcap--get-user-mime-data + :set #'mailcap--set-user-mime-data + :group 'mailcap) + ;; Postpone using defcustom for this as it's so big and we essentially ;; have to have two copies of the data around then. Perhaps just ;; customize the Lisp viewers and rely on the normal configuration @@ -700,6 +753,20 @@ mailcap-viewer-lessp t) (t nil)))) +(defun mailcap-select-preferred-viewer (type-info) + "Return an applicable viewer entry from `mailcap-user-mime-data'." + (let ((info (mapcar (lambda (a) (cons (symbol-name (car a)) + (cdr a))) + (cdr type-info))) + viewer) + (dolist (entry mailcap-user-mime-data) + (when (and (null viewer) + (string-match (concat "^" (cdr (assq 'type entry)) "$") + (car type-info)) + (mailcap-viewer-passes-test entry info)) + (setq viewer entry))) + viewer)) + (defun mailcap-mime-info (string &optional request no-decode) "Get the MIME viewer command for STRING, return nil if none found. Expects a complete content-type header line as its argument. @@ -732,41 +799,47 @@ mailcap-mime-info (if no-decode (list (or string "text/plain")) (mail-header-parse-content-type (or string "text/plain")))) - (setq major (split-string (car ctl) "/")) - (setq minor (cadr major) - major (car major)) - (when (setq major-info (cdr (assoc major mailcap-mime-data))) - (when (setq viewers (mailcap-possible-viewers major-info minor)) - (setq info (mapcar (lambda (a) (cons (symbol-name (car a)) - (cdr a))) - (cdr ctl))) - (while viewers - (if (mailcap-viewer-passes-test (car viewers) info) - (setq passed (cons (car viewers) passed))) - (setq viewers (cdr viewers))) - (setq passed (sort passed 'mailcap-viewer-lessp)) - (setq viewer (car passed)))) - (when (and (stringp (cdr (assq 'viewer viewer))) - passed) - (setq viewer (car passed))) + ;; Check if there's a user-defined viewer from `mailcap-user-mime-data'. + (setq viewer (mailcap-select-preferred-viewer ctl)) + (if viewer + (setq passed (list viewer)) + ;; None found, so heuristically select some applicable viewer + ;; from `mailcap-mime-data'. + (setq major (split-string (car ctl) "/")) + (setq minor (cadr major) + major (car major)) + (when (setq major-info (cdr (assoc major mailcap-mime-data))) + (when (setq viewers (mailcap-possible-viewers major-info minor)) + (setq info (mapcar (lambda (a) (cons (symbol-name (car a)) + (cdr a))) + (cdr ctl))) + (while viewers + (if (mailcap-viewer-passes-test (car viewers) info) + (setq passed (cons (car viewers) passed))) + (setq viewers (cdr viewers))) + (setq passed (sort passed 'mailcap-viewer-lessp)) + (setq viewer (car passed)))) + (when (and (stringp (cdr (assq 'viewer viewer))) + passed) + (setq viewer (car passed)))) (cond ((and (null viewer) (not (equal major "default")) request) - (mailcap-mime-info "default" request no-decode)) + (mailcap-mime-info "default" request no-decode)) ((or (null request) (equal request "")) - (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) + (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) ((stringp request) - (mailcap-unescape-mime-test - (cdr-safe (assoc request viewer)) info)) + (mailcap-unescape-mime-test + (cdr-safe (assoc request viewer)) info)) ((eq request 'all) - passed) + passed) (t - ;; MUST make a copy *sigh*, else we modify mailcap-mime-data - (setq viewer (copy-sequence viewer)) - (let ((view (assq 'viewer viewer)) - (test (assq 'test viewer))) - (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info))) - (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info)))) - viewer))))) + ;; MUST make a copy *sigh*, else we modify mailcap-mime-data + (setq viewer (copy-sequence viewer)) + (let ((view (assq 'viewer viewer)) + (test (assq 'test viewer))) + (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info))) + (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info)))) + viewer))))) ;;; ;;; Experimental MIME-types parsing --8<---------------cut here---------------end--------------->8--- Bye, Tassilo