emacs_el/tiny-tools/tiny/tinypair.el

   1 ;;; tinypair.el --- Self insert character (pa)irs () "" '' <>
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   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 M-x tinypair-version.
  13 ;; 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 ;;      ** MINOR MODE IS GLOBALLY ACTIVED WHEN YOU LOAD THIS FILE **
  42 ;;
  43 ;;      ;;  If you don't want global activation, use
  44 ;;      ;;  (defvar tinypair-mode nil)
  45 ;;
  46 ;;      (require 'tinypair)
  47 ;;      (tinypair-pair-type-select 'us)         ;; US `style'
  48 ;;      (tinypair-pair-type-select 'european)   ;; European 'style'
  49 ;;
  50 ;; Or use autoload and your Emacs starts faster
  51 ;;
  52 ;;      (autoload 'turn-on-tinypair-mode "tinypair")
  53 ;;      (add-hook <your-favourite-mode-hook> 'turn-on-tinypair-mode)
  54 ;;
  55 ;; If you want to turn the pairing off, use this:
  56 ;;
  57 ;;      M-x turn-off-tinypair-mode
  58 ;;
  59 ;; If you have any questions, use this function
  60 ;;
  61 ;;      M-x tinypair-submit-bug-report
  62 ;;
  63 ;; If you find any incorrect behavior, please immediately
  64 ;;
  65 ;;      o   Turn on debug M-x tinypair-debug-toggle
  66 ;;      o   Repeat the task
  67 ;;      o   Send bug report
  68
  69 ;;}}}
  70 ;;{{{ Documentation
  71
  72 ;; ..................................................... &t-commentary ...
  73 ;;; Commentary:
  74
  75 ;;  Preface, 1995
  76 ;;
  77 ;;      Pacakge paired-insert.el was posted to gnu.emacs.help group, and
  78 ;;      the code was not very well documented, The code showed lot of
  79 ;;      promises, but it lacked smart pairing, so this package was born instead.
  80 ;;
  81 ;;  Overview of features
  82 ;;
  83 ;;      o   Minor mode for paired characters.
  84 ;;      o   [] {} <> '' `' ""
  85 ;;
  86 ;;  Pairing control
  87 ;;
  88 ;;      *Remember* Always ask youself "Does this character the cursor is
  89 ;;      on, belong to _word_ class?", when you wonder why the pairing does
  90 ;;      not take in effect around the current character block.
  91 ;;
  92 ;;      The pair control is turned off for lisp mode, because it makes
  93 ;;      things worse if the pairing is on. The pairing in US style includes
  94 ;;
  95 ;;          `'
  96 ;;
  97 ;;      But European people almost never use backquote, intead they use:
  98 ;;
  99 ;;          ''
 100 ;;
 101 ;;  General pairing rules, just some of them
 102 ;;
 103 ;;      The pairing is done according to assoc lists in the following way:
 104 ;;
 105 ;;      o   if there is whitespace in front of char, then pair is inserted
 106 ;;      o   if character is over pair-end, no pairing takes effect.
 107 ;;          Like if you press opening paren when you're sitting on the
 108 ;;          closing paren:
 109 ;;
 110 ;;          ()
 111 ;;           *  <-- cursor here, pressing another ( does not pair.
 112 ;;
 113 ;;      but this behavior can be controlled through variable
 114 ;;
 115 ;;      o  if the cursor is at the beginning of the word (see syntax-table):
 116 ;;          -- if there is no pairs around the word, the whole word is paired.
 117 ;;          -- if there is pair, no pairing takes effect. The char acts as
 118 ;;          self-insert-command.
 119 ;;
 120 ;;      o   if previous character is word. then the '  doesn't pair. Reason
 121 ;;          is in english language .........................^
 122 ;;
 123 ;;      o   if character is repeated with prefix arg, the pairing isn't done,
 124 ;;          instead the character is repeated as in self-insert-command.
 125 ;;
 126 ;;  Cursor positioning
 127 ;;
 128 ;;      By default the cursor is positioned in the "middle" of the inserted
 129 ;;      pair chars. But for words, this is impossible, because there is no
 130 ;;      middle position. Please see the variables
 131 ;;
 132 ;;          tinypair-:word-positioning
 133 ;;          tinypair-:word-positioning-function
 134 ;;
 135 ;;      which allow you to customize cursor positioning after word pairing.
 136 ;;
 137 ;;  Word about syntax tables
 138 ;;
 139 ;;      Syntax table play a major part in pairing, especially pairing words
 140 ;;      correctly. Suppose you're writing in text mode:
 141 ;;
 142 ;;          ...txt txt... (help is the key)
 143 ;;                         *                    <-- cursor
 144 ;;
 145 ;;      If you now press " to have the word HELP paired, you don't get it,
 146 ;;      because normally text mode's syntax table says that "(" belongs
 147 ;;      to group "w" (word) too. So the actual word is seen as "(help" and
 148 ;;      the program determines that you're inside a word, thus not
 149 ;;      allowing the pairing.
 150 ;;
 151 ;;      In the other hand, if you were in any other mode, say in C++, the
 152 ;;      "(" is defined as open parenthesis syntax and it that case the
 153 ;;      seen word seen would have been "help" and the " character would have
 154 ;;      been added around the HELP string. Like this:
 155 ;;
 156 ;;          ...txt txt... ("help" is the key)
 157 ;;                          *                   <-- cursor
 158 ;;
 159 ;;      You may propably want quickly to see the syntax definition of
 160 ;;      characters; use function from my lisp libraries
 161 ;;
 162 ;;          (defalias 'syntax-info 'ti::string-syntax-info)
 163 ;;
 164 ;;      To return to this syntax problem in text mode, you could do the
 165 ;;      following, to make certain characters out of "w" class.
 166 ;;
 167 ;;          (defun my-syntax-default (table )
 168 ;;            "My syntax table settings."
 169 ;;            (modify-syntax-entry ?[ "_" table)
 170 ;;            (modify-syntax-entry ?] "_" table)
 171 ;;            (modify-syntax-entry ?{ "_" table)
 172 ;;            (modify-syntax-entry ?} "_" table)
 173 ;;            (modify-syntax-entry ?( "_" table)
 174 ;;            (modify-syntax-entry ?) "_" table)
 175 ;;            (modify-syntax-entry ?/ "." table)
 176 ;;            (modify-syntax-entry ?\' "\"" table)
 177 ;;            (modify-syntax-entry ?\" "\"" table)
 178 ;;            (modify-syntax-entry ?_ "w" table))
 179 ;;
 180 ;;      Then you just change the definitions of syntax table in hook:
 181 ;;
 182 ;;          (setq text-mode-hook 'my-text-mode-hook)
 183 ;;          (defun my-text-mode-hook ()
 184 ;;            (my-syntax-default  text-mode-syntax-table))
 185 ;;
 186 ;;      Do you wonder why I put {}()[] into "_" class and not in
 187 ;;      corresponding "(" or ")" classes? Well, my stig-paren just went
 188 ;;      beserk and started beeping the bell whenever I was nearby
 189 ;;      ")" class... The "_" shut it down, so I just chose it. You can
 190 ;;      of course put the chars into any class you like.
 191 ;;
 192
 193 ;;}}}
 194
 195 ;;; Change Log:
 196
 197 ;;; Code:
 198
 199 ;;{{{ setup: require
 200
 201 (require 'tinylibm)
 202
 203 (eval-when-compile (ti::package-use-dynamic-compilation))
 204
 205 (ti::package-defgroup-tiny TinyPair tinypair-: extensions
 206   "self insert character pairs () \"\" '' <>
 207   Overview of features
 208
 209         o   When you hit e.g. \", package will double the character. If you
 210             insertion point was on whitespace, the pair is inserted 'as
 211             is', but if point was in front of word, the word is surrounded
 212             with pair, provided that there we no pair already.
 213         o   Every pair beginning character may have it's own function
 214             to handle the pairing.")
 215
 216 ;;}}}
 217 ;;{{{ setup: hook
 218
 219 (defcustom tinypair-:load-hook nil
 220   "*Hook that is run when package is loaded."
 221   :type  'hook
 222   :group 'TinyPair)
 223
 224 ;;}}}
 225 ;;{{{ setup: private
 226
 227 (defvar tinypair-:us-alist
 228   '((?\(    ?\) nil)
 229     (?\[    ?\] nil)
 230     (?\{    ?\} nil)
 231     (?\<    ?\> tinypair-c-\<)
 232     (?\`    ?\' tinypair-c-\')
 233     (?\"    ?\" tinypair-c-\"))
 234   "Default US pairing alist.")
 235
 236 (defvar tinypair-:european-alist
 237   '((?\(  ?\)   nil)
 238     (?\[  ?\]   nil)
 239     (?\{  ?\}   nil)
 240     (?\<  ?\>   tinypair-c-\<)
 241     (?\'  ?\'   tinypair-c-\')
 242     (?\`  ?\`   nil)             ;in perl, or shell you need backticks
 243     (?\"  ?\"   tinypair-c-\"))
 244   "Default European pairing alist.")
 245
 246 (defvar tinypair-:alist tinypair-:us-alist
 247   "The pairing alist '((?BEG-CHAR  ?END-CHAR FUNC-SYM) ..)
 248 The FUNC-SYM element is optional. FUNC definition should have form,
 249
 250 accepted args:
 251
 252   BEG-CHAR
 253   END-CHAR
 254
 255 Return values:
 256
 257    t    force immediate pairing
 258    nil  pairing prohibited, main should insert char \"as is\"
 259    nbr  return control to main program.
 260    sym  func handled pairing, main program should terminate.
 261
 262 If the func element is missing, pairing is done always according to main
 263 function's decision.")
 264
 265 ;;; ........................................................ &v-public ...
 266 ;;; User configurable
 267
 268 ;;  - Since not all people program with perl-mode when coding perl
 269 ;;    (I don't use it), the default function here is not always
 270 ;;    the best choice.
 271 ;;  - For detecting buffer contents in more robust way that just
 272 ;;    relying on the major-mode variable, see this
 273 ;;
 274 ;;        tinylibid.el -- Identifying buffer regardless of mode
 275
 276 (defcustom tinypair-:all-pairing-disabled-function
 277   'tinypair-check-if-pairing-allowed
 278   "*Funtion to determine if any pairing is allowed.
 279 Takes no args, and must return nil or non-nil.
 280 If return value is non-nil, pairing is allowed."
 281   :type  'function
 282   :group 'TinyPair)
 283
 284 (defcustom tinypair-:disable-mode-list
 285   '(message-mode
 286     gnus-summary-mode
 287     gnus-article-mode
 288     gnus-group-mode
 289     gnus-server-mode
 290     rmail-summary-mode
 291     rmail-mode
 292     vm-summary-mode
 293     vm-mode
 294     lisp-mode
 295     emacs-lisp-mode
 296     lisp-interaction-mode
 297     compilation-mode
 298     compilation-minor-mode
 299     gud-mode
 300     shell-mode
 301     comint-mode
 302     dired-mode
 303     vc-dired-mode
 304     cvs-mode
 305     rcs-mode
 306     Electric-buffer-menu-mode ;; std emacs ebuff-menu.el
 307     Buffer-menu-mode          ;; std Emacs
 308     bs-mode) ;; bs.el by <Olaf.Sylvester@kiel.netsurf.de>
 309   "*List of `major-mode' symbols, where the pairing is prohibited.
 310 This variable is used by function `tinypair-check-if-pairing-allowed' which is
 311 the default Manager for pairing. If you
 312 change `tinypair-:all-pairing-disabled-function', this variable is not used."
 313   :type  '(repeat symbol)
 314   :group 'TinyPair)
 315
 316 (defcustom tinypair-:automatic-word-pairing t
 317   "*If non-nil, then the word pairing is allowed.
 318 Eg when your cursor is at the beginning of word, pressing
 319 pair-beg char will pair the whole word.
 320
 321    txt          -->                (txt)"
 322   :type  'boolean
 323   :group 'TinyPair)
 324
 325 (defcustom tinypair-:word-positioning-function
 326   'tinypair-word-position-function
 327   "*Function to position the cursor after pairing.
 328 The value can also be a function symbol, which takes care of positioning
 329 the cursor. Passed parameters are:
 330
 331   BEG-POINT     ,point+1 where the beg-char were inserted
 332   BEG-CHAR      ,character
 333
 334 If function returns, non-nil it is assumed that function handled the
 335 positioning. If it returns nil, then the control is returned to calling
 336 program and the positioning is done according to variable
 337 `tinypair-:word-positioning'"
 338   :type  'function
 339   :group 'TinyPair)
 340
 341 (defcustom tinypair-:word-positioning 'end
 342   "*How the cursor should be positioned after word pairing.
 343 'beg          ,leave point after beg pair char
 344   'end          ,leave point after end pair char"
 345   :type  '(choice
 346            (const beg)
 347            (const end))
 348   :group 'TinyPair)
 349
 350 (defcustom tinypair-:word-syntax-classes  '(?w ?$ ?. )
 351   "*List of syntax classes that are treated like WORD while pairing.
 352 Eg if you have following text in LaTeX mode:
 353
 354     $x^2+$
 355          *      <-- cursor here, now you want to pair it with (
 356
 357 You would normally get
 358
 359     $x^2+()$
 360           *
 361
 362 Because the character $ is in class $. (You can check the class with
 363 function `tinypair-syntax-info'). But when the is defined into this variable's
 364 list, it is seen as \"word\", and the pairing is done like for word,
 365 so that you get this:
 366
 367      $x^2+($)
 368            *"
 369   :type  '(repeat character :tag "syntax class")
 370   :group 'TinyPair)
 371
 372 ;;}}}
 373 ;;{{{ setup: version
 374
 375 ;;;###autoload (autoload 'tinypair-version "tinypair" "Display commentary." t)
 376
 377 (eval-and-compile
 378   (ti::macrof-version-bug-report
 379    "tinypair.el"
 380    "tinypair"
 381    tinypair-:version-id
 382    "$Id: tinypair.el,v 2.47 2007/05/01 17:20:51 jaalto Exp $"
 383    '(tinypair-:version-id
 384      tinypair-:debug
 385      tinypair-:load-hook
 386      tinypair-:us-alist
 387      tinypair-:european-alist
 388      tinypair-:alist
 389      tinypair-:all-pairing-disabled-function
 390      tinypair-:disable-mode-list
 391      tinypair-:automatic-word-pairing
 392      tinypair-:word-positioning-function
 393      tinypair-:word-positioning
 394      tinypair-:word-syntax-classes)
 395    '(tinypair-:debug-buffer)))
 396
 397 ;;}}}
 398 ;;{{{ misc
 399
 400 ;;; ............................................................ &mode ...
 401
 402 ;;;###autoload (autoload 'tinypair-mode            "tinypair" "" t)
 403 ;;;###autoload (autoload 'turn-on-tinypair-mode    "tinypair" "" t)
 404 ;;;###autoload (autoload 'turn-off-tinypair-mode   "tinypair" "" t)
 405 ;;;###autoload (autoload 'tinypair-commentary      "tinypair" "" t)
 406
 407 (defvar tinypair-mode t
 408   "*Minor mode on/off flag.")
 409
 410 (make-variable-buffer-local 'tinypair-mode)
 411
 412 (ti::macrof-minor-mode-wizard
 413  "tinypair-" " p" nil  "Pair" 'TinyUrl "tinypair-:"
 414  "Paired insert of characters.
 415
 416 Defined keys:
 417
 418 \\{tinypair-:mode-map}"
 419
 420  "Paired insert"
 421  nil
 422  ;;  The Menubar item takes space and is not useful at least not
 423  ;;  now, because there is no other functionality in this mode.
 424  nil
 425  nil
 426  (progn
 427    (define-key root-map "<"  'tinypair-self-insert-command)
 428    (define-key root-map "("  'tinypair-self-insert-command)
 429    (define-key root-map "{"  'tinypair-self-insert-command)
 430    (define-key root-map "["  'tinypair-self-insert-command)
 431    (define-key root-map "\"" 'tinypair-self-insert-command)
 432    (define-key root-map "'"  'tinypair-self-insert-command)
 433    (define-key root-map "`"  'tinypair-self-insert-command)
 434    (define-key root-map "\C-c\"" 'tinypair-pair-type-select)))
 435
 436 ;;;### (autoload 'tinypair-debug-toggle "tinypair" t t)
 437
 438 (eval-and-compile (ti::macrof-debug-standard "tinypair" "-:"))
 439
 440 (defalias 'tinypair-syntax-info 'ti::string-syntax-info)
 441
 442 ;;; ----------------------------------------------------------------------
 443 ;;;
 444 (defsubst tinypair-word-class-p (class)
 445   "Check if CLASS of part of logical word classes."
 446   (memq class tinypair-:word-syntax-classes))
 447
 448 ;;; ----------------------------------------------------------------------
 449 ;;;
 450 (defun tinypair-whitespace-p ()
 451   "Check that current point is sitting alone. No word next to it."
 452   (let ((prev (char-to-string (or (preceding-char) ?\n )))
 453         (next (char-to-string (or (following-char) ?\n ))))
 454     (and (string-match "[ \000\t\n\f\r]" prev)
 455          (string-match "[ \000\t\n\f\r]" next))))
 456
 457 ;;; ----------------------------------------------------------------------
 458 ;;;
 459 (defun tinypair-word-class-skip (&optional back)
 460   "Skip forward all `tinypair-:word-syntax-class' characters. Optionally BACK."
 461   (let* ((ptr           tinypair-:word-syntax-classes)
 462          (func          (if back
 463                             'skip-syntax-backward
 464                           'skip-syntax-forward))
 465          (point         (point)))
 466     (while ptr
 467       (funcall func (char-to-string (car ptr)))
 468       (if (eq (point) point)
 469           (pop ptr)
 470         ;; moved, start over.
 471         (setq point (point))
 472         (setq ptr tinypair-:word-syntax-classes)))))
 473
 474 ;;; ----------------------------------------------------------------------
 475 ;;;
 476 (defun tinypair-word-beginning-paired-on-line (char-string)
 477   "Search backward CHAR-STRING and check if it's next to word in current line.
 478 The point is not preserved.
 479 See `tinypair-:word-syntax-classes' for word definition."
 480   (interactive)
 481   (when (search-backward char-string (line-beginning-position) t)
 482     (if (tinypair-word-class-p (char-syntax (ti::buffer-read-char nil 1)))
 483         t)))
 484
 485 ;;; ----------------------------------------------------------------------
 486 ;;;
 487 (defun tinypair-elt-beg (elt)
 488   "Return begin pair from ELT."
 489   (nth 0  elt))
 490
 491 (defun tinypair-elt-end (elt)
 492   "Return end pair from ELT."
 493   (nth 1 elt))
 494
 495 (defun tinypair-elt-func (elt)
 496   "Return func from ELT."
 497   (if (= (length elt) 3)
 498       (nth 2 elt)
 499     nil))
 500
 501 ;;}}}
 502 ;;{{{ pair control
 503
 504 ;;; ----------------------------------------------------------------------
 505 ;;; "c"  refers to "checking func"
 506 ;;;
 507 (defun tinypair-c-\' (ch1 ch2)
 508   "Check if tick '  character can be paired."
 509   (setq ch1 ch2) ;;  Byte compiler silencer
 510   ;;  - Check previous character. If it is a word, assume that user is
 511   ;;    writing regular text, like "I'm, it's, he's"
 512   ;;  - In fact this test is useful in old perl code too, where
 513   ;;    one writes "$package'variable".
 514   (cond
 515    ((tinypair-word-class-p (char-syntax (preceding-char)))
 516     nil)
 517    (t
 518     1)))
 519
 520 ;;; ----------------------------------------------------------------------
 521 ;;;
 522 (defun tinypair-c-\< (ch1 ch2)
 523   "Check if <  character can be paired. In HTML mode when there
 524 is tag end,\"slash\", it's not desirable to have <>. Several other HTML
 525 cases are checked too."
 526   (setq ch1 ch2) ;;  Byte compiler silencer
 527   (let* ((ret 1))
 528     (cond
 529      ((memq (following-char) '(?/ ))
 530       (setq ret nil))
 531      ((eq major-mode 'shell-mode)
 532       (setq ret nil))
 533      ((and nil ;; currently disabled
 534            (not (tinypair-whitespace-p))
 535            (tinypair-word-beginning-paired-on-line "<"))
 536       (setq ret nil))
 537      ((or (looking-at "a[ \t]+href")
 538           (looking-at "hr[ \t]\\(size\\|wid\\)") ;1.1N <hr size=..>
 539           (looking-at "\\(th\\|tr\\)[ \t]align") ;1.1N tables
 540           (looking-at "p[ \t]+align")            ;1.1N <p align=..>
 541           (looking-at "\\(link\\|img\\|form\\) "))
 542       ;;  The word pairing isn't good in sgml/html mode.
 543       ;;
 544       ;;  If we have
 545       ;;     <A HREF="http://www.interplay.com">Interplay</a>
 546       ;;     <LINK REV="company"  HREF="http://www.interplay.com">
 547       ;;
 548       (setq ret nil)))
 549     ret))
 550
 551 ;;; ----------------------------------------------------------------------
 552 ;;;
 553 ;;;  It's like you have opened ne quote
 554 ;;;   "txt txt txt
 555 ;;;       *               ,point here, and you want to end the quote..
 556 ;;;
 557 ;;;  In this case the pairing isn't desiredable
 558 ;;;
 559 (defun tinypair-c-\" (ch1 ch2)
 560   "Check if \"  character can be paired. Looks backward if previous word
 561 has starting pair.
 562 "
 563   (let* ((ret 1)                        ;default is main handling
 564          prev                           ;char
 565          point)
 566     ;;  The prev is nil if point is in BOB
 567     (setq  prev (char-syntax (or (ti::buffer-read-char nil -1) ?\ )))
 568     (if (and prev
 569              (tinypair-word-class-p prev))
 570         (save-excursion
 571           (setq point (point))
 572           ;;  "This statement has been paired"
 573           ;;                                 *cursor-here
 574           ;;
 575           ;;  If we find QUOTE next to WORD, then we assume that this
 576           ;;  is just closing QUOTE and we won't pair it
 577           (if (tinypair-word-beginning-paired-on-line "\"")
 578               (setq ret nil))
 579           (when ret
 580             (skip-syntax-backward "w")
 581             ;;  point must move, because the skip-syntax will skip
 582             ;;        "txt"
 583             ;;         2  1          1= before  2, after
 584             ;;  and reading that first " require backward char
 585             (when (and (not (= point (point))) ;require movement
 586                        (not (bobp))
 587                        (prog1 t (forward-char -1)) ;now we can move
 588 ;;;                (ti::d! (following-char) ch1)
 589                        (eq (following-char) ch1))
 590               ;;  disallow pairing
 591               (setq ret nil)))))
 592     ret))
 593
 594 ;;}}}
 595 ;;{{{ other
 596
 597 ;;; ----------------------------------------------------------------------
 598 ;;;
 599 (defun tinypair-check-if-pairing-allowed ()
 600   "Function to determine if pairing is allowed.
 601 Returns t, when pairing is allowed for buffer."
 602   (not (memq major-mode tinypair-:disable-mode-list)))
 603
 604 ;;; ----------------------------------------------------------------------
 605 ;;;
 606 (defun tinypair-move (count)
 607   (cond
 608    ((or (not (integerp count))
 609         (<= count 1))
 610     nil)                                ;do nothing
 611    (t
 612     (backward-char (/ count 2)))))
 613
 614 ;;; ----------------------------------------------------------------------
 615 ;;; - I used this before, may use it again...
 616 ;;;
 617 (defun tinypair-move-logical-word (&optional count)
 618   "Move forward, skipping `tinypair-:word-syntax-classes' COUNT times."
 619   (let* ((i             0)
 620          (count         (or count 1))
 621          (back          (if (< count 0)
 622                             'back
 623                           nil))
 624          (func          (if back 'skip-chars-backward
 625                           'skip-chars-forward)))
 626     (while (< i count)
 627       (funcall func " \f\t\r\n")        ;ignore whitespace
 628       (tinypair-word-class-skip back)
 629       (incf i))))
 630
 631 ;;; ----------------------------------------------------------------------
 632 ;;;
 633 (defun tinypair-word-position-function (beg char)
 634   "Special cursor positioning function.
 635 BEG is start point and CHAR is starting pair character."
 636   (cond
 637    ((char= char ?\( )
 638     ;;  Mostly in minibuffer and for lisp'ish things, put cursor
 639     ;;  after starting paren.
 640     (goto-char beg))
 641    ((or (char= char ?\' )               ;Move to next word.
 642         (char= char ?\` ))
 643     (let (point)
 644       (save-excursion
 645         (skip-chars-forward " \t\f")
 646         (unless (tinypair-whitespace-p)
 647           (setq point (point))))
 648       (goto-char point)))
 649    (t
 650     nil)))
 651
 652 ;;; ----------------------------------------------------------------------
 653 ;;;
 654 (defun tinypair-word-pair (arg ch-beg ch-end)
 655   "Insert pair around word(s) ARG times using CH-BEG and CH-END."
 656   (let* ((fid       "tinypair-word-pair: ")
 657          (pos-flag  tinypair-:word-positioning)
 658          (pos-func  tinypair-:word-positioning-function)
 659          ch1
 660          ch2
 661          read-ch
 662          count
 663          syntax-now syntax-prev
 664          tmp
 665          beg)
 666     (setq syntax-prev  (char-syntax
 667                         (setq ch1 (or (preceding-char) ?\ ))))
 668     (setq syntax-now  (char-syntax
 669                        (setq ch2 (or (following-char) ?\ ))))
 670     ;;  No-ops. XEmacs byte ocmpiler silencers
 671     (unless ch2
 672       (setq ch2 nil))
 673     (unless fid
 674       (setq fid nil))
 675     (tinypair-debug fid
 676                     "arg"
 677                     arg
 678                     "syntax now"
 679                     (char-to-string syntax-now)
 680                     "char syntax prev"
 681                     (char-to-string syntax-prev)
 682                     "Is-word-class now"
 683                     (tinypair-word-class-p syntax-now)
 684                     "Is-word-class prev"
 685                     (tinypair-word-class-p syntax-prev)
 686                     "CH1"
 687                     (char-to-string ch1)
 688                     "CH2"
 689                     (char-to-string ch2))
 690     (cond
 691      ((and (or (null arg)
 692                (integerp arg))
 693            (tinypair-word-class-p syntax-now)
 694            ;;  the $ character is consudered word in programming
 695            ;;  modes, so treat it specially. So is Perl's %
 696            ;;
 697            ;;      $<cursor>PATH
 698            ;;
 699            ;;  The wanted behavior is
 700            ;;
 701            ;;      ${PATH}     not ${}PATH
 702            ;;
 703            (or (null (tinypair-word-class-p syntax-prev))
 704                (ti::char-in-list-case ch1 '(?$ ?%))))
 705       (setq count (if (null arg)
 706                       1
 707                     arg))
 708       (if (< count 0)                   ;switch the values
 709           (setq tmp ch-beg   ch-beg ch-end   ch-end tmp))
 710       (insert ch-beg)
 711       (setq beg (point))
 712       (tinypair-move-logical-word count)
 713       (setq read-ch (or (ti::buffer-read-char nil 0) ?\  ))
 714       (tinypair-debug fid "count" count
 715                       "point" (point)
 716                       "read ch end"
 717                       (char-to-string read-ch)
 718                       (char-to-string ch-end))
 719       (unless (char= read-ch ch-end)
 720         (insert ch-end)))
 721      ((integerp arg)
 722       (insert (ti::string-repeat arg ch-beg)))
 723      (t                                 ;default case
 724       (tinypair-debug fid "default")
 725       (insert ch-beg ch-end)
 726       (backward-char 1)
 727       (setq pos-flag nil)))
 728     ;; ............................................ cursor positioning ...
 729     (setq tmp nil)                      ;"status" of call
 730     (and (fboundp pos-func)
 731          (integerp beg)
 732          (setq tmp (funcall pos-func beg ch-beg)))
 733     (tinypair-debug fid "cursor>>" beg (fboundp pos-func) tmp)
 734     (cond
 735      ((not (null tmp))                  ;function handled this.
 736       nil)
 737      ((eq 'beg pos-flag)
 738       (and (integerp beg)
 739            (goto-char beg)))
 740      (t
 741       nil))))
 742
 743 ;;}}}
 744 ;;{{{ main
 745
 746 ;;; ----------------------------------------------------------------------
 747 ;;;
 748 (defun tinypair-pair-type-select (&optional arg)
 749   "Pairing control center.
 750 Input:
 751  nil 'us 'usa    Use US pairing.
 752  other value     Use European pairing style."
 753   (interactive "P")
 754   (if (interactive-p)
 755       (message "TinyPair: Selected %s pairing style "
 756                (if arg "European" "US" )))
 757   (cond
 758    ((memq arg '(nil us usa))
 759     (setq tinypair-:alist tinypair-:us-alist))
 760    (t
 761     (setq tinypair-:alist tinypair-:european-alist))))
 762
 763 ;;; ----------------------------------------------------------------------
 764 ;;; - Original idea in 19.29+ package paired-insert.el. Unfortunately the
 765 ;;;   package didn't satisfy my needs, so here is better pairing func.
 766 ;;;
 767 ;;; - the 'pair' variable in this function is purposively set
 768 ;;;   many times, although it is not always necessary. It is just eases
 769 ;;;   following the program flow.
 770 ;;;
 771 (defun tinypair-self-insert-command (arg)
 772   "Smart pairing. ARG is repeat count of character."
 773   (interactive "P")
 774   (let*  ((fid          "tinypair-self-insert-command: ")
 775           (nbr          (prefix-numeric-value arg))
 776           (word-pair    tinypair-:automatic-word-pairing)
 777           (ch           last-command-char)
 778           (elt          (assoc ch tinypair-:alist))
 779           ;;  If TinyEf is active in minibuffer prompt, turn ourself off.
 780           (pair-allow
 781            (if (and (boundp 'tief-mode)
 782                     (symbol-value 'tief-mode))
 783                nil
 784              (if (fboundp tinypair-:all-pairing-disabled-function)
 785                  (funcall tinypair-:all-pairing-disabled-function)
 786                t)))
 787           (pair         nil)            ;pair control
 788           (status       1)           ;see user configuration CHAR-FUNC
 789           direction                     ;character looking at cmd
 790           ch-func                       ;character function
 791           ch-beg
 792           ch-end
 793           syntax-now
 794           ch-now)
 795     (tinypair-debug fid
 796                     'ARG                arg
 797                     'CHAR               (char-to-string ch)
 798                     ch
 799                     'POINT              (point)
 800                     'PAIR-ALLOW-FLAG    pair-allow
 801                     'MODE               major-mode
 802                     'ELT                elt)
 803     (cond
 804      ((null pair-allow)
 805       (turn-off-tinypair-mode)
 806       ;; This isn't exactly right, e.g. in some modes the "'" or any pairing
 807       ;; character is not a self-insert-command, but a keymap prefix.
 808       ;; We run `self-insert-command' only if buffer is NOT read-only.
 809       (unless buffer-read-only
 810         (self-insert-command nbr)))
 811      ((null elt)                        ;Not defined for pairing
 812       (self-insert-command nbr))
 813      (t
 814       ;; ... ... ... ... ... ... ... ... ... ... ... ... .. do pairing . .
 815       (setq ch-beg  (tinypair-elt-beg elt))
 816       (setq ch-end  (tinypair-elt-end elt))
 817       (setq ch-func (tinypair-elt-func elt))
 818       (setq syntax-now (char-syntax (setq ch-now (following-char))))
 819       (tinypair-debug fid 'POINT (point) ch-func)
 820       (if (fboundp ch-func)
 821           (setq status (funcall ch-func ch-beg ch-end)))
 822       (tinypair-debug fid
 823                       "CH-NOW"      (char-to-string ch-now)
 824                       'POINT        (point)
 825                       "CH-END"      (char-to-string ch-end)
 826                       "STAT"        status
 827                       "CH-FUNC"     ch-func
 828                       "SYNTAX-NOW"  (char-to-string syntax-now))
 829       (cond
 830        ((integerp status)
 831         (setq direction
 832               (cond
 833                ((integerp arg)
 834                 (if (> arg -1) nil 'back))
 835                (t                       ;C-u forward
 836                 nil)))
 837         ;; No-ops. XEmacs byte compiler silencers
 838         (unless direction
 839           (setq direction nil))
 840         (unless fid
 841           (setq fid nil))
 842         (tinypair-debug  fid "direction" (or direction 'forward)
 843                          "WORD-PAIR" word-pair)
 844         (cond
 845          ;; ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
 846          ((char= ch-now ch-end)         ;already pair visible
 847           (tinypair-debug  fid "now = End"))
 848          ;; ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
 849          ((char= syntax-now ?\ )        ;whitespace at point
 850           (setq pair t)                 ;ok, do pairing
 851           (tinypair-debug  fid "Whitespace 1 1 t"))
 852          (word-pair
 853           ;; ... ... ... ... ... ... ... ... ... ... ... ... ...  words  ..
 854           ;; the default case
 855           ;;  handle smart pairing.
 856           (setq pair 'word))
 857          (t
 858           (tinypair-debug  fid "default word")
 859           (setq arg 1 pair t)))         ;main COND
 860         ;; ... ... ... ... ... ... ... ... ... ... ...  insert chars ? ...
 861         (tinypair-debug  fid "Doing... ARG; PAIR-flag" arg pair )
 862         (cond
 863          ((eq pair 'word)
 864           (tinypair-word-pair arg ch-beg ch-end))
 865          (pair
 866           (tinypair-word-pair nil ch-beg ch-end))
 867          (t
 868           (insert (ti::string-repeat nbr ch-beg)))))
 869        ;; ... ... ... ... ... ... ... ... ... ... ... ... other status ..
 870        ((eq nil status)
 871         (insert ch-beg))
 872        ((eq t status)
 873         (insert ch-beg ch-end)
 874         (backward-char 1))
 875        ((symbolp status)
 876         nil))))))
 877
 878 ;;}}}
 879
 880 (add-hook 'tinypair-:mode-define-keys-hook 'tinypair-mode-define-keys)
 881
 882 (ti::add-hooks '(minibuffer-setup-hook
 883                  dired-mode-hook
 884                  cvs-mode-hook
 885                  gnus-summary-mode-hook
 886                  gnus-group-mode-hook
 887                  rmail-mode-hook
 888                  rmail-summary-mode-hook
 889                  vm-mode-hook
 890                  vm-summary-mode-hook)
 891                'turn-off-tinypair-mode)
 892
 893 (if tinypair-mode
 894     (turn-on-tinypair-mode))
 895
 896 (provide   'tinypair)
 897 (run-hooks 'tinypair-:load-hook)
 898
 899 ;;; tinypair.el ends here