diff options
Diffstat (limited to 'site-lisp')
| -rw-r--r-- | site-lisp/whole-line-or-region.el | 644 |
1 files changed, 0 insertions, 644 deletions
diff --git a/site-lisp/whole-line-or-region.el b/site-lisp/whole-line-or-region.el deleted file mode 100644 index 3b08d9f..0000000 --- a/site-lisp/whole-line-or-region.el +++ /dev/null @@ -1,644 +0,0 @@ -;;; @(#) whole-line-or-region.el -- operate on current line if region undefined -;;; @(#) $Id: whole-line-or-region.el,v 1.3 2008/12/06 03:31:32 joe Exp $ - -;; This file is not part of Emacs - -;; Copyright (C) 2001 by Joseph L. Casadonte Jr. -;; Author: Joe Casadonte (emacs@northbound-train.com) -;; Maintainer: Joe Casadonte (emacs@northbound-train.com) -;; Created: July 1, 2001 -;; Keywords: kill yank cut copy paste whole lines -;; Latest Version: http://www.northbound-train.com/emacs.html - -;; COPYRIGHT NOTICE - -;; 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 2, 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. - -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; -;; This minor mode allows functions to operate on the current line if -;; they would normally operate on a region and region is currently -;; undefined. -;; -;; The primary use for this is to kill (cut) the current line if no -;; region is defined, and kill-region is invoked. It basically saves -;; you the effort of going to the begining of the line, selecting the -;; text up to the end of the line, and killing. Similarly, when -;; yanking, it's smart enough to know that the string to be yanked -;; was killed as a whole line, and it should be yanked as one, too. -;; So you don't need to position yourself at the start of the line -;; before yanking. If region *is* defined, though, all functions act -;; as normal. -;; -;; The inspiration for this came from an old editor I used to use -;; (brief maybe?), that did this exact thing for you. It was a handy -;; feature to have, and I definitely wanted it when I moved to Emacs. -;; I've extended the concept slightly, to let you copy N whole lines, -;; using the standard prefix method. -;; -;; NOTE: This package will behave unexpectedly (and indeed is nearly -;; useless) if `transient-mark-mode' is off, as there is then always -;; a region defined. -;; -;; NOTE: I haven't gotten this to work under XEmacs (though I -;; honestly haven't tried real hard). - -;;; Usage: -;; -;; M-x `whole-line-or-region-mode' - -;; Toggles whole-line-or-region-mode on & off. Optional arg turns -;; whole-line-or-region-mode on iff arg is a positive integer. Then -;; just call functions `copy-region-as-kill', `kill-region', -;; `kill-ring-save' and `yank' as you normally would. -;; -;; To turn the mode on automatically whenever Emacs starts, customize -;; `whole-line-or-region-mode' (which see). - -;;; Extending Package: -;; -;; I've tried to make the base functions as generic as possible so -;; that this same concept can be used for other region-based -;; functions. The only function I've thought of to date to extend in -;; this manner is `comment-dwim'. Examples using `comment-dwim' -;; follow. -;; -;; In order to extend this package for additional region-based -;; functions, you must understand how those functions work, and write -;; a new stub function that will be used to replace it. One of two -;; whole-line-or-region functions must be called from within that -;; stub; which one to use depends on whether or not the original -;; function wants region passed into it, or assumes region is defined -;; before being called. -;; -;; Using `kill-region' as an example, looking at its definition we -;; see that it takes two arguments, BEG and END. Looking at it -;; another way, it's interactive declaration is "r", which says to -;; pass in the current region. Because of this, the stub function -;; for it should call `whole-line-or-region-call-with-region': -;; -;; (defun whole-line-or-region-kill-region (prefix) -;; "Kill region or PREFIX whole lines." -;; (interactive "*p") -;; (whole-line-or-region-call-with-region 'kill-region prefix t)) -;; -;; The first argument to `whole-line-or-region-call-with-region' is -;; the function being replaced. The second is the value for prefix, -;; so that the stub can operate on more than just one line (e.g. C-u -;; 12 M-w would copy 12 whole lines). Other arguments are explained -;; in the function documentation. -;; -;; The function `comment-dwim', on the other hand, expects region to -;; be defined coming in, so its stub should call into the other -;; whole-line stub, `whole-line-or-region-call-with-prefix'. There are -;; things to consider, though. The original `comment-dwim' wants a -;; raw prefix value, but it doesn't use it to work over a variable -;; number of lines; rather it uses it to signal what DWIM really -;; does. Sort of defeats the purpose of a DWIM command, if you ask -;; me -- it should be simple enough to determine from the current -;; context what DWIMs should do. I digress, however..... -;; -;; The "proper" way to write a whole-line version of `comment-dwim' -;; would be like the following: -;; -;; (defun whole-line-or-region-comment-dwim (raw-prefix) -;; "Call `comment-dwim' on current region or current line." -;; (interactive "*P") -;; (whole-line-or-region-call-with-prefix 'comment-dwim 1 nil t raw-prefix)) -;; -;; The arguments for `whole-line-or-region-call-with-prefix' are -;; basically the same as for `whole-line-or-region-call-with-region', -;; but how each of them call the original function differs. The -;; first one calls it with two arguments (i.e. region's BEG & END) -;; and the second one sets mark (i.e. defines region) and passes in -;; prefix (raw or processed, depending). -;; -;; So the above example for `comment-dwim' would call the original -;; function with the current region (if defined) or the current line -;; (the second argument, the number of lines to operate on, being -;; hard-coded to 1), also passing in the raw prefix, for use within -;; the original function. It retains its original semantics and just -;; saves you from having to mark the current line. -;; -;; It could instead be defined like so: -;; -;; (defun whole-line-or-region-comment-dwim-2 (prefix) -;; "Call `comment-dwim' on region or PREFIX whole lines." -;; (interactive "*p") -;; (whole-line-or-region-call-with-prefix 'comment-dwim prefix nil t)) -;; -;; What this version does is override the normal behavior of the -;; prefix arg to `comment-dwim', and instead uses it to indicate how -;; many lines the whole-line version will comment out -- no prefix -;; value is passed to the original function in this case. This is -;; the version that I use, as it's just more intuitive for me. -;; -;; After defining the new stub, however you do it, the package needs -;; to know about it so that it can toggle its use on and off as the -;; mode toggles on and off. For that you need to customize the -;; variable `whole-line-or-region-extensions-alist', telling it the -;; original function name (`comment-dwim') and the new one -;; (`whole-line-or-region-comment-dwim-2'). If you want to limit the -;; redefinition to a specific keymap then specify that as well; -;; otherwise, the rebinding will occur in the global keymap. -;; Rebinding occurs via `substitute-key-definition' (which see). - -;;; To Do: -;; -;; o Nothing, at the moment. - -;;; Comments: -;; -;; Any comments, suggestions, bug reports or upgrade requests are welcome. -;; Please send them to Joe Casadonte (emacs@northbound-train.com). -;; -;; This version of whole-line-or-region was developed and tested with NTEmacs -;; 22.2.1 under Windows XP Pro. Please, let me know if it works with -;; other OS and versions of Emacs. - -;;; Change Log: -;; -;; see http://www.northbound-train.com/emacs/whole-line-or-region.log - -;;; ************************************************************************** -;;; ************************************************************************** -;;; ************************************************************************** -;;; ************************************************************************** -;;; ************************************************************************** -;;; Code: - -(eval-when-compile - ;; silence the old byte-compiler - (defvar byte-compile-dynamic nil) - (set (make-local-variable 'byte-compile-dynamic) t)) - -;;; ************************************************************************** -;;; ***** version related routines -;;; ************************************************************************** -(defconst whole-line-or-region-version - "$Revision: 1.3 $" - "Version number for 'whole-line-or-region' package.") - -;; --------------------------------------------------------------------------- -(defun whole-line-or-region-version-number () - "Return 'whole-line-or-region' version number." - (string-match "[0123456789.]+" whole-line-or-region-version) - (match-string 0 whole-line-or-region-version)) - -;; --------------------------------------------------------------------------- -(defun whole-line-or-region-display-version () - "Display 'whole-line-or-region' version." - (interactive) - (message "whole-line-or-region version <%s>." (whole-line-or-region-version-number))) - -;;; ************************************************************************** -;;; ***** customization -;;; ************************************************************************** -(defgroup whole-line-or-region nil - "Customization group for whole-line-or-region minor mode." - :group 'editing-basics - :group 'convenience) - -;; --------------------------------------------------------------------------- -(defun whole-line-or-region-customize () - "Customization of the group 'whole-line-or-region'." - (interactive) - (customize-group "whole-line-or-region")) - -;; --------------------------------------------------------------------------- -(defcustom whole-line-or-region-mode nil - "Non-nil if whole-line-or-region minor mode is enabled. - -Setting this variable directly does not take effect; use either -\\[customize] or the function `whole-line-or-region-mode'." - :set (lambda (symbol value) - (whole-line-or-region-mode (or value 0))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'whole-line-or-region) - -;; --------------------------------------------------------------------------- -(defcustom whole-line-or-region-extensions-alist '( - (copy-region-as-kill whole-line-or-region-copy-region-as-kill nil) - (kill-region whole-line-or-region-kill-region nil) - (kill-ring-save whole-line-or-region-kill-ring-save nil) - (yank whole-line-or-region-yank nil) - ) - "List of functions for whole-line-or-region to swap. - -When whole-line-or-region is activated, all original functions will be -replaced with their whole-line counterparts in the global keymap, -unless the optional keymap is specified (in which case it will be -replace in that map only). Similarly, when whole-line-or-region is -de-activated, the functions will be swapped back. - -The default is to map the following: - - o `copy-region-as-kill' -> `whole-line-or-region-copy-region-as-kill' - o `kill-region' -> `whole-line-or-region-kill-region' - o `kill-ring-save' -> `whole-line-or-region-kill-ring-save' - o `yank' -> `whole-line-or-region-yank' - -In addition, the following functions are provided by the package for -your convenience: - - o `whole-line-or-region-delete' - o `whole-line-or-region-comment-dwim' - o `whole-line-or-region-comment-dwim-2' - -See the individual functions for more information on what they do and -suggested mappings." - :type '(repeat - (list :tag "Function Mappings:" - (function :tag "Original Function") - (function :tag "Whole-line Version") - (variable :tag "Keymap (optional)") - )) - :group 'whole-line-or-region - :set (lambda (symbol newval) - (set symbol newval) - (when whole-line-or-region-mode - (whole-line-or-region-bind-keys))) - ) - -;; --------------------------------------------------------------------------- -(defcustom whole-line-or-region-mode-line-string " WLR" - "String to display in mode-line when 'whole-line-or-region' is active. - -Must start with a space. Changes will take effect next time emacs is -started." - :type 'string - :group 'whole-line-or-region) - -;; --------------------------------------------------------------------------- -(defcustom whole-line-or-region-load-hook nil - "Hook to run when package is loaded." - :type 'hook - :group 'whole-line-or-region) - -;; --------------------------------------------------------------------------- -(defcustom whole-line-or-region-on-hook nil - "Hook called when 'whole-line-or-region' mode is turned on." - :type 'hook - :group 'whole-line-or-region) - -;; --------------------------------------------------------------------------- -(defcustom whole-line-or-region-off-hook nil - "Hook called when 'whole-line-or-region' mode is turned off." - :type 'hook - :group 'whole-line-or-region) - -;;; ************************************************************************** -;;; ***** minor mode functions -;;; ************************************************************************** -; (defvar whole-line-or-region-mode nil ) - -;;; -------------------------------------------------------------------------- -;;;###autoload -(defun whole-line-or-region-mode (&optional arg) - "Toggle use of whole-line-or-region minor mode. - -This minor mode allows functions to operate on the current line if -they would normally operate on a region and region is currently -undefined. - -Optional ARG turns mode on iff ARG is a positive integer." - (interactive "P") - - ;; toggle on and off - (let ((old-mode whole-line-or-region-mode)) - (setq whole-line-or-region-mode - (if arg (or (listp arg) - (> (prefix-numeric-value arg) 0)) - (not whole-line-or-region-mode))) - - (when (not (equal old-mode whole-line-or-region-mode)) - ;; enable/disable advice - (if whole-line-or-region-mode - (whole-line-or-region-bind-keys) - (whole-line-or-region-restore-keys)) - - (run-hooks (if whole-line-or-region-mode - 'whole-line-or-region-on-hook - 'whole-line-or-region-off-hook)) - ))) - -;; --------------------------------------------------------------------------- -;; add to minor-mode-alist if not there already -(or - (assq 'whole-line-or-region-mode minor-mode-alist) - (setq minor-mode-alist - (cons - (list 'whole-line-or-region-mode whole-line-or-region-mode-line-string) - minor-mode-alist))) - -;;; ************************************************************************** -;;; ***** interactive functions (used by default) -;;; ************************************************************************** -;;;###autoload -(defun whole-line-or-region-copy-region-as-kill (prefix) - "Copy region or PREFIX whole lines." - (interactive "p") - (whole-line-or-region-call-with-region 'copy-region-as-kill prefix t)) - -;;; -------------------------------------------------------------------------- -;; (defalias 'whole-line-or-region-copy 'whole-line-or-region-copy-region-as-kill) - -;;; ************************************************************************** -;;;###autoload -(defun whole-line-or-region-kill-region (prefix) - "Kill (cut) region or PREFIX whole lines." - (interactive "*p") - (whole-line-or-region-call-with-region 'kill-region prefix t)) - -;;; ************************************************************************** -;;;###autoload -(defun whole-line-or-region-kill-ring-save (prefix) - "Copy region or PREFIX whole lines." - (interactive "p") - (whole-line-or-region-call-with-region 'kill-ring-save prefix t)) - -;;; ************************************************************************** -;;;###autoload -(defun whole-line-or-region-yank (raw-prefix &optional string-in) - "Yank (paste) previously killed text. - -If the text to be yanked was killed with a whole-line-or-region -function *as* a whole-line, then paste it as a whole line (i.e. do not -break up the current line, and do not force the user to move point). - -RAW-PREFIX is used to determine which string to yank, just as `yank' -would normally use it. - -Optionally, pass in string to be \"yanked\" via STRING-IN." - (interactive "*P") - - ;; figure out what yank would do normally - (let ((string-to-yank (or string-in (current-kill - (cond ((listp raw-prefix) 0) - ((eq raw-prefix '-) -1) - (t (1- raw-prefix))) t))) - (saved-column (current-column))) - - ;; check for whole-line prop in yanked text - (if (get-text-property 0 'whole-line-or-region string-to-yank) - (let ((beg (line-beginning-position))) - ;; goto beg of line and yank - (beginning-of-line) - (if string-in - ;; insert "manually" - (insert string-in) - ;; just yank as normal - (yank raw-prefix)) - - ;; a whole-line killed from end of file may not have a - ;; trailing newline -- add one, in these cases - (when (not (string-match "\n$" string-to-yank)) - (insert "\n") - (previous-line 1)) - - ;; restore state of being.... - (move-to-column saved-column) - (remove-text-properties beg (+ beg 1) '(whole-line-or-region nil))) - - ;; no whole-line-or-region mark - (if string-in - ;; insert "manually" - (progn - (when (and delete-selection-mode - mark-active) - (delete-active-region)) - (insert string-in)) - ;; just yank as normal - (yank raw-prefix))) - )) - -;;; -------------------------------------------------------------------------- -;; in case delete-selection-mode (delsel.el) is being used -(if (string-match "Emacs 21" (emacs-version)) - (put 'whole-line-or-region-yank 'delete-selection 'yank) - (put 'whole-line-or-region-yank 'delete-selection t)) - -;;; ************************************************************************** -;;; alternate interactive functions -;;; ************************************************************************** -;;;###autoload -(defun whole-line-or-region-delete (prefix) - "Delete region or PREFIX whole lines." - (interactive "*p") - (whole-line-or-region-call-with-region 'delete-region prefix)) - -;;; ************************************************************************** -;;;###autoload -(defun whole-line-or-region-comment-dwim (raw-prefix) - "Call `comment-dwim' on current region or current line. - -See `comment-dwim' for details of RAW-PREFIX usage." - (interactive "*P") - (whole-line-or-region-call-with-prefix 'comment-dwim 1 nil t raw-prefix)) - -;;; ************************************************************************** -;;;###autoload -(defun whole-line-or-region-comment-dwim-2 (prefix) - "Call `comment-dwim' on region or PREFIX whole lines." - (interactive "*p") - (whole-line-or-region-call-with-prefix 'comment-dwim prefix nil t)) - -;;; ************************************************************************** -;;; ***** internal functions -;;; ************************************************************************** -(defun whole-line-or-region-call-with-region (fn &optional cnt mark-as-whole send-prefix prefix) - "Calls FN on region or CNT whole lines. - -If region is defined simply call FN, passing in the start and end of -the current region. - -If region is not currently defined, then define it temporarily as the -current line. Additionally, if CNT is set, expand region to cover the -next CNT whole lines (or previous CNT whole lines, if CNT is -negative). Before FN is called, mark the temporary region with a -special property if MARK-AS-WHOLE is non-nil (this is useful if the -text could be worked on with some future whole-line-or-region -function, and it makes sense to understand the context in which FN was -originally called, e.g. killing and yanking text; see -`whole-line-or-region-yank' for an example). - -In either case, if SEND-PREFIX is non-nil, then PREFIX is passed into -FN as a third argument." - (whole-line-or-region-base-call fn fn t nil nil cnt mark-as-whole send-prefix prefix)) - -;;; ************************************************************************** -(defun whole-line-or-region-call-with-prefix (fn &optional cnt mark-as-whole send-prefix prefix) - "Calls FN on region or CNT whole lines. - -If region is defined simply call FN. - -If region is not currently defined, then define it temporarily as the -current line. Additionally, if CNT is set, expand region to cover the -next CNT whole lines (or previous CNT whole lines, if CNT is -negative). Before FN is called, mark the temporary region with a -special property if MARK-AS-WHOLE is non-nil (this is useful if the -text could be worked on with some future whole-line-or-region -function, and it makes sense to understand the context in which FN was -originally called, e.g. killing and yanking text; see -`whole-line-or-region-yank' for an example). - -In either case, if SEND-PREFIX is non-nil, then PREFIX is passed into -FN as the sole argument." - (whole-line-or-region-base-call fn fn nil nil nil cnt mark-as-whole send-prefix prefix)) - -;;; ************************************************************************** -(defun whole-line-or-region-base-call (norm-fn wlr-fn - &optional beg-end pre-args post-args - cnt mark-as-whole send-prefix prefix) - "Calls FN on region or CNT whole lines. - -If region is defined simply call NORM-FN. - -If region is not currently defined, then define it temporarily as the -current line. Additionally, if CNT is set, expand region to cover the -next CNT whole lines (or previous CNT whole lines, if CNT is -negative). Before WLR-FN is called, mark the temporary region with a -special property if MARK-AS-WHOLE is non-nil (this is useful if the -text could be worked on with some future whole-line-or-region -function, and it makes sense to understand the context in which WLR-FN was -originally called, e.g. killing and yanking text; see -`whole-line-or-region-yank' for an example). - -In either case, if BEG-END is non-nil, then pass into FN the start and -end of the current region. PRE-ARGS and POST-ARGS are lists of -arguments to be passed into FN before \(PRE-ARGS) and/or after -\(POST-ARGS) the start and end of the current region (but only if -BEG-END is non-nil). Finally, if SEND-PREFIX is non-nil, then PREFIX -is passed into FN before POST-ARGS." - - ;; region is defined, so just do what should normally be done - (if (and mark-active - (/= (point) (mark))) - ;; just call it, but make sure to pass all of the arguments.... - (let (args) - (when pre-args - (whole-line-or-region-append-to-list 'args pre-args)) - - (when beg-end - (whole-line-or-region-append-to-list 'args (point)) - (whole-line-or-region-append-to-list 'args (mark))) - - (when send-prefix - (whole-line-or-region-append-to-list 'args (list prefix))) - - (when post-args - (whole-line-or-region-append-to-list 'args post-args)) - - (apply 'funcall norm-fn args)) - - ;; no region defined, act on whole line - (let ((saved-column (current-column)) - (current-mod-state (buffer-modified-p)) - beg end) - (save-excursion - (setq beg (line-beginning-position)) - (set-mark beg) - - ;; add whole-line property, sometimes - (when mark-as-whole - (let ((inhibit-read-only t)) - (put-text-property beg (+ beg 1) 'whole-line-or-region t) - (set-buffer-modified-p current-mod-state))) - - (setq end (line-beginning-position (+ (or cnt 1) 1))) - (goto-char end) - - (let (args) - (when pre-args - (whole-line-or-region-append-to-list 'args pre-args)) - - (when beg-end - (whole-line-or-region-append-to-list 'args beg) - (whole-line-or-region-append-to-list 'args end)) - - (when send-prefix - (whole-line-or-region-append-to-list 'args (list prefix))) - - (when post-args - (whole-line-or-region-append-to-list 'args post-args)) - - (apply 'funcall wlr-fn args)) - - ;; remove whole-line property, sometimes - (when mark-as-whole - (let ((inhibit-read-only t) - (current-mod-state (buffer-modified-p))) - (remove-text-properties beg (+ beg 1) '(whole-line-or-region nil)) - (set-buffer-modified-p current-mod-state))) - ) - - (move-to-column saved-column)) - )) - -;;; ************************************************************************** -(defun whole-line-or-region-bind-keys (&optional switch) - "Bind keys according to `whole-line-or-region-extensions-alist'. - -With optional SWITCH, restore keys instead." - (let ((gmap (current-global-map)) - (ext-alist whole-line-or-region-extensions-alist) - elem orig wlr map) - (while ext-alist - (setq elem (car ext-alist)) - (setq ext-alist (cdr ext-alist)) - - (setq orig (nth 0 elem)) - (setq wlr (nth 1 elem)) - (setq map (nth 2 elem)) - - (if switch - (substitute-key-definition wlr orig (or map gmap)) - (substitute-key-definition orig wlr (or map gmap))) - ))) - -;;; ************************************************************************** -(defun whole-line-or-region-restore-keys () - "Restore keys according to `whole-line-or-region-extensions-alist'." - (whole-line-or-region-bind-keys t)) - -;;; ************************************************************************** -(defun whole-line-or-region-append-to-list (list-var element) - "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. - -The test for presence of ELEMENT is done with `equal'. -If ELEMENT is added, it is added at the beginning of the list, -unless the optional argument APPEND is non-nil, in which case -ELEMENT is added at the end. - -If you want to use `whole-line-or-region-append-to-list' on a variable that is not defined -until a certain package is loaded, you should put the call to `whole-line-or-region-append-to-list' -into a hook function that will be run only after loading the package. -`eval-after-load' provides one way to do this. In some cases -other hooks, such as major mode hooks, can do the job." - (set list-var - (append (symbol-value list-var) (if (listp element) element (list element))) - )) - -;;; ************************************************************************** -;;; ***** we're done -;;; ************************************************************************** -(provide 'whole-line-or-region) -(run-hooks 'whole-line-or-region-load-hook) - -;;; whole-line-or-region.el ends here -;;; ************************************************************************** -;;;; ***** EOF ***** EOF ***** EOF ***** EOF ***** EOF ************* |