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-batch-size 1000000
  33   "Defines how large each batch of file data initially is (in bytes)."
  34   :group 'vlf :type 'integer)
  35
  36 (defcustom vlf-application 'ask
  37   "Determines when `vlf' will be offered on opening files.
  38 Possible values are: nil to never use it;
  39 `ask' offer `vlf' when file size is beyond `large-file-warning-threshold';
  40 `dont-ask' automatically use `vlf' for large files;
  41 `always' use `vlf' for all files."
  42   :group 'vlf :type '(radio (const :format "%v " nil)
  43                             (const :format "%v " ask)
  44                             (const :format "%v " dont-ask)
  45                             (const :format "%v" always)))
  46
  47 (defcustom vlf-forbidden-modes-list
  48   '(archive-mode tar-mode jka-compr git-commit-mode image-mode
  49                  doc-view-mode doc-view-mode-maybe ebrowse-tree-mode)
  50   "Major modes which VLF will not be automatically applied to."
  51   :group 'vlf :type '(list symbol))
  52
  53 (unless (fboundp 'file-size-human-readable)
  54   (defun file-size-human-readable (file-size)
  55     "Print FILE-SIZE in MB."
  56     (format "%.3fMB" (/ file-size 1048576.0))))
  57
  58 (defun vlf-determine-major-mode (filename)
  59   "Determine major mode from FILENAME."
  60   (let ((name filename)
  61         (remote-id (file-remote-p filename))
  62         mode)
  63     ;; Remove backup-suffixes from file name.
  64     (setq name (file-name-sans-versions name))
  65     ;; Remove remote file name identification.
  66     (and (stringp remote-id)
  67          (string-match (regexp-quote remote-id) name)
  68          (setq name (substring name (match-end 0))))
  69     (setq mode
  70           (if (memq system-type '(windows-nt cygwin))
  71               ;; System is case-insensitive.
  72               (let ((case-fold-search t))
  73                 (assoc-default name auto-mode-alist 'string-match))
  74             ;; System is case-sensitive.
  75             (or ;; First match case-sensitively.
  76              (let ((case-fold-search nil))
  77                (assoc-default name auto-mode-alist 'string-match))
  78              ;; Fallback to case-insensitive match.
  79              (and auto-mode-case-fold
  80                   (let ((case-fold-search t))
  81                     (assoc-default name auto-mode-alist
  82                                    'string-match))))))
  83     (if (and mode (consp mode))
  84         (cadr mode)
  85       mode)))
  86
  87 (autoload 'vlf "vlf" "View Large FILE in batches." t)
  88
  89 (defadvice abort-if-file-too-large (around vlf-if-file-too-large
  90                                            compile activate)
  91   "If file SIZE larger than `large-file-warning-threshold', \
  92 allow user to view file with `vlf', open it normally, or abort.
  93 OP-TYPE specifies the file operation being performed over FILENAME."
  94   (cond
  95    ((or (not size) (zerop size)))
  96    ((or (not vlf-application)
  97         (not filename)
  98         (memq (vlf-determine-major-mode filename)
  99               vlf-forbidden-modes-list))
 100     ad-do-it)
 101    ((eq vlf-application 'always)
 102     (vlf filename)
 103     (error ""))
 104    ((and large-file-warning-threshold
 105          (< large-file-warning-threshold size)
 106          (< vlf-batch-size size))
 107     (if (eq vlf-application 'dont-ask)
 108         (progn (vlf filename)
 109                (error ""))
 110       (let ((char nil))
 111         (while (not (memq (setq char
 112                                 (read-event
 113                                  (propertize
 114                                   (format
 115                                    "File %s is large (%s): \
 116 %s normally (o), %s with vlf (v) or abort (a)"
 117                                    (if filename
 118                                        (file-name-nondirectory filename)
 119                                      "")
 120                                    (file-size-human-readable size)
 121                                    op-type op-type)
 122                                   'face 'minibuffer-prompt)))
 123                           '(?o ?O ?v ?V ?a ?A))))
 124         (cond ((memq char '(?v ?V))
 125                (vlf filename)
 126                (error ""))
 127               ((memq char '(?a ?A))
 128                (error "Aborted"))))))))
 129
 130 ;; disable for some functions
 131 (defmacro vlf-disable-for-function (func file)
 132   "Build advice to disable VLF during execution of FUNC\
 133 defined in FILE."
 134   `(eval-after-load ,file
 135      '(defadvice ,func (around ,(intern (concat "vlf-"
 136                                                 (symbol-name func)))
 137                                compile activate)
 138         "Temporarily disable `vlf-mode'."
 139         (let ((vlf-application nil))
 140           ad-do-it))))
 141
 142 (vlf-disable-for-function tags-verify-table "etags")
 143 (vlf-disable-for-function tag-find-file-of-tag-noselect "etags")
 144 (vlf-disable-for-function helm-etags-create-buffer "helm-tags")
 145
 146 ;; dired
 147 (defun dired-vlf ()
 148   "In Dired, visit the file on this line in VLF mode."
 149   (interactive)
 150   (vlf (dired-get-file-for-visit)))
 151
 152 (eval-after-load "dired"
 153   '(define-key dired-mode-map "V" 'dired-vlf))
 154
 155 (provide 'vlf-integrate)
 156
 157 ;;; vlf-integrate.el ends here