Xref: utzoo comp.emacs:8979 gnu.emacs:3711 Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!wuarchive!mit-eddie!uw-beaver!cornell!bard From: bard@brigid.cs.cornell.edu (Bard Bloom) Newsgroups: comp.emacs,gnu.emacs Subject: Re: little kill-region hack Message-ID: <45156@cornell.UUCP> Date: 30 Aug 90 16:31:57 GMT References: <1990Aug29.022757.2855@athena.mit.edu> Sender: nobody@cornell.UUCP Reply-To: bard@cs.cornell.edu (Bard Bloom) Distribution: comp Organization: Cornell Univ. CS Dept, Ithaca NY Lines: 301 In article gaynor@sparky.rutgers.edu (Silver) writes: >To summarize acevedo@james-tiptree-jr.mit.edu (Gabriel) article: >> [The perhaps too-convenient binding of kill-region often causes grief. It is >> not uncommon to inadvertantly kill a region which is too large for undo to >> handle. Fortunately the auto-save mechanism can be used to recover in this >> situation. What follows is a version of kill-region which performs an >> aut-osave before killing regions which exceed undo's capabilities.] > >What I find to be a much more serious problem is not the fact that kill-region >can kill arbitrarily large portions of text, but that it does so very, very >quietly. Misstriking C-e and C-s is probably the most common circumstance. >However, the function is used too often and is too useful to cripple with a lot >of bells and whistles and confirmations like > [[Ag] gives an amusing paranoid-kill-region function, and then > a noisy one. ] Here's wimpy-delete.el, which is my preferred cowardly kill-region. ;; wimpy-delete -- a cautious form of kill-region. ;; Copyright (C) Bard Bloom, June 1989 ;; bard@theory.lcs.mit.edu ;; This file is not yet part of GNU Emacs. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY. No author or distributor ;; accepts responsibility to anyone for the consequences of using it ;; or for whether it serves any particular purpose or works at all, ;; unless he says so in writing. Refer to the GNU Emacs General Public ;; License for full details. ;; Everyone is granted permission to copy, modify and redistribute ;; GNU Emacs, but only under the conditions described in the ;; GNU Emacs General Public License. A copy of this license is ;; supposed to have been given to you along with GNU Emacs so you ;; can know your rights and responsibilities. It should be in a ;; file named COPYING. Among other things, the copyright notice ;; and this notice must be preserved on all copies. ;; WHAT THIS DOES: ;; It's a variant of kill-region (c-w) which, if the region is too big ;; (default 100 characters), asks you if you really want to delete it. The ;; prompt gives a couple words at each end, and tells you how big the region ;; is. ;; There's a related command, describe-region, which simply messages a few ;; words at each end of the region, and the total size. (require 'cl) (defvar wimpy-delete-size 100 "kill-region-wimpy will ask if you want to delete more than this many characters. Setting it to nil inhibits this feature altogether.") (defvar wimpy-delete-dopey-message "Gosh, that was a narrow escape!" "Message that kill-region-wimpy prints when you tell it not to delete the region.") (setq wimpy-delete-query-list '(((?y ?Y ?\ ?\r) kill "Yes " nil) ((?n ?N ?\C-?) nil "No " nil) ((?c) copy "Copy region " nil) ((?r) (recursive-edit nil) "Recursive Edit " nil) ((?a) (keyboard-quit nil) "Abort " nil) )) (defun kill-region-wimpy (beg end) "Like kill-region, this deletes the text between BEG and END, and stuffs it in the kill ring. (Interactively, uses the region.) However, it asks you if you really want to delete a large chunk of text. " (interactive "*r") (let ((size (- end beg)) action ) (cond ((and wimpy-delete-size (> size wimpy-delete-size)) (setq action (one-char-question (region-description (- (screen-width) 6) "Delete `" "'?") wimpy-delete-query-list "Delete the region?"))) (t (setq action 'kill))) (case action (kill (kill-region beg end)) (copy (copy-region-as-kill beg end) (message "I copied the region!")) (t (message "%s" wimpy-delete-dopey-message))))) (defun copy-region-as-kill-wimpy (beg end) "Copy region into the kill-ring, and describe it as well." (interactive "r") (message "Taking %s" (region-description (- (screen-width) 8) nil nil beg end)) (copy-region-as-kill beg end)) (defun describe-region () "Gives a message briefly describing the text at the beginning and end of the region." (interactive) (message "%s" (region-description (- (screen-width) 2)))) (defun absdiff (m n) (if (< m n) (- n m) (- m n))) (defun region-description (width &optional prefix suffix begin end) "Returns a string containing a one-line description of the region. Required argument WIDTH tells how the string can be; there's a lower limit of about 20 characters. Optional arguments: PREFIX and SUFFIX are strings to tack on the ends of the message. They *do* count towards its length. Defaults: null strings both of them. BEGIN and END are the beginning and end of the region to use, if it's not the real region." (unless prefix (setq prefix "")) (unless suffix (setq suffix "")) (when (and begin (not end)) (setq end (point))) (cond (begin (psetq begin (min begin end) end (max begin end))) (t (setq begin (min (point) (mark)) end (max (point) (mark))))) ; (message "%d `%s' `%s' %d %d" width prefix suffix begin end) (cond ((< (- end begin) (- width 2)) (concat "\"" (buffer-substring begin end) "\"")) (t (let* ((chars-string (format "...<%d chars>..." (- end begin))) (space-for-messages (+ (length prefix) (length suffix) (length chars-string))) (space-for-quote (/ (max 0 (- width space-for-messages)) 2)) (beg-words (pick-some-words begin nil space-for-quote)) (end-words (pick-some-words end t space-for-quote)) ) (concat prefix beg-words chars-string end-words suffix) )));let*,cond ) (defun pick-some-words (pos direction limit) "Arguments POS DIRECTION LIMIT. Returns a string of at most LIMIT chars, with one end at POS. It will try to fit as many words into the string as it can. If it can't fit even one word, it will take LIMIT characters. DIRECTION = nil for forward, t for backward." (save-excursion (goto-char pos) (let (p q) (if direction (backward-word 1) (forward-word 1)) (if (> (absdiff (point) pos) limit) (buffer-substring pos (+ (if direction (- limit) limit) pos)) (setq p (point) q t) (while (and q (not (eobp)) (not (bobp))) (if direction (backward-word 1) (forward-word 1)) (if (<= (absdiff (point) pos) limit) (setq p (point)) (goto-char p) (setq q nil))) (buffer-substring pos (point)))))) (defun one-char-question (question chars &optional help case-sensitive) "Ask user a question, expecting a one-character answer. The question is a string QUESTION. The answer must be one of CHARS, which is a list of lists of the form: ( ((a b .. d) result1 help1 confirm1) ((e f .. g) result2 help2 confirm2) ... ) result1 is a value for one-char-question to return if the user a or b or .. d. atoms are simply returned. If result1 is a list of the form (fun returnp) then one-char-question calls fun with no arguments. (If it's a symbol, it calls its function) If returnp is true then one-char-question returns fun's value, Else one-char-question asks the question again. help1 is a string to print as the meaning of a, b, ... d confirm1 is t if an answer of a, b, ..., d should be confirmed via y-or-n-p. Special characters do special things (and cannot be overridden) ? prints a help screen c-r enters a recursive edit c-l refreshes the screen Optional arguments: HELP is inserted at the top of the help listing. if CASE-SENSITIVE is true then the command is case sensitive. " (save-window-excursion (let ((answered nil) char-analysis answer should-confirm c ) (while (not answered) (message "%s" question) (setq c (read-char)) (unless case-sensitive (setq c (downcase c))) (cond ((= c ?\C-r) (save-window-excursion (save-excursion (save-restriction (message "Entering a recursive edit...") (widen) (recursive-edit))))) ((= c ?\C-l) (recenter)) ((= c ??) (one-char-question-help question chars help)) ((progn (setq char-analysis (one-char-question-answer c chars)) (first char-analysis)) (setq answered (second char-analysis) answer (third char-analysis) should-confirm (fourth char-analysis) help (fifth char-analysis) ) ) (t (beep))) ;; now confirm it (maybe) (when should-confirm (setq answered (y-or-n-p (format "Really %s?" help))))) answer))) (defun one-char-question-help (question chars help) (with-output-to-help-buffer (concat "*" question "*") (princ help) (terpri) (dolist (x chars) (princ (format "%s: %s\n" (third x) (mapconcat 'char-to-string (first x) ", ") ))))) (defun one-char-question-answer (c chars) "Internal function for one-char-question. Just keeping the form of whilst violating the spirit. Dont' ask what this does. But if you must know, C is the character the user typed, CHARS is the chars argument ot one-char-question, and this thing returns: (true-if-C-is-one-of-the-chars-in-CHARS answered=t-if-one-char-question-should-be-satisfied result-for-ocq-to-return true-if-ocq-shoudl-ask-for-confirmation help-message) " (let ((ocqa nil) result result-result (answered t) ) (dolist (x chars) (when (memq c (first x)) (setq result (second x)) (when (consp result) (setq result-result (funcall (if (symbolp (first result)) (symbol-function (first result)) (first result)))) (if (second result) (setq result result-result) (setq answered nil))) (setq ocqa (list t answered result (fourth x) (third x))) )) ocqa)) (defvar y-or-n-p-list '(((?y ?Y ?\ ?\r) t "Yes " nil) ((?n ?N ?\C-?) nil "No " nil) ((?r) (recursive-edit nil) "Recursive Edit " nil) ((?a) (keyboard-quit nil) "Abort " nil) ) "List to make one-char-question act like y-or-n-p") ;(one-char-question "Yes or no?" y-or-n-p-list "Stuff")