cgit.sxemacs.org Git - sxemacs/blob - lisp/ffi/ffi-magic.el

   1 ;; ffi-magic.el --- Lisp bindings into file(1)'s libmagic.so   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2008 Steve Youngs
   4
   5 ;; Author:     Steve Youngs <steve@sxemacs.org>
   6 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
   7 ;; Created:    <2008-04-02>
   8 ;; Homepage:   http://www.sxemacs.org
   9 ;; Keywords:   ffi, file, magic, extension
  10
  11 ;; This file is part of SXEmacs.
  12
  13 ;; Redistribution and use in source and binary forms, with or without
  14 ;; modification, are permitted provided that the following conditions
  15 ;; are met:
  16 ;;
  17 ;; 1. Redistributions of source code must retain the above copyright
  18 ;;    notice, this list of conditions and the following disclaimer.
  19 ;;
  20 ;; 2. Redistributions in binary form must reproduce the above copyright
  21 ;;    notice, this list of conditions and the following disclaimer in the
  22 ;;    documentation and/or other materials provided with the distribution.
  23 ;;
  24 ;; 3. Neither the name of the author nor the names of any contributors
  25 ;;    may be used to endorse or promote products derived from this
  26 ;;    software without specific prior written permission.
  27 ;;
  28 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  29 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  30 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  31 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  32 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  33 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  34 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  35 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  36 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  37 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  38 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  39
  40 ;;; Commentary:
  41 ;;
  42 ;;    Mimic file(1)'s basic usage.  At the moment, this is quite raw
  43 ;;    and single-minded.  It will only use the default magic db and
  44 ;;    doesn't allow use of any of file(1)'s options.
  45 ;;
  46 ;;    (magic:file-type (expand-file-name "about.el" lisp-directory))
  47 ;;     => "Lisp/Scheme program, ISO-8859 text"
  48
  49 ;;; Todo:
  50 ;;
  51 ;;    o Optionally output MIME type strings like "text/plain",
  52 ;;      "applicaton/octet-stream"
  53 ;;
  54 ;;    o Other options from file(1).
  55
  56 ;;; Code:
  57 (require 'ffi)
  58 (require 'ffi-libc)
  59
  60 ;; Can't do anything without this
  61 (ffi-load "libmagic")
  62
  63 (defvar ffi-magic-shared nil
  64   "Shared context with preloaded magic file, to speed up things.")
  65
  66 \f
  67 (define-ffi-type magic_t pointer)
  68
  69 (define-ffi-function magic-open (flag)
  70   "Call libmagic's magic_open()."
  71   '(function magic_t int)
  72   "magic_open")
  73
  74 (define-ffi-function magic-load (magic magicfile)
  75   "Call libmagic's magic_load()."
  76   '(function int magic_t c-string)
  77   "magic_load")
  78
  79 (define-ffi-function magic-file (magic file)
  80   "Call libmagic's magic_file()."
  81   '(function safe-string magic_t c-string)
  82   "magic_file")
  83
  84 (define-ffi-function magic-close (magic)
  85   "Call libmagic's magic_close()."
  86   '(function void magic_t)
  87   "magic_close")
  88
  89 (define-ffi-function magic-error (magic)
  90   "Call libmagic's magic_error()."
  91   '(function safe-string magic_t)
  92   "magic_error")
  93
  94 ;;;###autoload
  95 (defun magic:file-type (file)
  96   "Return as a string what type FILE is using libmagic."
  97   (interactive "fFile name: ")
  98   (unless ffi-magic-shared
  99     (setq ffi-magic-shared (magic-open 0))
 100     (magic-load ffi-magic-shared (ffi-null-pointer)))
 101
 102   (let ((ftype (magic-file ffi-magic-shared (expand-file-name file))))
 103     (if (interactive-p)
 104         (message ftype)
 105       ftype)))
 106
 107 (defun magic:error (&optional magic)
 108   (magic-error (or magic ffi-magic-shared)))
 109
 110 (provide 'ffi-magic)
 111 ;;; ffi-magic.el ends here