code.delx.au - gnu-emacs-elpa/blob - packages/vlf/vlf-integrate.el

   1 ;;; vlf-integrate.el --- VLF integration with other packages  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5 ;; Keywords: large files, integration
   6 ;; Author: Andrey Kotlarski <m00naticus@gmail.com>
   7 ;; URL: https://github.com/m00natic/vlfi
   8
   9 ;; This file is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 3, or (at your option)
  12 ;; any later version.
  13
  14 ;; This file is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25 ;; This package enables VLF play seamlessly with rest of Emacs.
  26
  27 ;;; Code:
  28
  29 (defgroup vlf nil "View Large Files in Emacs."
  30   :prefix "vlf-" :group 'files)
  31
  32 (defcustom vlf-application 'ask
  33   "Determines when `vlf' will be offered on opening files.
  34 Possible values are: nil to never use it;
  35 `ask' offer `vlf' when file size is beyond `large-file-warning-threshold';
  36 `dont-ask' automatically use `vlf' for large files;
  37 `always' use `vlf' for all files."
  38   :group 'vlf :type '(radio (const :format "%v " nil)
  39                             (const :format "%v " ask)
  40                             (const :format "%v " dont-ask)
  41                             (const :format "%v" always)))
  42
  43 (defcustom vlf-forbidden-modes-list
  44   '(archive-mode tar-mode jka-compr git-commit-mode image-mode
  45                  doc-view-mode doc-view-mode-maybe ebrowse-tree-mode)
  46   "Major modes which VLF will not be automatically applied to."
  47   :group 'vlf :type '(list symbol))
  48
  49 (unless (fboundp 'file-size-human-readable)
  50   (defun file-size-human-readable (file-size)
  51     "Print FILE-SIZE in MB."
  52     (format "%.3fMB" (/ file-size 1048576.0))))
  53
  54 (defun vlf-determine-major-mode (filename)
  55   "Determine major mode from FILENAME."
  56   (let ((name filename)
  57         (remote-id (file-remote-p filename))
  58         mode)
  59     ;; Remove backup-suffixes from file name.
  60     (setq name (file-name-sans-versions name))
  61     ;; Remove remote file name identification.
  62     (and (stringp remote-id)
  63          (string-match (regexp-quote remote-id) name)
  64          (setq name (substring name (match-end 0))))
  65     (setq mode
  66           (if (memq system-type '(windows-nt cygwin))
  67               ;; System is case-insensitive.
  68               (let ((case-fold-search t))
  69                 (assoc-default name auto-mode-alist 'string-match))
  70             ;; System is case-sensitive.
  71             (or ;; First match case-sensitively.
  72              (let ((case-fold-search nil))
  73                (assoc-default name auto-mode-alist 'string-match))
  74              ;; Fallback to case-insensitive match.
  75              (and auto-mode-case-fold
  76                   (let ((case-fold-search t))
  77                     (assoc-default name auto-mode-alist
  78                                    'string-match))))))
  79     (if (and mode (consp mode))
  80         (cadr mode)
  81       mode)))
  82
  83 (autoload 'vlf "vlf" "View Large FILE in batches." t)
  84
  85 (defadvice abort-if-file-too-large (around vlf-if-file-too-large
  86                                            compile activate)
  87   "If file SIZE larger than `large-file-warning-threshold', \
  88 allow user to view file with `vlf', open it normally, or abort.
  89 OP-TYPE specifies the file operation being performed over FILENAME."
  90   (cond
  91    ((or (not size) (zerop size)))
  92    ((or (not vlf-application)
  93         (not filename)
  94         (memq (vlf-determine-major-mode filename)
  95               vlf-forbidden-modes-list))
  96     ad-do-it)
  97    ((eq vlf-application 'always)
  98     (vlf filename)
  99     (error ""))
 100    ((and large-file-warning-threshold
 101          (< large-file-warning-threshold size))
 102     (if (eq vlf-application 'dont-ask)
 103         (progn (vlf filename)
 104                (error ""))
 105       (let ((char nil))
 106         (while (not (memq (setq char
 107                                 (read-event
 108                                  (propertize
 109                                   (format
 110                                    "File %s is large (%s): \
 111 %s normally (o), %s with vlf (v) or abort (a)"
 112                                    (if filename
 113                                        (file-name-nondirectory filename)
 114                                      "")
 115                                    (file-size-human-readable size)
 116                                    op-type op-type)
 117                                   'face 'minibuffer-prompt)))
 118                           '(?o ?O ?v ?V ?a ?A))))
 119         (cond ((memq char '(?v ?V))
 120                (vlf filename)
 121                (error ""))
 122               ((memq char '(?a ?A))
 123                (error "Aborted"))))))))
 124
 125 ;; disable for some functions
 126 (defmacro vlf-disable-for-function (func file)
 127   "Build advice to disable VLF during execution of FUNC\
 128 defined in FILE."
 129   `(eval-after-load ,file
 130      '(defadvice ,func (around ,(intern (concat "vlf-"
 131                                                 (symbol-name func)))
 132                                compile activate)
 133         "Temporarily disable `vlf-mode'."
 134         (let ((vlf-application nil))
 135           ad-do-it))))
 136
 137 (vlf-disable-for-function tags-verify-table "etags")
 138 (vlf-disable-for-function tag-find-file-of-tag-noselect "etags")
 139 (vlf-disable-for-function helm-etags-create-buffer "helm-tags")
 140
 141 ;; dired
 142 (defun dired-vlf ()
 143   "In Dired, visit the file on this line in VLF mode."
 144   (interactive)
 145   (vlf (dired-get-file-for-visit)))
 146
 147 (eval-after-load "dired"
 148   '(define-key dired-mode-map "V" 'dired-vlf))
 149
 150 (provide 'vlf-integrate)
 151
 152 ;;; vlf-integrate.el ends here