From: klaprade@jabba.ess.harris.com (Ken Laprade)
Subject: Re: DIRED/find-file .gif mode??
Reply-To: laprade@trantor.harris-atd.com
Organization: Advanced Technology Dept., Harris Corp., Melbourne, FL
Date: Tue, 15 Dec 1992 18:25:49 GMT


On 4 Dec 92, Shawn Koppenhoefer wrote

>> MY QUESTION: is there a "gif-mode.el" somewhere that will
>> automagically launch my "xv" program if I do a find-file on a gif
>> program?? how 'bout a "postscript-mode.el" for launching ghostview if
>> the file is a postscript file.... and lastly, a dvi-mode.el for
>> launching xtex if the file is a .dvi file.

I wrote this extension to find-file-noselect to launch such a program
BEFORE reading it into emacs.  I use it with FrameMaker all the time.

----------------------------------------
;;; -*-Emacs-Lisp-*-
;;; launcher.el - 15 Dec 92 - KCL
;;;
;;; Extension to find-file-noselect to check filetype before reading in.  A
;;; specific shell command or elisp function can be run on the file rather
;;; than reading it into a buffer.
;;;
;;; $Id: launcher.el,v 1.2 1992/12/15 14:47:36 laprade Exp $
;;;
;;; Copyright (C) 1992  Kenneth C. Laprade.
;;;
;;; Author: Kenneth C. Laprade (laprade@trantor.harris-atd.com)
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; A copy of the GNU General Public License can be obtained from this
;;; program's author (send electronic mail to laprade@trantor.harris-atd.com)
;;; or from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
;;;
;;;    LCD Archive Entry:
;;;    launcher|Ken Laprade|laprade@trantor.harris-atd.com
;;;    |Run a program on a file by checking filetype before reading in
;;;    |$Date: 1992/12/15 14:47:36 $|$Revision: 1.2 $|

;;; From epoch's wrapper.el:
(or (fboundp 'functionp)
    (defun functionp (thing)
      "Returns t if the argument is a function, nil otherwise"
      (cond
       ((symbolp thing) (fboundp thing))
       ((consp thing)
	(and (eq (car thing) 'lambda) (listp (cadr thing)))    )
       (t nil))))

(defvar launcher-list
  '(("\\.doc$" "Frame Maker document" "domaker %s&")
    ("\\.doc$" "Frame Maker book" "domaker %s&")
    (nil "rasterfile\\|P[BGP]M\\|GIF\\|TIFF" "xv %s&")
    (nil "audio data:" "play %s&"))
  "Selection list for program to execute.  May be selected based on either
filename or output of `file' command.  Each element of list is a list.  First
element of each list is a regexp that matches filenames of the file type.
Second element is a regexp that matches the output of the `file' command when
run on a file of the file type.  Either of the selection criteria elements may
be nil, and only the other criteria will be used.  The third element is the
action specifier used if either of the selection criteria matches.  If it is a
string, it is a format specifier for the shell command to run.  The fully
expanded filename will be supplied as an argument to format, so a `%s' should
be placed in the command where the filename should go.  If the element is a
function, it will be called with the fully expanded filename as its argument.")

(defvar launcher-magic-file (or (getenv "MAGIC") "/etc/magic")
  "*File to use instead of `/etc/magic' with the `file' command.")

(defvar launcher-enabled t
  "*If nil, launcher-find-file-noselect will never try to launch a file.")

(defun launcher-file-type (file)
  "Return the type of FILE as reported by the `file' command."
  (let ((buffer (generate-new-buffer " *file-output*"))
	stuff)
    (call-process "file" nil buffer nil "-L" "-m" launcher-magic-file file)
    (save-excursion
      (set-buffer buffer)
      (goto-char (point-min))
      (setq stuff (if (re-search-forward "^[^:]+:[ \t]*\\(.*\\)$" nil t)
		      (buffer-substring (match-beginning 1) (match-end 1))
		    ""))
      (kill-buffer buffer)
      stuff)))

(defun launcher-parse-launcher-list (file)
  "Determine if FILE satisfies any of the criteria in launcher-list.  All
filename regexp's are checked before any `file' command regexp's.  If a match
is found, the command element is returned.  If no criteria is satisfied, nil is
returned."
  (let ((l launcher-list)
	result)
    (while l
      (and (car (car l))
	   (string-match (car (car l)) file)
	   (setq result (nth 2 (car l))
		 l nil))
      (setq l (cdr l)))
    (if result
	()
      (setq l launcher-list
	    file (launcher-file-type file))
      (while l
      (and (nth 1 (car l))
	   (string-match (nth 1 (car l)) file)
	   (setq result (nth 2 (car l))
		 l nil))
      (setq l (cdr l))))
    result))

(defun launch-file (file &optional noerror)
  "Try to run a command on FILE as determined by launcher-list.
With NOERROR non-nil, will not call error if FILE cannot be launched."
  (interactive "fLaunch file: ")
  (setq file (expand-file-name file))
  (let ((command (launcher-parse-launcher-list file)))
    (cond
     ((stringp command)
      (call-process "/bin/csh" nil 0 nil "-c" (format command file))
      t)
     ((functionp command)
      (funcall command file)
      t)
     (t
      (or noerror
	  (error "Could not launch %s" file))
      nil))))

(defun launcher-find-file-noselect (filename &optional nowarn)
  "Try to start up an application for FILENAME based on launcher-list.  If
fails or launcher-enabled is nil, do launcher-original-find-file-noselect.

See documentation of launcher-original-find-file-noselect for the original
definition of find-file-noselect."
  (or (and launcher-enabled
	   (let (launcher-enabled)	; In case we launch a find-file.
	     (launch-file filename t))
	   ;; find-file-noselect is expected to return a buffer to select, so
	   ;; return the current buffer.
	   (current-buffer))
      (launcher-original-find-file-noselect filename nowarn)))

;;; Interpose launcher-find-file-noselect ahead of find-file-noselect.
(if (fboundp 'launcher-original-find-file-noselect)
    ()
  (fset 'launcher-original-find-file-noselect (symbol-function 'find-file-noselect))
  (fset 'find-file-noselect 'launcher-find-file-noselect))

(provide 'launcher)
--
---
Ken Laprade			INTERNET: laprade@trantor.harris-atd.com
Harris Corporation 		Usenet:  ...!uunet!x102a!trantor!laprade
PO Box 37, MS 3A/1912		Voice: (407)727-4433
Melbourne, FL 32902		FAX: (407)729-3363