diff options
Diffstat (limited to 'emacs.d/nxhtml/util/anchored-transpose.el')
| -rw-r--r-- | emacs.d/nxhtml/util/anchored-transpose.el | 305 |
1 files changed, 0 insertions, 305 deletions
diff --git a/emacs.d/nxhtml/util/anchored-transpose.el b/emacs.d/nxhtml/util/anchored-transpose.el deleted file mode 100644 index 3a5464c..0000000 --- a/emacs.d/nxhtml/util/anchored-transpose.el +++ /dev/null @@ -1,305 +0,0 @@ -;;; anchored-transpose.el --- Transposes a phrase around an anchor phrase - -;; Copyright (C) 2004 Free Software Foundation, Inc. - -;; Author: Rick Bielawski <rbielaws@i1.net> -;; Keywords: tools convenience - -;; 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. - -;;; Commentary: - -;; `anchored-transpose' is an interactive autoload function to transpose -;; portions of a region around an anchor phrase. In other words it swaps -;; two regions. -;; -;; See C-h f anchored-transpose <ret> for a complete description. - -;;; Installing: - -;; 1) Put anchored-transpose.el on your load path. -;; 2) Put the following 2 lines in your .emacs -;; (global-set-key [?\C-x ?t] 'anchored-transpose) ;; Just a suggestion... -;; (autoload 'anchored-transpose "anchored-transpose" nil t) - -;;; History: - -;; 2004-09-24 RGB Seems useable enough to release. -;; 2004-10-15 RGB Only comments and doc strings were updated. -;; 2004-10-22 RGB Added support for 2 phrase selection. -;; 2004-12-01 RGB Added secondary selection support. -;; 2005-07-21 RGB Updated help text and comments. -;; Added support for A C B D and C A D B selection. -;; Fixed bug affecting multi line selections. -;; 2005-09-28 RGB Allow swapping regions with no anchor text between. - -;; Changes by Lennart Borgman -;; 2009-11-25 LB Set and clear secondary selection from keyboard. -;; Always use secondary selection. -;; Keep selections right after swapping. -;; Clear them if not used again. -;; Swap between buffers. -;; Check for read-only. -;; Probably broke something... ;-) - -;;; Code: - -(defvar anchored-transpose-anchor () - "begin/end when `anchored-transpose' is in progress else nil") - -;;;###autoload -(defun anchored-transpose (beg1 end1 flg1 &optional beg2 end2 flg2 win2) - "Transpose portions of the region around an anchor phrase. - -`this phrase but not that word' can be transposed into -`that word but not this phrase' - -I want this phrase but not that word. - |----------------------------|. .This is the entire phrase. - |-------|. . . . . . .This is the anchor phrase. - -First select the entire phrase and type \\[anchored-transpose]. -This set the secondary selection. - -Then select the anchor phrase and type \\[anchored-transpose] -again. Alternatively you can do the selections like this: - -I want this phrase but not that word. - |----------| |---------| Separate phrase selection. - -By default the anchor phrase will automatically include -any surrounding whitespace even if you don't explicitly select -it. Also, it won't include certain trailing punctuation. See -`anchored-transpose-do-fuzzy' for details. A prefix arg prior to -either selection means `no fuzzy logic, use selections -literally'. - -You can select the regions to be swapped separately in any -order. - -After swapping both primary and secondary selection are still -active. They will be canceled after second next command if you -do not swap regions again. \(Second because this allow you to -adjust the regions and try again.) - -You can also swap text between different buffers this way. - -Typing \\[anchored-transpose] with nothing selected clears any -prior selection, ie secondary selection." - (interactive `(,(region-beginning) ,(region-end) - ,current-prefix-arg - ,@anchored-transpose-anchor)) - (setq anchored-transpose-anchor nil) - (when (and mouse-secondary-overlay - mark-active - (overlay-buffer mouse-secondary-overlay) - (/= (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay))) - (if (eq (overlay-buffer mouse-secondary-overlay) (current-buffer)) - (progn - (setq beg2 (overlay-start mouse-secondary-overlay)) - (setq end2 (overlay-end mouse-secondary-overlay)) - (setq flg2 flg1) - (delete-overlay mouse-secondary-overlay)) - (let* ((sec-buf (overlay-buffer mouse-secondary-overlay)) - (sec-win (get-buffer-window sec-buf)) - (sec-new nil)) - (unless sec-win - (setq sec-new t) - (setq sec-win (split-window))) - (with-selected-window sec-win - (set-window-buffer (selected-window) sec-buf) - (goto-char (overlay-start mouse-secondary-overlay))) - (if (not (y-or-n-p "Swap between buffers ")) - (when sec-new (delete-window sec-win)) - (setq beg2 (overlay-start mouse-secondary-overlay)) - (setq end2 (overlay-end mouse-secondary-overlay)) - (setq flg2 flg1) - (setq win2 sec-win))))) - (setq win2 (or win2 (selected-window))) - (if mark-active - (if end2 ; then both regions are marked. swap them. - (if (not (eq win2 (selected-window))) - (anchored-transpose-swap beg1 end1 beg2 end2 win2) - (if (and (< beg1 beg2) ;A C B D - (< end1 end2) - (> end1 beg2)) - (apply 'anchored-transpose-swap - (anchored-transpose-do-fuzzy - beg1 beg2 end1 end2 flg1 flg2 flg1 flg2)) - (if (and (> beg1 beg2) ;C A D B - (> end1 end2) - (> end2 beg1)) - (apply 'anchored-transpose-swap - (anchored-transpose-do-fuzzy - beg2 beg1 end2 end1 flg2 flg1 flg2 flg1)) - (if (and (< beg1 beg2) ;A C D B - (> end1 end2)) - (apply 'anchored-transpose-swap - (anchored-transpose-do-fuzzy - beg1 beg2 end2 end1 flg1 flg2 flg2 flg1)) - (if (and (> beg1 beg2) ;C A B D - (< end1 end2)) - (apply 'anchored-transpose-swap - (anchored-transpose-do-fuzzy - beg2 beg1 end1 end2 flg2 flg1 flg1 flg2)) - (if (<= end1 beg2) ;A B C D - (apply 'anchored-transpose-swap - (anchored-transpose-do-fuzzy - beg1 end1 beg2 end2 flg1 flg1 flg2 flg2)) - (if (<= end2 beg1) ;C D A B - (apply 'anchored-transpose-swap - (anchored-transpose-do-fuzzy - beg2 end2 beg1 end1 flg2 flg2 flg1 flg1)) - (error "Regions have invalid overlap")))))))) - ;; 1st of 2 regions. Save it and wait for the other. - ;;(setq anchored-transpose-anchor (list beg1 end1 flg1)) - (if (or buffer-read-only - (get-char-property beg1 'read-only) - (get-char-property end1 'read-only)) - ;; Fix-me: move test, clean up a bit. - (message "Buffer text is readonly") - (set-secondary-selection beg1 end1) - (setq deactivate-mark t) - (message "%s" (this-command-keys)) - (message (propertize "Transpose: Select second region and call again - (without selection to cancel)" - 'face 'secondary-selection)))) - (if (and mouse-secondary-overlay - (overlay-buffer mouse-secondary-overlay)) - (progn - (cancel-secondary-selection) - (message (propertize "Canceled secondary selection" 'face - 'highlight))) - (message (propertize "Command requires a marked region" 'face - 'highlight))))) - -;;;###autoload -(defun set-secondary-selection (beg end) - "Set the secondary selection to the current region. -This must be bound to a mouse drag event." - (interactive "r") - (move-overlay mouse-secondary-overlay beg end (current-buffer)) - (when (called-interactively-p 'interactive) - ;;(deactivate-mark) - ) - (x-set-selection - 'SECONDARY - (buffer-substring (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)))) - -;;;###autoload -(defun cancel-secondary-selection () - (interactive) - (delete-overlay mouse-secondary-overlay) - (x-set-selection 'SECONDARY nil)) - -(defun anchored-transpose-do-fuzzy (r1beg r1end r2beg r2end - lit1 lit2 lit3 lit4) - "Returns the first 4 arguments after adjusting their value if necessary. - -I want this phrase but not that word. - |----------------------------|. .This is the entire phrase. - |-------|. . . . . . .This is the anchor phrase. - R1BEG R1END R2BEG R2END - -R1BEG and R1END define the first region and R2BEG and R2END the second. - -The flags, LIT1 thru LIT4 indicate if fuzzy logic should be applied to the -beginning of R1BEG, the end of R1END, the beginning of R2BEG, the end of R2END -respectively. If any flag is nil then fuzzy logic will be applied. Otherwise -the value passed should be returned LITerally (that is, unchanged). - -See `anchored-transpose-fuzzy-begin' and `anchored-transpose-fuzzy-end' for -specifics on what adjustments these routines will make when LITx is nil." - (list - (if lit1 r1beg - (anchored-transpose-fuzzy-begin r1beg r1end "[\t ]+")) - (if lit2 r1end - (anchored-transpose-fuzzy-end r1beg r1end "\\s +")) - (if lit3 r2beg - (anchored-transpose-fuzzy-begin r2beg r2end "[\t ]+")) - (if lit4 r2end - (anchored-transpose-fuzzy-end r2beg r2end "\\s *[.!?]")) - nil)) - -(defun anchored-transpose-fuzzy-end (beg end what) - "Returns END or new value for END based on the regexp WHAT. -BEG and END are buffer positions defining a region. If that region ends -with WHAT then the value for END is adjusted to exclude that matching text. - -NOTE: The regexp is applied differently than `looking-back' applies a regexp. - -Example: if (buffer-string beg end) contains `1234' the regexp `432' matches -it, not `234' as `looking-back' would. Also, your regexp never sees the char -at BEG so the match will always leave at least 1 character to transpose. -The reason for not using looking-back is that it's not greedy enough. -\(looking-back \" +\") will only match one space no matter how many exist." - (let ((str (concat - (reverse (append (buffer-substring (1+ beg) end) nil))))) - (if (string-match (concat "`" what) str) - (- end (length (match-string 0 str))) - end))) - -(defun anchored-transpose-fuzzy-begin (beg end what) - "Returns BEG or a new value for BEG based on the regexp WHAT. -BEG and END are buffer positions defining a region. If the region begins -with WHAT then BEG is adjusted to exclude the matching text. - -NOTE: Your regexp never sees the last char defined by beg/end. This insures -at least 1 char is always left to transpose." - (let ((str (buffer-substring beg (1- end)))) - (if (string-match (concat "`" what) str) - (+ beg (length (match-string 0 str))) - beg))) - -(defun anchored-transpose-swap (r1beg r1end r2beg r2end win2) - "Swaps region r1beg/r1end with r2beg/r2end. Flags are currently ignored. -Point is left at r1end." - (let ((reg1 (buffer-substring r1beg r1end)) - (reg2 nil) - (old-buffer (current-buffer))) - (when win2 - (unless (eq (selected-window) win2) - (select-window win2) - (set-buffer (window-buffer (selected-window))))) - (setq reg2 (delete-and-extract-region r2beg r2end)) - (goto-char r2beg) - (let ((new-mark (point))) - (insert reg1) - (push-mark new-mark)) - ;; I want to leave point at the end of phrase 2 in current buffer. - (save-excursion - (with-current-buffer old-buffer - (goto-char r1beg) - (delete-region r1beg r1end) - (let ((here (point))) - (insert reg2) - (set-secondary-selection here (point))))) - (setq deactivate-mark nil) - (when (eq old-buffer (current-buffer)) - (add-hook 'post-command-hook 'anchored-swap-post-command t t)))) - -(defun anchored-swap-post-command () - (condition-case err - (unless mark-active - (cancel-secondary-selection) - (remove-hook 'post-command-hook 'anchored-swap-post-command t)) - (error (message "anchored-swap-post-command: %s" err)))) - -(provide 'anchored-transpose) - -;; Because I like it this way. So there! -;;; fill-column:78 *** -;;; emacs-lisp-docstring-fill-column:78 *** -;;; -;;; Local Variables: *** -;;; End: *** -;;; anchored-transpose.el ends here. |