code.delx.au - gnu-emacs-elpa/blob - packages/quarter-plane/quarter-plane.el

   1 ;;; quarter-plane.el --- editing using quarter-plane screen model
   2
   3 ;; Copyright (C) 2011  Free Software Foundation, Inc.
   4
   5 ;; Author: Peter J. Weisberg
   6 ;; Version: 0.1
   7 ;; Keywords: convenience wp
   8
   9 ;; This program 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 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; This code provides a minor mode to enable the some of picture-mode
  25 ;; commands documented in the Emacs manual in order to treat the
  26 ;; screen as a semi-infinite quarter-plane, without changing the
  27 ;; buffer's major mode.
  28
  29 ;; Known issues:
  30
  31 ;; Quarter-Plane mode doesn't work in read-only buffers, where it
  32 ;; can't insert spaces.
  33
  34 ;; The user doesn't really care about the "modifications" of adding
  35 ;; whitespace that's going to be trimmed when he exits quarter-plane
  36 ;; mode or saves, but it's still part of the undo history.
  37
  38 ;; Both of these are due to the disconnect between what the user
  39 ;; really wants--movement of the cursor within the window, regardless
  40 ;; of where the text is--and what the mode can actually do--add dummy
  41 ;; text to give the cursor a place to move to.
  42
  43 ;;; Code:
  44
  45 (require 'picture)
  46
  47 (defvar quarter-plane-mode-map
  48   (let ((map (make-sparse-keymap)))
  49     (define-key map [remap right-char] 'picture-forward-column)
  50     (define-key map [remap forward-char] 'picture-forward-column)
  51     (define-key map [remap previous-line] 'picture-move-up)
  52     (define-key map [remap next-line] 'picture-move-down)
  53     (define-key map [remap mouse-set-point] 'picture-mouse-set-point)
  54     map))
  55
  56 (defconst quarter-plane-saved-symbols
  57   '(truncate-lines show-trailing-whitespace)
  58   "Buffer-local variables whose modified by `quarter-plane-mode`.
  59 Their values are saved when `quarter-plane-mode` is enabled and restored
  60 when it's disabled.")
  61
  62 (defvar quarter-plane-saved-values)
  63 (make-variable-buffer-local 'quarter-plane-saved-values)
  64 (put 'quarter-plane-saved-values 'permanent-local t)
  65
  66 ;;;###autoload
  67 (define-minor-mode quarter-plane-mode
  68   "Toggle Quarter-Plane mode on or off.
  69 Interactively, with no prefix argument, toggle the mode.
  70 With universal prefix ARG turn mode on.
  71 With zero or negative ARG turn mode off.
  72
  73 Use point movement commands that act as if the text extended
  74 infinitely down and to the right, inserting spaces as necessary.
  75 Excess whitespace is trimmed when saving or exiting Quarter-Plane mode.
  76
  77 Because it works by inserting spaces, Quarter-Plane mode won't work in
  78 read-only buffers
  79
  80 \\{quarter-plane-mode-map}"
  81   :lighter " Plane"
  82   :group 'picture
  83   :keymap quarter-plane-mode-map
  84   (cond
  85    (quarter-plane-mode
  86     (add-hook 'before-save-hook 'quarter-plane-delete-whitespace nil t)
  87     (setq quarter-plane-saved-values nil)
  88     (dolist (sym quarter-plane-saved-symbols)
  89       (push (symbol-value sym) quarter-plane-saved-values))
  90     (setq quarter-plane-saved-values (nreverse quarter-plane-saved-values))
  91     (setq truncate-lines t)
  92     (setq show-trailing-whitespace nil))
  93    (t
  94     (remove-hook 'before-save-hook 'quarter-plane-delete-whitespace t)
  95     (dolist (sym quarter-plane-saved-symbols)
  96       (set sym (pop quarter-plane-saved-values))))))
  97
  98 ;;;###autoload
  99 (define-global-minor-mode global-quarter-plane-mode quarter-plane-mode
 100   turn-on-quarter-plane-mode
 101   :group 'picture)
 102
 103 (defun quarter-plane-delete-whitespace ()
 104   "Call `delete-trailing-whitespace' if the buffer is not read-only."
 105   (if (not buffer-read-only)
 106       (delete-trailing-whitespace)))
 107
 108 (add-hook 'quarter-plane-mode-off-hook 'quarter-plane-delete-whitespace)
 109
 110 (provide 'quarter-plane)
 111
 112 ;;; quarter-plane.el ends here