Last edit
Summary: bugfix
Changed:
< ;; $Id: viewer.el,v 1.12 2012/12/31 11:38:16 rubikitch Exp $
to
> ;; $Id: viewer.el,v 1.13 2013/03/14 23:37:05 rubikitch Exp $
Added:
> ;; Revision 1.13 2013/03/14 23:37:05 rubikitch
> ;; Rename obsolete face name: modeline -> mode-line
> ;;
Changed:
< (defvar viewer-version "$Id: viewer.el,v 1.12 2012/12/31 11:38:16 rubikitch Exp $")
to
> (defvar viewer-version "$Id: viewer.el,v 1.13 2013/03/14 23:37:05 rubikitch Exp $")
Changed:
< (defvar viewer-modeline-color-default (face-background 'modeline))
to
> (defvar viewer-modeline-color-default (face-background 'mode-line))
Changed:
< 'modeline
to
> 'mode-line
;;; viewer.el --- View-mode extension ;; $Id: viewer.el,v 1.13 2013/03/14 23:37:05 rubikitch Exp $ ;; Copyright (C) 2009 rubikitch ;; Author: rubikitch <rubikitch@ruby-lang.org> ;; Keywords: view, extensions ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/viewer.el ;; This file 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 2, or (at your option) ;; any later version. ;; This file 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. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Viewer is view-mode extension. View-mode is finger-friendly than ;; normal editing because of many alphabetical commands. Let's use ;; view-mode more to protect our pinky. ;;; Commands: ;; ;; Below are complete command list: ;; ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;; `view-mode-by-default-regexp' ;; *Regexp of file name to open by `view-mode'. ;; default = nil ;; `viewer-aggressive-minimum-size' ;; *Minimum file size to enable aggressive view-mode. ;; default = 100 ;; `viewer-aggressive-writable' ;; *When non-nil, aggressive view-mode buffer is writable. ;; default = t ;; `viewer-modeline-color-unwritable' ;; *Modeline color when file is not writable. ;; default = "tomato" ;; `viewer-modeline-color-view' ;; *Modeline color for `view-mode'. ;; default = "orange" ;; This package provides: ;; * specify files to open by `view-mode' by default. ;; * stay in `view-mode' in unwritable files. ;; * indicate `view-mode' by modeline color. ;; * override default `view-mode-map' for major modes. ;; * open ANY files by `view-mode' for enthusiasts. ;;; Installation: ;; Put viewer.el to your load-path. ;; The load-path is usually ~/elisp/. ;; It's set in your ~/.emacs like this: ;; (add-to-list 'load-path (expand-file-name "~/elisp")) ;; ;; And the following to your ~/.emacs startup file. ;; ;; (require 'viewer) ;; (viewer-stay-in-setup) ;; (setq viewer-modeline-color-unwritable "tomato" ;; viewer-modeline-color-view "orange") ;; (viewer-change-modeline-color-setup) ;; ;; If you want to open any file by `view-mode', add the following: ;; (viewer-aggressive-setup 'force) ;; ;; Note that the command `view-mode' should be bound in easy-to-type ;; key. ;; ;; If you want to open any file matching a regexp, add the following: ;; (setq view-mode-by-default-regexp "/regexp-to-path") ;; ;; No need more. ;;; Customize: ;; ;; All of the above can customize by: ;; M-x customize-group RET viewer RET ;; ;;; Tips: ;; Defining major-mode specific `view-mode' is useful. ;; See `define-overriding-view-mode-map'. ;; ;; [EVAL IT] (describe-function 'define-overriding-view-mode-map) ;;; Bug Report: ;; ;; If you have problem, send a bug report via M-x viewer-send-bug-report. ;; The step is: ;; 0) Setup mail in Emacs, the easiest way is: ;; (setq user-mail-address "your@mail.address") ;; (setq user-full-name "Your Full Name") ;; (setq smtpmail-smtp-server "your.smtp.server.jp") ;; (setq mail-user-agent 'message-user-agent) ;; (setq message-send-mail-function 'message-smtpmail-send-it) ;; 1) Be sure to use the LATEST version of viewer.el. ;; 2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t) ;; 3) Use Lisp version instead of compiled one: (load "viewer.el") ;; 4) Do it! ;; 5) If you got an error, please do not close *Backtrace* buffer. ;; 6) M-x viewer-send-bug-report and M-x insert-buffer *Backtrace* ;; 7) Describe the bug using a precise recipe. ;; 8) Type C-c C-c to send. ;; # If you are a Japanese, please write in Japanese:-) ;;; History: ;; $Log: viewer.el,v $ ;; Revision 1.13 2013/03/14 23:37:05 rubikitch ;; Rename obsolete face name: modeline -> mode-line ;; ;; Revision 1.12 2012/12/31 11:38:16 rubikitch ;; viewer-change-modeline-color: fix advice of select-window ;; ;; Revision 1.11 2012/06/25 10:19:18 rubikitch ;; Bugfix: error when edebug.el is not loaded. ;; ;; Revision 1.10 2012/06/19 15:27:53 rubikitch ;; You can exit view-mode if `edebug-active' is non-nil. ;; ;; Revision 1.9 2012/06/12 01:05:53 rubikitch ;; erase warning ;; ;; Revision 1.8 2012/06/12 01:03:40 rubikitch ;; set viewer-stay-in-unless-writable advice for `view-mode' ;; ;; Revision 1.7 2012/01/16 14:46:49 rubikitch ;; viewer-change-modeline-color-setup: Use window-configuration-change-hook ;; ;; Revision 1.6 2010/10/30 12:13:10 rubikitch ;; viewer-install-extension: call only if view-mode is enabled because (view-mode -1) on emacs24 calls it. mystery. ;; ;; Revision 1.5 2010/05/04 08:56:49 rubikitch ;; Added bug report command ;; ;; Revision 1.4 2009/03/11 08:52:12 rubikitch ;; fix bug in `aggressive-view-mode' ;; ;; Revision 1.3 2009/02/19 02:50:02 rubikitch ;; * view-mode by default ;; * update doc ;; ;; Revision 1.2 2009/02/18 23:57:11 rubikitch ;; * Aggressive view-mode ;; * Stay in view-mode ;; * Change mode-line color ;; ;; Revision 1.1 2009/02/18 15:04:14 rubikitch ;; Initial revision ;; ;;; Code: (defvar viewer-version "$Id: viewer.el,v 1.13 2013/03/14 23:37:05 rubikitch Exp $") (require 'view) (eval-when-compile (require 'cl)) ;;;; (@* "Overriding view-mode keymap") (defun define-overriding-view-mode-map-internal (mode-name key-bindings) (let ((mapsym (intern (concat (symbol-name mode-name) "-view-map"))) (view-mode-sym (intern (concat (symbol-name mode-name) "-view-mode")))) (eval `(defvar ,mapsym nil)) (let ((map (make-sparse-keymap))) (loop for (key . command) in key-bindings do (define-key map (read-kbd-macro key) command)) (set mapsym map) (setq minor-mode-map-alist (cons (cons view-mode-sym map) (delete (assq view-mode-sym minor-mode-map-alist) minor-mode-map-alist))) nil))) (defmacro define-overriding-view-mode-map (mode-name &rest key-bindings) "Define major-mode specific view-mode keymap. Note that the car of an element of KEY-BINDINGS is `kbd' notation. For example, to define `view-mode' keys for `emacs-lisp-mode': (define-overriding-view-mode-map emacs-lisp-mode (\"C-m\" . find-function) (\"C-j\" . find-variable)) " `(define-overriding-view-mode-map-internal ',mode-name ',key-bindings)) (defun viewer-install-extension () (when view-mode (set (make-local-variable (intern (concat (symbol-name major-mode) "-view-mode"))) t))) (add-hook 'view-mode-hook 'viewer-install-extension) (defun viewer-uninstall-extension () (kill-local-variable (intern (concat (symbol-name major-mode) "-view-mode")))) (defadvice view-mode-disable (before viewer activate) (viewer-uninstall-extension)) ;;;; (@* "View-mode by default") (defcustom view-mode-by-default-regexp nil "*Regexp of file name to open by `view-mode'." :type 'string :group 'viewer) (defun view-mode-by-default-setup () (when (and buffer-file-name view-mode-by-default-regexp (string-match view-mode-by-default-regexp buffer-file-name)) (view-mode 1) (message "view-mode by view-mode-by-default-regexp."))) (add-hook 'find-file-hook 'view-mode-by-default-setup) ;;;; (@* "Aggressive view-mode") (defgroup viewer nil "View-mode extensions" :group 'view) (defcustom viewer-aggressive-minimum-size 100 "*Minimum file size to enable aggressive view-mode." :type 'integer :group 'viewer) (defcustom viewer-aggressive-writable t "*When non-nil, aggressive view-mode buffer is writable." :type 'boolean :group 'viewer) (defadvice find-file-noselect (after switch-to-view-file) (when (bufferp ad-return-value) (with-current-buffer ad-return-value (aggressive-view-mode)))) (defun aggressive-view-mode () (when (and buffer-file-name (> (buffer-size) viewer-aggressive-minimum-size) (file-regular-p buffer-file-name)) (view-mode 1) (setq buffer-read-only (not (file-writable-p buffer-file-name))))) ;; (describe-function 'find-file-noselect) ;; (memq 'aggressive-view-mode find-file-hook) ;; (viewer-aggressive-setup nil) ;; (viewer-aggressive-setup t) ;; (viewer-aggressive-setup 'force) (defun viewer-aggressive-setup (arg) "Setup aggressive `view-mode'. When ARG is t, all new files are opened by `view-mode'. When ARG is 'force, enable `view-mode' even if file buffer is selected. When ARG is nil, uninstall it." (case arg ('force (remove-hook 'find-file-hook 'aggressive-view-mode) (ad-enable-advice 'find-file-noselect 'after 'switch-to-view-file) (ad-update 'find-file-noselect)) (nil (remove-hook 'find-file-hook 'aggressive-view-mode) (ad-disable-advice 'find-file-noselect 'after 'switch-to-view-file) (ad-update 'find-file-noselect)) (t (add-hook 'find-file-hook 'aggressive-view-mode) (ad-disable-advice 'find-file-noselect 'after 'switch-to-view-file) (ad-update 'find-file-noselect)))) ;;;; (@* "Stay in view-mode") (defvar view-mode-force-exit nil) (defmacro viewer-stay-in-unless-writable-advice (f) `(defadvice ,f (around viewer-stay-in-unless-writable activate) (if (or view-mode-force-exit (and (boundp 'edebug-active) edebug-active) (not (and view-mode (buffer-file-name) (not (file-writable-p (buffer-file-name)))))) ad-do-it (message "File is unwritable, so stay in view-mode.")))) (defun view-mode-force-exit () (interactive) (let ((view-mode-force-exit t)) (view-mode-exit))) (defun viewer-stay-in-setup () "Setup stay-in view-mode. Stay in `view-mode' when the file is unwritable." (viewer-stay-in-unless-writable-advice view-mode) (viewer-stay-in-unless-writable-advice view-mode-exit) (viewer-stay-in-unless-writable-advice view-mode-disable)) ;;;; (@* "Change mode-line color") (defvar viewer-modeline-color-default (face-background 'mode-line)) (defcustom viewer-modeline-color-unwritable "tomato" "*Modeline color when file is not writable." :type 'string :group 'viewer) (defcustom viewer-modeline-color-view "orange" "*Modeline color for `view-mode'." :type 'string :group 'viewer) (defun viewer-change-modeline-color () (interactive) (when (eq (selected-window) (get-buffer-window (current-buffer))) (set-face-background 'mode-line (cond ((and buffer-file-name view-mode (not (file-writable-p buffer-file-name))) viewer-modeline-color-unwritable) (view-mode viewer-modeline-color-view) (t viewer-modeline-color-default))) (force-mode-line-update))) (defmacro viewer-change-modeline-color-advice (f) `(defadvice ,f (after change-mode-line-color activate) (viewer-change-modeline-color))) (defun viewer-change-modeline-color-setup () "Setup coloring modeline. See also `viewer-modeline-color-unwritable' and `viewer-modeline-color-view'." (add-hook 'window-configuration-change-hook 'viewer-change-modeline-color) (viewer-change-modeline-color-advice toggle-read-only) (viewer-change-modeline-color-advice view-mode-enable) (viewer-change-modeline-color-advice view-mode-disable) (viewer-change-modeline-color-advice other-window) (defadvice select-window (around change-modeline-color activate) (let ((curwin (selected-window)) (destwin (ad-get-arg 0))) ad-do-it (unless (or (called-interactively-p 'any) (eq curwin destwin)) (viewer-change-modeline-color)))) (viewer-change-modeline-color-advice select-frame) nil) ;;;; Bug report (defvar viewer-maintainer-mail-address (concat "rubiki" "tch@ru" "by-lang.org")) (defvar viewer-bug-report-salutation "Describe bug below, using a precise recipe. When I executed M-x ... How to send a bug report: 1) Be sure to use the LATEST version of viewer.el. 2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t) 3) Use Lisp version instead of compiled one: (load \"viewer.el\") 4) If you got an error, please paste *Backtrace* buffer. 5) Type C-c C-c to send. # If you are a Japanese, please write in Japanese:-)") (defun viewer-send-bug-report () (interactive) (reporter-submit-bug-report viewer-maintainer-mail-address "viewer.el" (apropos-internal "^view" 'boundp) nil nil viewer-bug-report-salutation)) (provide 'viewer) ;; How to save (DO NOT REMOVE!!) ;; (emacswiki-post "viewer.el") ;;; viewer.el ends here