;;; SHIFT-MODE.EL - minor mode to change indent level
;;; Copyright (C) 2000-2009 Robert Wyrick (rob@wyrick.org)
;;
;; SUMMARY: minor mode to make shifting text left/right easy.
;;
;; INSTALLATION INSTRUCTIONS:
;;
;; Install this file somewhere in your load path, byte-compile it and
;; add the following to your .emacs file (remove the comment
;; delimiters ;-)
;;
;;     (require 'shift-mode)
;;     (global-set-key [(meta left)] 'shift-region-left)
;;     (global-set-key [(meta right)] 'shift-region-right)
;;     (global-set-key (quote [27 left]) 'shift-region-left)
;;     (global-set-key (quote [27 right]) 'shift-region-right)
;;
;; USAGE INSTRUCTIONS:
;;
;;  If installed like above, the Meta-Left and Meta-Right keys will
;;  enter shift-mode... you of course can bind that whereever you want it.
;;
;; `M-Left'  Enter shift mode and move highlighted text one character to the left.
;; `M-Right' Enter shift mode and move highlighted text one character to the right.
;;
;; Once in shift mode, the following keys are re-bound:
;;
;; `Left'    Move highlighted text one character to the left.
;; `Right'   Move highlighted text one character to the right.
;; `Up'      Increase the number of spaces you will be shifting by.
;; `Down'    Decrease the number of spaces you will be shifting by.
;; `C-g'     Turn off shift mode.
;; `C-Space' Turn off shift mode.
;;
;; Known bugs:
;;   none
;;
;; COMMENTARY:
;;
;; This minor mode assists code developers in changing the "indent" level of large
;; sections of code.  I know we all usually let emacs (re)indent our code, but if
;; for some reason you want the control... here it is.  It is especially useful
;; for inserting a column of spaces in between stuff... i.e
;; changing THIS:
;;     int   a;
;;     char* b;
;;     void* c;
;;     ANewLongerTypename* d;
;; to THIS:
;;     int                 a;
;;     char*               b;
;;     void*               c;
;;     ANewLongerTypename* d;
;; is simply a matter of placing the cursor on the 'a' in the first line,
;; setting the mark, going down two lines and pressing 'M-Right' to enter
;; shift-mode.  Once in shift mode, use the left/right cursor keys to
;; move the text to where you want it then press 'C-g' to exit.

;;; LICENSE:

;;; This program 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 1, or (at your option)
;;; any later version.

;;; This program 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.

;;; A copy of the GNU General Public License can be obtained from 
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.

(defconst shift-mode-version "1.2"
  "Report bugs to: Robert Wyrick <rob@wyrick.org>")

;;; CHANGE HISTORY
;;;
;;; 1.0 - Jun 20, 2003
;;;   First public release - I've been using it for over 3 years now without problems.
;;; 1.1 - Dec 16, 2003
;;;   Bug fix - when some lines in the region were shorter than others, and the
;;;   starting column was past the end of those short lines, there was some weird
;;;   behavior.  This has been fixed.
;;; 1.2 - Aug 26, 2009
;;;   Bug fix - Text could get deleted when shifting left by more than 1.

(defvar shift-mode nil
  "Whether shift mode is on or not")
(make-variable-buffer-local 'shift-mode)

(defvar shift-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [left]  'shift-region-left)
    (define-key map [right] 'shift-region-right)
    (define-key map [up]    'shift-increment)
    (define-key map [down]  'shift-decrement)
    (define-key map [?\C-g] 'shift-mode-off)
    (define-key map [?\C- ] 'shift-mode-off)
    map))

(add-minor-mode 'shift-mode " Shift" shift-mode-map) ;; depends on add-minor-mode

(defun shift-region-right (top bottom)
"Shifts the selected region to the left by removing a space at the
 head of each complete line in the region.  If there first character
 of the line is not a space then the line is not altered"
   (interactive "*r")
   (if (not shift-mode)
       (let ((by current-prefix-arg))
         (if (or (null by)
                 (< by 0))
             (setq by 1))
         (shift-mode by)))
   (shift-region top bottom shift-mode))

(defun shift-region-left (top bottom)
"Shifts the selected region to the left by removing a space at the
 head of each complete line in the region.  If there first character
 of the line is not a space then the line is not altered"
   (interactive "*r")
   (if (not shift-mode)
       (let ((by current-prefix-arg))
         (if (or (null by)
                 (< by 0))
             (setq by 1))
         (shift-mode by)))
   (shift-region top bottom (- shift-mode)))

(defun shift-region (top bottom dir)
  ;; We only need to save all these variables for XEmacs.
  ;; The save-excursion is all that is needed in GNU Emacs
  (let ((oldp (point-marker))
        (oldm (copy-marker (mark-marker)))
        shift-col
        mark-active
        deactivate-mark
        transient-mark-mode
        mark-ring)
    (remove-hook 'before-change-functions 'shift-mode-off t)
    (save-excursion
      (goto-char top)
      (setq shift-col (current-column))
      (cond ((bolp)
             (indent-rigidly top bottom dir))
            ((> dir 0)
             (while (<= (point) bottom)
               (move-to-column shift-col)
               (if (= (current-column) shift-col)
                   (insert-char ?\s dir))
               (setq bottom (+ bottom dir))
               (backward-char dir)
               (next-line 1)))
            (1
             (while (<= (point) bottom)
               ;; do we need to untabify?
               (if (eq (following-char) ?\t )
                   (let ((col (current-column)))
                     (forward-char 1)
                     (setq col (- (current-column) col))
                     (delete-char -1)
                     (insert-char ?\s col)
                     (setq bottom (+ bottom (1- col)))
                     (backward-char col)))
               (move-to-column shift-col)
               (let ((todelete (- dir)))
                 (while (and (= (current-column) shift-col)
                             (eq (following-char) ?\s)
                             (> todelete 0))
                   (delete-char 1)
                   (setq bottom (+ bottom 1)
                         todelete (- todelete 1))))
               (next-line 1)))
      )
    )
    (make-local-hook 'before-change-functions)
    (add-hook 'before-change-functions 'shift-mode-off nil t)
    (goto-char oldp)
    (push-mark oldm nil t)
    (set-marker (mark-marker) oldm)
))

(defun shift-increment (&optional one two)
  "Increment shift amount"
  (interactive)
  ;; We only need to save all these variables for XEmacs.
  ;; The save-excursion is all that is needed in GNU Emacs
  (let ((oldp (point-marker))
        (oldm (copy-marker (mark-marker)))
        mark-active
        deactivate-mark
        transient-mark-mode
        mark-ring)
    (setq shift-mode (1+ shift-mode))
    (goto-char oldp)
    (push-mark oldm nil t)
    (set-marker (mark-marker) oldm)
    (message (concat "Shift by " (number-to-string shift-mode)))))

(defun shift-decrement (&optional one two)
  "Decrement shift amount"
  (interactive)
  ;; We only need to save all these variables for XEmacs.
  ;; The save-excursion is all that is needed in GNU Emacs
  (let ((oldp (point-marker))
        (oldm (copy-marker (mark-marker)))
        mark-active
        deactivate-mark
        transient-mark-mode
        mark-ring)
    (setq shift-mode (1- shift-mode))
    (if (< shift-mode 1)
        (setq shift-mode 1))
    (goto-char oldp)
    (push-mark oldm nil t)
    (set-marker (mark-marker) oldm)
    (message (concat "Shift by " (number-to-string shift-mode)))))

(defun shift-mode-off (&optional one two)
  "Turn shift mode off"
  (interactive)
  (if shift-mode
      (shift-mode 0)))

(defun shift-mode (arg)
  "Toggle shift mode.
With arg, turn shift mode on iff arg is positive."
  (interactive "p")
  (setq shift-mode
        (cond ((null arg)
               (not shift-mode))
              ((> arg 0)
               arg)
              (t nil)))
  (if shift-mode
      (progn
        (make-local-hook 'before-change-functions)
        (add-hook 'before-change-functions 'shift-mode-off nil t)
        (message "Shift Mode On"))

    ;; else

    ;; I'd like to do a remove-hook here on before-change-functions,
    ;; but I can't since this function is called from before-change-functions.
    ;; See the docs on the variable before-change-functions for details.
    (message "Shift Mode Off"))
  (cond ((fboundp 'force-mode-line-update)
         (force-mode-line-update))
        ((fboundp 'redraw-modeline)
         (redraw-modeline))))

(provide 'shift-mode)