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

   1 ;;; vlf-setup.el --- VLF integration with other packages  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014-2015 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 (defvar dired-mode-map)
  54 (declare-function dired-get-file-for-visit "dired")
  55
  56 (unless (fboundp 'file-size-human-readable)
  57   (defun file-size-human-readable (file-size)
  58     "Print FILE-SIZE in MB."
  59     (format "%.3fMB" (/ file-size 1048576.0))))
  60
  61 (defun vlf-determine-major-mode (filename)
  62   "Determine major mode from FILENAME."
  63   (let ((name filename)
  64         (remote-id (file-remote-p filename))
  65         mode)
  66     ;; Remove backup-suffixes from file name.
  67     (setq name (file-name-sans-versions name))
  68     ;; Remove remote file name identification.
  69     (and (stringp remote-id)
  70          (string-match (regexp-quote remote-id) name)
  71          (setq name (substring name (match-end 0))))
  72     (setq mode
  73           (if (memq system-type '(windows-nt cygwin))
  74               ;; System is case-insensitive.
  75               (let ((case-fold-search t))
  76                 (assoc-default name auto-mode-alist 'string-match))
  77             ;; System is case-sensitive.
  78             (or ;; First match case-sensitively.
  79              (let ((case-fold-search nil))
  80                (assoc-default name auto-mode-alist 'string-match))
  81              ;; Fallback to case-insensitive match.
  82              (and auto-mode-case-fold
  83                   (let ((case-fold-search t))
  84                     (assoc-default name auto-mode-alist
  85                                    'string-match))))))
  86     (if (and mode (consp mode))
  87         (cadr mode)
  88       mode)))
  89
  90 (autoload 'vlf "vlf" "View Large FILE in batches." t)
  91
  92 (defadvice abort-if-file-too-large (around vlf-if-file-too-large
  93                                            compile activate)
  94   "If file SIZE larger than `large-file-warning-threshold', \
  95 allow user to view file with `vlf', open it normally, or abort.
  96 OP-TYPE specifies the file operation being performed over FILENAME."
  97   (cond
  98    ((or (not size) (zerop size)))
  99    ((or (not vlf-application)
 100         (not filename)
 101         (memq (vlf-determine-major-mode filename)
 102               vlf-forbidden-modes-list))
 103     ad-do-it)
 104    ((eq vlf-application 'always)
 105     (vlf filename)
 106     (error ""))
 107    ((and large-file-warning-threshold
 108          (< large-file-warning-threshold size)
 109          (< vlf-batch-size size))
 110     (if (eq vlf-application 'dont-ask)
 111         (progn (vlf filename)
 112                (error ""))
 113       (let ((char nil))
 114         (while (not (memq (setq char
 115                                 (read-event
 116                                  (propertize
 117                                   (format
 118                                    "File %s is large (%s): \
 119 %s normally (o), %s with vlf (v) or abort (a)"
 120                                    (if filename
 121                                        (file-name-nondirectory filename)
 122                                      "")
 123                                    (file-size-human-readable size)
 124                                    op-type op-type)
 125                                   'face 'minibuffer-prompt)))
 126                           '(?o ?O ?v ?V ?a ?A))))
 127         (cond ((memq char '(?v ?V))
 128                (vlf filename)
 129                (error ""))
 130               ((memq char '(?a ?A))
 131                (error "Aborted"))))))))
 132
 133 ;; disable for some functions
 134 (defmacro vlf-disable-for-function (func file)
 135   "Build advice to disable VLF during execution of FUNC\
 136 defined in FILE."
 137   `(eval-after-load ,file
 138      '(defadvice ,func (around ,(intern (concat "vlf-"
 139                                                 (symbol-name func)))
 140                                compile activate)
 141         "Temporarily disable `vlf-mode'."
 142         (let ((vlf-application nil))
 143           ad-do-it))))
 144
 145 (vlf-disable-for-function tags-verify-table "etags")
 146 (vlf-disable-for-function tag-find-file-of-tag-noselect "etags")
 147 (vlf-disable-for-function helm-etags-create-buffer "helm-tags")
 148
 149 ;; dired
 150 (defun dired-vlf ()
 151   "In Dired, visit the file on this line in VLF mode."
 152   (interactive)
 153   (vlf (dired-get-file-for-visit)))
 154
 155 (eval-after-load "dired"
 156   '(define-key dired-mode-map "V" 'dired-vlf))
 157
 158 (provide 'vlf-setup)
 159
 160 ;;; vlf-setup.el ends here