emacs_el/tiny-tools/tiny/tinyeat.el

   1 ;; tinyeat.el --- Eat blocks of text at point, forward and backward
   2
   3 ; This file is not part of Emacs
   4
   5 ;;{{{ Documentation
   6
   7 ;; Copyright (C)    1995-2007 Jari Aalto
   8 ;; Keywords:        extensions
   9 ;; Author:          Jari Aalto
  10 ;; Maintainer:      Jari Aalto
  11 ;;
  12 ;; To get information on this program  call C-u M-x
  13 ;; tinyeat-version. Look at the code with folding.el
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;; ....................................................... &t-install ...
  38 ;; Put this file on your Emacs-Lisp load path, add following into your
  39 ;; emacs startup file.
  40 ;;
  41 ;;      ;; Rebind BACKSPACE and DEL-related keys
  42 ;;      (setq tinyeat-:load-hook '(tinyeat-install))
  43 ;;      (require 'tinyeat)
  44 ;;      (global-set-key "\M-z"   'tinyeat-kill-buffer-lines-main)
  45 ;;
  46 ;; Or use autoload and Emacs starts up faster
  47 ;;
  48 ;;      (autoload 'tinyeat-forward-preserve            "tinyeat" "" t)
  49 ;;      (autoload 'tinyeat-backward-preserve           "tinyeat" "" t)
  50 ;;      (autoload 'tinyeat-delete-paragraph            "tinyeat" "" t)
  51 ;;      (autoload 'tinyeat-kill-line                   "tinyeat" "" t)
  52 ;;      (autoload 'tinyeat-zap-line                    "tinyeat" "" t)
  53 ;;      (autoload 'tinyeat-kill-line-backward          "tinyeat" "" t)
  54 ;;      (autoload 'tinyeat-kill-buffer-lines-point-max "tinyeat" "" t)
  55 ;;      (autoload 'tinyeat-kill-buffer-lines-point-min "tinyeat" "" t)
  56 ;;
  57 ;;      (global-set-key (kbd "ESC C-k")       'tinyeat-kill-line-backward)
  58 ;;      (global-set-key (kbd "ESC d")         'tinyeat-forward-preserve)
  59 ;;      (global-set-key (kbd "ESC z")         'tinyeat-kill-buffer-lines-main)
  60 ;;      (global-set-key (kbd "ESC C-k")       'tinyeat-zap-line)
  61 ;;
  62 ;;      (global-set-key (kbd "M-DEL")         'tinyeat-forward-preserve)
  63 ;;      (global-set-key (kbd "<C-delete>")    'tinyeat-backward-preserve)
  64 ;;      (global-set-key (kbd "<S-backspace>") 'tinyeat-delete-whole-word)
  65 ;;
  66 ;; Investigate problems with:
  67 ;;
  68 ;;      M-x tinyeat-debug-toggle
  69 ;;      M-x tinyeat-debug-show
  70 ;;
  71 ;; If you have any questions, use this function to contact maintainer
  72 ;;
  73 ;;      M-x tinyeat-submit-bug-report
  74
  75 ;;}}}
  76 ;;{{{ Documentation
  77
  78 ;;; Commentary:
  79
  80 ;;  Preface, overview of features
  81 ;;
  82 ;;      o   Determines how much text should be eaten around current cursor
  83 ;;          position. Eat extra spaces, extra newlines, next word
  84 ;;          next statement, next comment ... whatever is appropriate
  85 ;;      o   Can also eat inside mixed case word: WordsThatAreLikeThis
  86 ;;      o   Yank and "overwrite" text under cursor with Meta mouse-2 or
  87 ;;          `Meta' `C-y'. (Std Emacs in `overwrite-mode' doesn't allow you to
  88 ;;          yank and overwrite at the same time.)
  89 ;;
  90 ;;  Today's suggestion
  91 ;;
  92 ;;      If using Windowed Emacs and the prompt is at minibuffer and
  93 ;;      you would like to clean the whole prompt, hit key
  94 ;;      `Esc-backspace'. In non-windowed emacs, you have to repeat the
  95 ;;      keystroke as needed (this is due to "backspace key detection
  96 ;;      problem syndrome").
  97 ;;
  98 ;;  Non-windowed and Windowed Emacs
  99 ;;
 100 ;;      This package works _best_ in windowed Emacs, because in windowed
 101 ;;      environment you can use the modifiers *Control*, *Alt* and *Meta*
 102 ;;      freely with other keys. The idea of this package is to overload
 103 ;;      your single key, `backspace', as much as possible with various
 104 ;;      delete functionalities.
 105 ;;
 106 ;;      In non-windowed Emacs there is no key named `backspace', so
 107 ;;      standard Emacs bindings are bound instead. Many of this
 108 ;;      package's features are left unused because there are no
 109 ;;      suitable keys to bind the commands to. In non-windowed Emacs the
 110 ;;      command marked with (*) are not available. Emacs bindings
 111 ;;      that are redefined when you call `tinyeat-activate' are:
 112 ;;
 113 ;;                          was             now
 114 ;;          ---------------------------------------------------------
 115 ;;          M-d             kill-word       tinyeat-forward-preserve
 116 ;;          S-backspace     <none>          tinyeat-delete-whole-word  (*)
 117 ;;          M-k             kill-sentence   tinyeat-kill-line-backward
 118 ;;          M-C-d           down-list       tinyeat-delete-paragraph
 119 ;;          M-C-y           <none>          tinyeat-yank-overwrite
 120 ;;
 121 ;;  Story behind this package
 122 ;;
 123 ;;      One day the developer got frustrated of moving cursor around the
 124 ;;      point and using keys del or backspace to write C++ and LISP
 125 ;;      symbols. The start situation was like this while cursor was at (*):
 126 ;;
 127 ;;          (defun lisp-symbol-name-myname          ()
 128 ;;                                  *
 129 ;;
 130 ;;      He decided to change 'myname' to something else. Normally he
 131 ;;      would reach out for M-d for `kill-word' to delete `myname' and
 132 ;;      type the new name:
 133 ;;
 134 ;;          (defun lisp-symbol-name-mynew           ()
 135 ;;                                       *
 136 ;;
 137 ;;      Next, he noticed that there were extra spaces involved.
 138 ;;      A call to `fixup-whitespace' would make it go away ... Hmm that was
 139 ;;      not bound to any key by default (in this particular Emacs used
 140 ;;      at the time), so he had to type it the long way round: `M-x'
 141 ;;      `fixup-whitespace'. His thoughts were: "Oh, I should have bound it
 142 ;;      to some easily reacheable key". The story continues.
 143 ;;      He looked at the function once more and decided that the name
 144 ;;      `symbol-name-mynew' wasn't a good one after all. He decided to
 145 ;;      delete 3 words backward. Now, how do you do that?
 146 ;;
 147 ;;          (defun lisp-symbol-name-mynew ()
 148 ;;                                       *
 149 ;;
 150 ;;      He murmurs, "where is the command to delete backward ...". After
 151 ;;      spending valuable minutes to find the `delete-backward-word'
 152 ;;      command with the `M-x' `apropos',  hitting the page up and down
 153 ;;      to find anything that would look like what he wanted, he leaned
 154 ;;      back with despair, "Doh, there is no such command". Silently
 155 ;;      he ends up tapping the backspace until he reaches the correct point:
 156 ;;
 157 ;;          (defun lisp- ()
 158 ;;                      *
 159 ;;
 160 ;;      and starts typing a new name...
 161 ;;
 162 ;;          (defun lisp-my-func ()
 163 ;;
 164 ;;      All is perfect for a moment. Then, he notices that there are too
 165 ;;      many newlines above the newly created function and says to himself:
 166 ;;      "I really should delete those 5 extra empty lines above the
 167 ;;      function. Now, how do I kill backward 5 empty lines backward? The
 168 ;;      `kill-line' in C-k kills only forward" ...". The story teller
 169 ;;      rests here and leaves reader's imagination to fly forward.
 170 ;;
 171 ;;  Lesson learned
 172 ;;
 173 ;;      As you can notice, people often spend most of the time to
 174 ;;      position the cursor to the right spot and deleting text over
 175 ;;      there.. over here .. typing more .. changing our mind ... and
 176 ;;      so on.
 177 ;;
 178 ;;      It was time to do something creative, so that user wouldn't have to
 179 ;;      worry about the deletion of text so much. This package provides
 180 ;;      atempts to provide _smart_ deleting capabilities: whether it was
 181 ;;      to delete forward of backward. Naturally the art of deletion is
 182 ;;      not accurate, a few guesses need to be made and they may be
 183 ;;      wrong. If it so happens that a lot of text have suddenly
 184 ;;      retired (vanished, vaporized) from the buffer, remember, there
 185 ;;      is no need to panic. Emacs has friendly `undo' (C-_ or C-x u).
 186 ;;
 187 ;;  Default keybindings
 188 ;;
 189 ;;      Line delete
 190 ;;
 191 ;;          <<           >>           <<>>
 192 ;;          M-k          C-k          M-C-k
 193 ;;                                    zap whole line
 194 ;;
 195 ;;      Chunk delete: words, spaces, symbols ...
 196 ;;
 197 ;;          <<           >>           <<>>               \//\
 198 ;;          M-Backspace  C-backspace  S-Backspace        C-M-d  / C-S-backspace
 199 ;;                                    Delete whole word  Paragraph delete
 200 ;;
 201 ;;      Other functions that you might want to bind to keys:
 202 ;;
 203 ;;         M-x tinyeat-erase-buffer
 204 ;;         M-x tinyeat-kill-buffer-lines-main
 205 ;;         M-x tinyeat-join-lines
 206 ;;
 207 ;;  Known Bugs
 208 ;;
 209 ;;      This package heavily relies on various modifiers that can be
 210 ;;      attached to the *BACKSPACE* key and binding it can be a difficult
 211 ;;      subject under Unix. For example the *Alt* key may not exist and to
 212 ;;      make it "seen" under Unix you have to introduce yourself to
 213 ;;      `xmodmap(1)' or `keycaps(1)' and possibly `xev(1)' in order to find
 214 ;;      the key symbols correctly.
 215 ;;
 216 ;;      Worse, in the same environment Emacs and XEmacs may disagree what
 217 ;;      BACKSPACE means. To get some taste, here is what XEmacs 20.4 and
 218 ;;      Emacs 20.3 in Redhat Linux 6.2 return:
 219 ;;
 220 ;;                              XEmacs          Emacs
 221 ;;
 222 ;;          <esc backspace>     M-backspace     ESC DEL
 223 ;;          <shift backspace>   delete          S-delete
 224 ;;          <alt backspace>     <nothing>       <nothing>
 225 ;;
 226 ;;      There is nothing this package can do to cope with these changes in
 227 ;;      key symbols or the environemnt you use. If you can, try to get the
 228 ;;      ALT key working and shift-modifier for backspace and everything
 229 ;;      is well. If that is not possible, the power of the predefined
 230 ;;      keybindings are mostly left unused and you have to look at the
 231 ;;      install function and determine how would you use your keyboard best
 232 ;;      with these functions.
 233
 234 ;;}}}
 235
 236 ;;; Change Log:
 237
 238 ;;; Code:
 239
 240 ;;{{{ setup: variables
 241
 242 (require 'tinylibm)
 243 (eval-when-compile (ti::package-use-dynamic-compilation))
 244
 245 (ti::package-defgroup-tiny TinyEat tinyeat-: extension
 246   "Eat blocks of text forward, backward.
 247 Overview of features
 248
 249         o   Determine how much text should be eaten around current cursor
 250             position. Eat extra spaces, extra newlines, next word
 251             next statement , next comment ... whatever is appropriate
 252         o   Can also eat only 'inside' words: WordsThatAreLikeThis")
 253
 254 (defcustom tinyeat-:load-hook nil
 255   "*Hook that is run when package is loaded."
 256   :type  'hook
 257   :group 'TinyEat)
 258
 259 (defcustom tinyeat-:verbose-flag t
 260   "*Non-nil means allow informational messages to be displayed."
 261   :type  'boolean
 262   :group 'TinyEat)
 263
 264 (defcustom tinyeat-:non-word-chars
 265   "][=_~+!@#$%&*:;'\"`,.<>(){}$<>?/|\\\\\n \t-"
 266   "*Characters that _stop_ eating word.
 267 Character ][ be in this order and in the beginning of variable,
 268 because this string is converted into regexp later."
 269   :type  '(string :tag "Charset")
 270   :group 'TinyEat)
 271
 272 (defcustom tinyeat-:eat-full-word-charset  "^][ \t\n(){};'\","
 273   "*Character set to use when determining word boundary.
 274 Normally word is terminated by whitespace or newlines."
 275   :type  '(string :tag "Charset")
 276   :group 'TinyEat)
 277
 278 ;;}}}
 279 ;;{{{ version
 280
 281 ;;;###autoload (autoload 'tinyeat-version "tinyeat" "Display commentary." t)
 282 (eval-and-compile
 283   (ti::macrof-version-bug-report
 284    "tinyeat.el"
 285    "tinyeat"
 286    tinyeat-:version-id
 287    "$Id: tinyeat.el,v 2.62 2007/05/01 17:20:43 jaalto Exp $"
 288    '(tinyeat-:version-id
 289      tinyeat-:debug
 290      tinyeat-:load-hook
 291      tinyeat-:verbose-flag
 292      tinyeat-:non-word-chars
 293      tinyeat-:eat-full-word-charset)
 294    '(tinyeat-:debug-buffer)))
 295
 296 ;;}}}
 297 ;;{{{ install
 298
 299 ;;;###autoload (autoload 'tinyeat-debug-toggle "tinyeat" "" t)
 300 ;;;###autoload (autoload 'tinyeat-debug-show   "tinyeat" "" t)
 301
 302 (eval-and-compile (ti::macrof-debug-standard "tinyeat" "-:"))
 303
 304 ;;; ----------------------------------------------------------------------
 305 ;;;
 306 (defun tinyeat-install-default-bindings-terminal ()
 307   "Install extra binding for dummy terminals."
 308   (let ((status (lookup-key global-map (kbd "ESC [ 3"))))
 309     ;;  Will be number, if this is a prefix key
 310     (when (or (integerp status)
 311               (and status
 312                    (keymapp status)))
 313       ;;  C-delete
 314       (global-set-key (kbd "ESC [ 3 ^") 'tinyeat-forward-preserve)
 315       ;;  S-delete
 316       (global-set-key (kbd "ESC [ 3 $") 'tinyeat-delete-whole-word)
 317       ;; C-S-delete
 318       (global-set-key (kbd "ESC [ 3 @") 'tinyeat-delete-paragraph))))
 319
 320 ;;; ----------------------------------------------------------------------
 321 ;;;
 322 ;;;###autoload
 323 (defun tinyeat-install-default-bindings ()
 324   "Add default bindings to the backspace key with modifiers."
 325   (interactive)
 326   (global-set-key (kbd "ESC C-y")         'tinyeat-yank-overwrite)
 327
 328   ;; was `kill-sentence'
 329   (global-set-key (kbd "ESC C-k")         'tinyeat-kill-line-backward)
 330
 331   ;;  was `kill-word'
 332   (global-set-key (kbd "ESC d")           'tinyeat-forward-preserve)
 333   (global-set-key (kbd "<C-delete>")      'tinyeat-forward-preserve)
 334   (global-set-key (kbd "<C-backspace>")   'tinyeat-forward-preserve)
 335
 336   ;;  Alt-backspace
 337   (global-set-key (kbd "ESC DEL")         'tinyeat-backward-preserve)
 338   (global-set-key (kbd "M-DEL")           'tinyeat-backward-preserve)
 339
 340   (global-set-key (kbd "<S-backspace>")   'tinyeat-delete-whole-word)
 341   (global-set-key (kbd "<S-delete>")      'tinyeat-delete-whole-word)
 342
 343 ;;;    (when (ti::xemacs-p)
 344 ;;;      (global-set-key (kbd "M-BS")            'tinyeat-backward-preserve)
 345 ;;;      (global-set-key (kbd "C-BS")            'tinyeat-forward-preserve))
 346
 347   ;;  Was `down-list'
 348   (global-set-key (kbd "ESC C-d")         'tinyeat-delete-paragraph)
 349   (global-set-key (kbd "<C-S-backspace>") 'tinyeat-delete-paragraph)
 350   (global-set-key (kbd "<C-S-delete>")    'tinyeat-delete-paragraph)
 351
 352   (global-set-key (kbd "ESC C-k")   'tinyeat-zap-line)
 353
 354   (unless (ti::compat-window-system)
 355     (tinyeat-install-default-bindings-terminal))
 356
 357   (message "\
 358 TinyEat: ** keys were bound to TinyEat functions."))
 359
 360 ;;; ----------------------------------------------------------------------
 361 ;;;
 362 ;;;###autoload
 363 (defun tinyeat-install (&optional arg)
 364   "Call `tinyeat-install-default-bindings' with ARG."
 365   (interactive)
 366   (tinyeat-install-default-bindings))
 367
 368 ;;}}}
 369 ;;{{{ misc
 370
 371 ;;; ----------------------------------------------------------------------
 372 ;;;
 373 (put 'tinyeat-repeat-macro 'lisp-indent-function 1)
 374 (defmacro tinyeat-repeat-macro (end &rest body)
 375   "Loop using VAR from BEG to END and do BODY."
 376   (` (loop for var from 1 to (, end)
 377            do
 378            (progn
 379              (,@ body)))))
 380
 381 ;;; ----------------------------------------------------------------------
 382 ;;;
 383 (put 'tinyeat-verbose-macro 'lisp-indent-function 0)
 384 (defmacro tinyeat-verbose-macro (&rest body)
 385   "Run BODY if tinyeat-:verbose-flag' is set.
 386 Minibuffer is excluded."
 387   (`
 388    (when (and (not (ti::buffer-minibuffer-p))
 389               tinyeat-:verbose-flag)
 390      (,@ body))))
 391
 392 ;;; ----------------------------------------------------------------------
 393 ;;;
 394 ;;;###autoload
 395 (defun tinyeat-erase-buffer  ()
 396   "Erase buffer. If read-only buffer, do nothing."
 397   (interactive)
 398   (unless buffer-read-only
 399     (if (ti::buffer-minibuffer-p)
 400         ;; `erase-buffer' signals error in minibuffer:
 401         ;;  read-only-text (like that in prompt)
 402         (delete-region
 403          (line-beginning-position)
 404          (line-end-position))
 405       (erase-buffer))))
 406
 407 ;;; ----------------------------------------------------------------------
 408 ;;;
 409 ;;;###autoload
 410 (defun tinyeat-zap-line (&optional count)
 411   "Kill COUNT times whole lines including the final newline."
 412   (interactive "p")
 413   (tinyeat-repeat-macro (or count 1)
 414                         (beginning-of-line)
 415                         (if (looking-at "\n")
 416                             (kill-line)
 417                           (kill-line 1))))
 418
 419 ;;; ----------------------------------------------------------------------
 420 ;;;
 421 ;;;###autoload
 422 (defun tinyeat-backward (&optional count)
 423   "Eat backward COUNT times. See `tinyeat-eat'."
 424   (interactive "p")
 425   (tinyeat-repeat-macro (or count 1)
 426                         (tinyeat-eat 'back)))
 427
 428 ;;; ----------------------------------------------------------------------
 429 ;;;
 430 ;;;###autoload
 431 (defun tinyeat-backward-preserve (&optional count)
 432   "Eat forward, but handle spaces differently. See `tinyeat-eat'."
 433   (interactive "p")
 434   (tinyeat-repeat-macro (or count 1)
 435                         (tinyeat-eat 'back 'preserve)))
 436
 437 ;;; ----------------------------------------------------------------------
 438 ;;;
 439 ;;;###autoload
 440 (defun tinyeat-forward (&optional count)
 441   "Eat forward COUNT times. See `tinyeat-eat'."
 442   (interactive "p")
 443   (tinyeat-repeat-macro (or count 1)
 444                         (tinyeat-eat)))
 445
 446 ;;; ----------------------------------------------------------------------
 447 ;;;
 448 ;;;###autoload
 449 (defun tinyeat-forward-preserve (&optional count)
 450   "Eat forward COUNT times. See `tinyeat-eat'."
 451   (interactive "p")
 452   (tinyeat-repeat-macro (or count 1)
 453                         (tinyeat-eat nil 'preserve)))
 454
 455 ;;; ----------------------------------------------------------------------
 456 ;;;
 457 ;;;###autoload
 458 (defun tinyeat-join-lines (&optional count)
 459   "Join this and next line with one space, and go to the joint."
 460   (interactive "p")
 461   (tinyeat-repeat-macro (or count 1)
 462                         (end-of-line)
 463                         (unless (eobp)
 464                           (kill-line)
 465                           (fixup-whitespace))))
 466
 467 ;;; ----------------------------------------------------------------------
 468 ;;;
 469 (defun tinyeat-delete-whole-word-1-charset (charset)
 470   "Delete word based on CHARSET. See `skip-chars-backward' and *-forward."
 471   (let* (beg
 472          end)
 473     (skip-chars-backward charset)
 474     (setq beg (point))
 475     (skip-chars-forward  charset)
 476     (setq end (point))
 477     (delete-region beg end)))
 478
 479 ;;; ----------------------------------------------------------------------
 480 ;;;
 481 (defun tinyeat-delete-whole-word-1-main  (&optional charset)
 482   "Delete one word at point. Optional CHARSET is for `skip-chars-backward'.
 483 References:
 484   `tinyeat-:eat-full-word-charset'"
 485   (interactive)
 486   (or charset
 487       (setq charset tinyeat-:eat-full-word-charset))
 488   (cond
 489    ((or (looking-at "[ \t\r\n][ \t\r\n]")
 490         (and (not (bolp))
 491              (string= " " (char-to-string (preceding-char)))
 492              (looking-at "[ \t\r\n]")))
 493     (fixup-whitespace))
 494    ((looking-at "[ \t\r\n]")
 495     (delete-horizontal-space))
 496    (t
 497     (tinyeat-delete-whole-word-1-charset charset)
 498     ;;      (unless (zerop (skip-chars-forward " \t"))   ; delete white space
 499 ;;;      (delete-region beg (point)))
 500     nil)))
 501
 502 ;;; ----------------------------------------------------------------------
 503 ;;;
 504 ;;;###autoload
 505 (defun tinyeat-delete-whole-word (&optional count)
 506   "Delete COUNT words at point.
 507
 508 - If there are multiple whitespaces around, call `fixup-whitespace'.
 509 - If on top of only one whitespcae, call `delete-horizontal-space'.
 510 - If on top of word, delete whole word.
 511
 512 References:
 513   `tinyeat-:eat-full-word-charset'"
 514   (interactive "p")
 515   (tinyeat-repeat-macro (or count 1)
 516                         (tinyeat-delete-whole-word-1-main)))
 517
 518 ;;; ----------------------------------------------------------------------
 519 ;;;
 520 ;;;###autoload
 521 (defun tinyeat-kill-line (&optional count)
 522   "Like `kill-line'; COUNT times. Killed text isn't put into cut buffer.
 523 This way you can retain mouse selection in cut buffer."
 524   (interactive "p")
 525   (tinyeat-repeat-macro (or count 1)
 526                         (cond
 527                          ((eobp))       ;Do nothing
 528                          ((eolp)
 529                           (delete-char 1))
 530                          (t
 531                           (delete-region (point) (line-end-position))))))
 532
 533 ;;; ----------------------------------------------------------------------
 534 ;;;
 535 ;;;###autoload
 536 (defun tinyeat-kill-line-backward (&optional count)
 537   "Like `kill-line' back; COUNT times. Killed text isn't put into cut buffer."
 538   (interactive "p")
 539   (tinyeat-repeat-macro (or count 1)
 540                         (when (not (bobp))
 541                           (if (bolp) ;Kill previous newline (shift line up)
 542                               (backward-delete-char 1)
 543                             (delete-region (point) (line-beginning-position))))))
 544
 545 ;;; ----------------------------------------------------------------------
 546 ;;;
 547 ;;;###autoload
 548 (defun tinyeat-kill-buffer-lines-point-max (&optional back)
 549   "Kill to the `point-max' or if BACK, then to the `point-min'."
 550   (interactive "P")
 551   (cond
 552    (back
 553     (delete-region (point) (point-min)))
 554    (t
 555     (delete-region (point) (point-max)))))
 556
 557 ;;; ----------------------------------------------------------------------
 558 ;;;
 559 ;;;###autoload
 560 (defun tinyeat-kill-buffer-lines-point-min ()
 561   "Kill until `point-min'."
 562   (interactive "p")
 563   (tinyeat-kill-buffer-lines-point-max 'back))
 564
 565 ;;; ----------------------------------------------------------------------
 566 ;;;
 567 ;;;###autoload
 568 (defun tinyeat-kill-buffer-lines-main (&optional backward)
 569   "Kill until `point-max' or if BACKWARD, until `point-min'."
 570   (interactive "p")
 571   (if backward
 572       (tinyeat-kill-buffer-lines-point-min)
 573     (tinyeat-kill-buffer-lines-point-max)))
 574
 575 ;;}}}
 576 ;;{{{ misc2
 577
 578 ;;; ----------------------------------------------------------------------
 579 ;;;
 580 ;;;###autoload
 581 (defun  tinyeat-delete-paragraph ()
 582   "Delete current paragraph, separated by empty lines."
 583   (interactive "*")
 584   (let* ((re "^[ \t]*$")
 585          beg
 586          end)
 587     (cond
 588      ((save-excursion                   ;sitting on empty line
 589         (beginning-of-line)         ;kill empty lines around the point
 590         (looking-at "^[ \t]*$"))
 591       (skip-chars-backward " \t\n")
 592       (forward-line 1)
 593       (setq beg (point))
 594       (skip-chars-forward " \t\n")
 595       (forward-line -1)
 596       (setq end (point)))
 597      ((save-excursion
 598         ;;  Kill paragraph.
 599         (if (not (re-search-backward re nil t))
 600             (setq beg (point-min))
 601           (beginning-of-line)
 602           (forward-line 1)              ;exlude space
 603           (setq beg (point))))
 604       (save-excursion
 605         (cond
 606          ((re-search-forward re nil t)
 607           (beginning-of-line)
 608           (setq end (point)))
 609          (t
 610           (if (not (eq beg (point-max)))
 611               (setq end (point-max))
 612             (setq end (point-min))))))))
 613     (if (and (not (and beg end))
 614              (not (ti::buffer-minibuffer-p)))
 615         (message "TinyEat: Can't find paragraph bounds (empty line)")
 616       (unless (eq beg end)
 617         (kill-region beg end)))))
 618
 619 ;;; ----------------------------------------------------------------------
 620 ;;;
 621 (defun tinyeat-space-delete-at-point (&optional back preserve)
 622   "Delete whitespace at point. Optionally BACK.
 623 If optional PRESERVE is given, then deletes towards the BACK only.
 624 if BACK is non-nil the deletion is headed backward."
 625   (let* ( ;; character function selection
 626          (charf   (if back 'skip-chars-backward 'skip-chars-forward))
 627          (p       (point))
 628          (ch      (ti::buffer-read-char back 0)) ;sitting on it if looking fwd
 629          (ch-p    (ti::buffer-read-char back -1))
 630          (ch-n    (ti::buffer-read-char back 1)))
 631     (cond
 632      ((and back
 633            (ti::space-p (or ch-p ?\ ))
 634            (char= ch ?\n))
 635       (delete-horizontal-space)
 636       (if (null back)
 637           (tinyeat-verbose-macro
 638            (message "TinyEat: line cleared")))
 639       t)
 640      ((char= ch ?\n)                    ;no spaces before, do nothing
 641       nil)
 642      ((or (and ch ch-n
 643                (ti::space-p ch)
 644                (ti::space-p ch-n))      ;at least two spaces
 645           (and ch ch-p
 646                (ti::space-p ch-p)
 647                (ti::space-p ch)))
 648       (if (null preserve)
 649           (fixup-whitespace)
 650         (funcall charf " \t")
 651         (delete-region p (point)))
 652       t)
 653      (t
 654       (delete-horizontal-space)
 655       t))))
 656
 657 ;;; ----------------------------------------------------------------------
 658 ;;;
 659 (defun tinyeat-word-move-point (&optional back)
 660   "Move to suitable word kill point. Mixed case words are special.
 661 Optionally BACK.
 662 See variable `tinyeat-:non-word-chars' how to delimit word parts.
 663
 664 * = cursor position
 665
 666 ThisIsMixedWord --> ThisIsMixedWord
 667 *                       *
 668 THISmixedWord   --> THISmixedWord
 669 *                       *"
 670   (let* ((fid         "tinyeat-word-move-point")
 671          (charf       (if back 'skip-chars-backward 'skip-chars-forward))
 672          (non-word    tinyeat-:non-word-chars)
 673          (nonw-re     (concat "[" non-word "]+"))
 674          (ch          (ti::buffer-read-char back))
 675          p
 676          str
 677          mb
 678          me                             ;match beg end
 679          mixed)
 680     (unless fid ;; Quiet XEmacs byte compiler
 681       (setq fid nil))
 682     (tinyeat-debug fid "ENTRY" 'back back
 683                    'char ch
 684                    (if ch
 685                        (char-to-string ch)
 686                      "no CHARACTER??"))
 687     ;;    Check if this is special mixedCase before vaporizing word...
 688     (save-excursion
 689       (setq p (point))
 690       (if back
 691           (backward-word 1)
 692         (forward-word 1))
 693       (setq str (buffer-substring p (point)))
 694       (setq mixed (ti::string-match-case "[A-Z][a-z]" str)))
 695     (cond
 696      (mixed
 697       (tinyeat-debug fid "CASE MIXED" 'point (point))
 698       (if (eq ch (downcase ch))
 699           (funcall charf "a-z")
 700         (setq p (point))
 701         ;;  Skip all big letters
 702         (funcall charf "A-Z")
 703         ;;  If this was only one letter, continue deleting. Otw stay put.
 704         (if (eq 1 (abs (- p (point))))
 705             (funcall charf "a-z")))
 706       ;;  The previous statements only moved 2 first statements
 707       ;;          ThisIsWord      start,
 708       ;;                   *
 709       ;;          ThisIsWord      after,
 710       ;;                 *
 711       ;;          ThisIsWord      correction. This is needed
 712       ;;                *
 713       (if (and back
 714                (not (bobp)))
 715           (backward-char 1)))
 716      (t
 717       ;; if there is non-word we must remove it.
 718       ;; - There is some problems in backward deltion, eg deleting "...."
 719       ;;   backward in text-mode does not delete all dots. Don't
 720       ;;   know why not.
 721       (cond
 722        ((if back                        ;select FWD of BCK looking
 723             (cond
 724              ((string-match nonw-re (char-to-string ch))
 725               (re-search-backward nonw-re nil t)))
 726           (looking-at nonw-re))
 727         (setq mb (match-beginning 0)
 728               me (match-end 0))
 729         (tinyeat-debug
 730          fid "CASE 1" ch 'point (point)
 731          'match-begin mb
 732          'match-end   me)
 733         ;;  1. if there is multiple items like "....", delete only
 734         ;;     those
 735         ;;  2. if there is only one member like ".member", delete
 736         ;;     dot and the word that follows it.
 737         ;;
 738         (if back (setq p mb)
 739           ;; selet direction
 740           (setq p me))
 741         (if (not (eq 1 (abs (- me mb))))
 742             (goto-char p)
 743           (goto-char p)
 744           (funcall charf (concat "^" non-word))))
 745        (t
 746         (tinyeat-debug "CASE default ")
 747         ;;  The skip-chars-forward _requires_ that the "-"
 748         ;;  character is the first item. That's why we have
 749         ;;  to add extra "-" to the front of string if user
 750         ;;  has defined "-" to be word stopper.
 751         (if (ti::string-match-case "-" non-word)
 752             (setq non-word (concat  "^-" non-word))
 753           (setq non-word (concat "^" non-word)))
 754         (tinyeat-debug "CASE default " charf non-word)
 755         (funcall charf non-word)))))))
 756
 757 ;;}}}
 758 ;;{{{ Yanking
 759
 760 ;;; ----------------------------------------------------------------------
 761 ;;; Having overwrite-mode on, does not support this kind of behavior?
 762 ;;;
 763 (defun tinyeat-yank-overwrite ()
 764   "Yank text by overwriting previous content."
 765   (interactive)
 766   (let* ((p  (point))                   ;insertion point
 767          len
 768          end)
 769     (with-temp-buffer
 770       (yank)
 771       (setq len (1- (point-max))))      ;how many chars in there ?
 772     (cond
 773      ((= len 0)
 774       (unless (ti::buffer-minibuffer-p)
 775         (message "TinyEat: Nothing to yank")))
 776      (t
 777       ;;   we must untabify  the line, otw we get unpleasant results
 778       (untabify p (line-end-position))
 779       (setq end (+ p len))
 780       (if (> end (point-max))
 781           (setq end (point-max)))
 782       (delete-region p end)
 783       (yank)))))
 784
 785 ;;}}}
 786 ;;{{{ engine
 787
 788 ;;; ----------------------------------------------------------------------
 789 ;;;
 790 ;;;###autoload
 791 (defun tinyeat-eat (&optional back ti::space-preserve)
 792   "Eat *appropriate* text forward, if BACK then backward.
 793
 794 The optional SPACE-PRESERVE changes the space eating.
 795
 796 A.  when it is NIL and BACK is anything.   * marks the cursor.
 797          text1 text1        *     text2  text2
 798     -->  text1 text1 text2  text2                   ;one space left
 799
 800 B.  when it is NON-NIL and BACK nil
 801          text1 text1        *     text2  text2
 802     -->  text1 text1        *text2  text2            ;delete right spaces
 803
 804 C.  when it is NON-NIL and BACK t
 805          text1 text1        *     text2  text2
 806          text1 text1*     text2  text2               ;delete left spaces
 807
 808 References:
 809
 810   `tinyeat-:non-word-chars'"
 811   (let ((fid        "tinyeat-eat ")
 812         (p          (point))
 813         (syntaxf    (if back 'skip-syntax-backward 'skip-syntax-forward))
 814         (charf      (if back 'skip-chars-backward  'skip-chars-forward))
 815         ch
 816         ch-n)
 817     ;;  XEmacs byte compiler thinks 'fid' is unused? Well, on the contrary.
 818     ;;  Quiet it. This is no-op.
 819     (unless fid
 820       (setq fid nil))
 821     ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. ..
 822     (setq ch (ti::buffer-read-char back 0)) ;; sitting on it if looking fwd
 823     (setq ch-n (ti::buffer-read-char back 1)) ;; next
 824     (tinyeat-debug
 825      fid
 826      "CHARACTER " ch  (char-to-string ch)
 827      "NEXT CHARACTER" ch-n (char-to-string ch-n))
 828     (cond
 829      ;; --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``--
 830      ;; BEG of buffer or END of buffer
 831      ((eq nil ch)
 832       (tinyeat-debug fid "CHARCTER is nil, maybe bop or eob")
 833       (tinyeat-verbose-macro
 834        (message
 835         "TinyEat: "
 836         (concat
 837          (if (bobp)
 838              "Beginning"
 839            "End")
 840          " of buffer"))))
 841      ;; --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``--
 842      ((ti::space-p ch)                  ;one whitespace
 843       (tinyeat-debug fid
 844                      "SPACE-P choice" 'back back 'preserve ti::space-preserve)
 845       (tinyeat-space-delete-at-point back ti::space-preserve)
 846       (if (and (null back)
 847                (looking-at "$"))        ;it handled this
 848           (tinyeat-verbose-macro
 849            (message "TinyEat: line cleared."))))
 850      ;; --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``--
 851      ;; - Multiple  newlines, squeeze to one only
 852      ((and (char= ch ?\n)
 853            ch-n
 854            (char= ch-n ?\n))
 855       (funcall charf "\n")
 856       (if (null back)
 857           (backward-char 1)        ;do not join, leave 1 EMPTY newline
 858         (forward-char 1))
 859       (tinyeat-debug fid "MULTIPLE newlines" 'was-point p 'now-point (point))
 860       (delete-region p (point)))
 861      ;; --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``--
 862      ;; - at the end of line I suppose add previous line to it.
 863      ((char= ch ?\n)
 864       (tinyeat-debug
 865        fid "NEWLINE" 'back back 'ti::space-preserve ti::space-preserve)
 866       (unless (tinyeat-space-delete-at-point back ti::space-preserve)
 867         (if (null back)                 ;which direction
 868             (delete-char 1)
 869           (if (not (eq 0 (funcall syntaxf  "_"))) ;try to move
 870               (delete-region p (point))           ;moveti::d!
 871             (backward-char 1)
 872             (delete-region p (point))))))
 873      ;; --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``-- --``--
 874      ;; WORD handling (blocks)
 875      (t                                 ;eat next word
 876       (funcall syntaxf " ")             ;ignore spaces
 877       (tinyeat-debug fid "default - WORD CASE\n"
 878                      "CHARACTER " (char-to-string ch)
 879                      "CHARACTER SYNTAX " (char-to-string (char-syntax ch)))
 880       ;;   - What is next char after whitespace ??
 881       ;;   - With these following conditionals we set the point
 882       ;;     to appropriate position and after COND we run the kill command
 883       (cond
 884        ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. ..
 885        ((and (not  (ti::char-in-list-case ch  '(?- ?_ ?:)))
 886              (equal ?w (char-syntax ch)))
 887         (tinyeat-debug fid "-- CASE 1 syntaxes [-_:]")
 888         (tinyeat-word-move-point back))
 889        ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. ..
 890        ((and (ti::char-in-list-case ch   '(?- ?_ ?:))
 891              ch-n
 892              (memq (char-syntax ch-n)  '(?w ?\ )))
 893         (tinyeat-debug fid "-- CASE 2")
 894         ;;  This is really hard to understand... execpt for the author
 895         ;;  1) Is CH variable start, a delimiter ?
 896         ;;  2) AND is the NEXT-CH word or whitespace
 897         ;; (funcall syntaxf  "_w")
 898         ;; (funcall syntaxf  " w")
 899         (funcall charf "-_:"))
 900        ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. ..
 901        (t
 902         ;; punctuation, comment, the rest ... skip non important stuff
 903         (tinyeat-debug fid "-- CASE other")
 904         (funcall charf "^ \t\na-zA-Z0-9")))
 905       (delete-region p (point))))))
 906
 907 ;;}}}
 908
 909 (provide   'tinyeat)
 910 (run-hooks 'tinyeat-:load-hook)
 911
 912 ;;; tinyeat.el ends here