emacs_el/tiny-tools/tiny/tinymy.el

   1 ;;; tinymy.el --- Collection of simple solutions.
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C)    1995-2007 Jari Aalto
   8 ;; Keywords:        tools
   9 ;; Author:          Jari Aalto
  10 ;; Maintainer:      Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tinymy-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 ;;; Install:
  38
  39 ;; ....................................................... &t-install ...
  40 ;; Put this file on your Emacs-Lisp load path, add following into your
  41 ;; ~/.emacs startup file.
  42 ;;
  43 ;;      (require 'tinymy)
  44 ;;      (tinymy-compile-run-command-advice)  ;; Activate smart M-x compile
  45 ;;
  46 ;; If you get key binding conflict when you load this package, either
  47 ;; relocate keys, modify `tinymy-:define-key-table' or use forced bindings
  48 ;; by adding this statement prior `require' command.
  49 ;;
  50 ;;      (setq tinymy-:define-key-force t)
  51 ;;
  52 ;; AUTOLOAD SETUP INSTRUCTIONS
  53 ;;
  54 ;; This package can't be autoloaded easily, because it installs timers
  55 ;; and many global bindings. One possible way to autoload this package is
  56 ;; to rely on the fact that you will most likely use function to match
  57 ;; parens: like "(this)". The autoload below is quite tricky, see if
  58 ;; you can learn from it. What if effective does, is a) put temporary
  59 ;; function under key "%", when you press it b) function gets called
  60 ;; and tinymy.el is loaded c) it wipes itself away and assigns
  61 ;; function `tinymy-vi-type-paren-match' to the "%" key.
  62 ;;
  63 ;;   global-set-key "%"
  64 ;;               (ti::definteractive
  65 ;;                 (let ((function (lookup-key global-map "%")))
  66 ;;                   (global-unset-key "%") ;; tinymy.el doesn't complain
  67 ;;                   (require 'tinymy)
  68 ;;                   ;;  Now run whatever user had there.
  69 ;;                   (if function
  70 ;;                       (funcall function)
  71 ;;                     (self-insert-command 1))
  72 ;;                   ;;  Second time, direc calls here
  73 ;;                   (global-set-key
  74 ;;                    "%"
  75 ;;                    'tinymy-vi-type-paren-match))))
  76 ;;
  77 ;; There are some scripts included in this module and you can unpack them
  78 ;; with following commands. You need `pgp' and `tar' executable in path for
  79 ;; this to work. The extra scripts are for compile command C-z c c,
  80 ;; but you don't need them necessarily.
  81 ;;
  82 ;;      M-x load-library RET tinymy RET
  83 ;;
  84 ;; Modify the following variable and put your own installation there if the
  85 ;; default setting is interfering your setup. Please remember to look the
  86 ;; _source_ code of `tinymy-define-keys' which is run when package loads.
  87 ;; Function overrides some default Emacs key bindings.
  88 ;;
  89 ;;      tinymy-:define-key-table
  90 ;;
  91 ;;      ;;  Redefine hook so that it doesn't
  92 ;;      ;;  override Emacs keys.  Define them somewhere else.
  93 ;;
  94 ;;      (add-hook 'tinymy-:load-hook 'tinymy-install)
  95 ;;      (add-hook 'tinymy-:load-hook 'tinymy-alias)
  96 ;;
  97 ;;   If you have any questions, use 'submit' function. In case of error
  98 ;;   or misbehavior, turn on the debug too and send the debug result and
  99 ;;   describe what you did and where went wrong.
 100 ;;
 101 ;;      M-x tinymy-debug-toggle
 102 ;;      M-x tinymy-submit-bug-report
 103
 104 ;;}}}
 105 ;;{{{ Documentation
 106
 107 ;; ..................................................... &t-commentary ...
 108 ;;; Commentary:
 109
 110 ;;  Preface, Nov 1995
 111 ;;
 112 ;;      Emacs startup files started to look quite interesting:
 113 ;;
 114 ;;          emacs-rc-tips     emacrs-rc-el      emacrs-rc-el
 115 ;;          emacs-rc-18       emacs-rc-19       emacs-rc-abb   emacs-rc-compile
 116 ;;          emacs-rc-debug    emacs-rc-default  emacs-rc-font  emacs-rc-ding
 117 ;;          emacs-rc-font.b   emacs-rc-gnus     emacs-rc-hooks
 118 ;;          emacs-rc-init     emacs-rc-init2    emacs-rc-mail
 119 ;;          emacs-rc-o        emacs-rc-o-19     emacs-rc-out
 120 ;;          emacs-rc-path     emacs-rc-pc       emacs-rc-prog  emacs-rc-set
 121 ;;          emacs-rc-test     emacs-rc-time     emacs-rc-tips  emacs-rc-vc
 122 ;;          emacs-rc-w3       emacs-rc-x-menu   emacs-rc-xe
 123 ;;          emacs-rc-dired
 124 ;;          ..
 125 ;;
 126 ;;      Private functions seemed to grow all the time, most of which were
 127 ;;      turned into packages, but sometimes it was just function or two
 128 ;;      that made a life with Emacs easier.  What you see here is a
 129 ;;      selection of so called general *my* functions. The term *my* does
 130 ;;      not refer to *mine*, but has a background in function
 131 ;;      naming. Remember? All user functions are recommended to be named
 132 ;;      so, that the first word is `my-', like `my-FUNC-NAME-HERE'
 133 ;;
 134 ;;  Overview of features
 135 ;;
 136 ;;      Timer processes
 137 ;;
 138 ;;      o   RMAIL/other buffers saved in regular intervals.
 139 ;;      o   Revert buffer in background and ask confirmation, if file
 140 ;;          has changed on disk. By <duthen@cegelec-red.fr>
 141 ;;          (Jacques Prestataire) This feature is automatically disabled
 142 ;;          if autorevert.el is present and running.
 143 ;;      o   Mail lock watchdog. If you have this lock in your file system,
 144 ;;          you cannot receive mail.
 145 ;;
 146 ;;      Buffer
 147 ;;
 148 ;;      o   Cursor changes shape according to `overwrite-mode'
 149 ;;      o   Rename any buffer with one key `C-z' `n' to be able to launch
 150 ;;          e.g. new *shell* or *mail* buffer.
 151 ;;      o   Scroll command goes to window end/beginning and does not scroll
 152 ;;          immediately. See variable `tinymy-:scroll-mode' for more.
 153 ;;      o   Trim trailing whites paces from the buffer when file
 154 ;;          is saved. This featue is automatically disabled if
 155 ;;          whitespace.el is noticed.
 156 ;;      o   Gzip or unzip current file buffer.
 157 ;;      o   Add up numbers in rectangle area
 158 ;;
 159 ;;      Compile
 160 ;;
 161 ;;      o   Guess compile command by looking at the buffer content
 162 ;;          Configure variable `tinymy-:compile-table' and
 163 ;;          `tinymy-:compile-command-c-code'. The compile command you
 164 ;;          chose is buffer local and lasts until you change it.
 165 ;;          This is different than hitting M-x compile, because compile
 166 ;;          Does not "remember" each buffer's correct compile command.
 167 ;;
 168 ;;      Files
 169 ;;
 170 ;;      o   Toggle write/read-only file permissions on disk with
 171 ;;          C-x q or `M-x' `tinymy-buffer-file-chmod'
 172 ;;      o   If file saved had #!, it is automatically made chmod u+x.
 173 ;;          This feature is not installed if function
 174 ;;          `executable-make-buffer-file-executable-if-script-p'
 175 ;;          is noticed.
 176 ;;
 177 ;;      Gnus, mail
 178 ;;
 179 ;;      o   Save lisp package in buffer like *mail* to file: find
 180 ;;          package regions.
 181 ;;      o   Copy current buffer's contents to new mail buffer and
 182 ;;          set subject line. You can send diff buffers and file buffers
 183 ;;          conveniently this way: `C-z' `m' (Zend buffer as Mail)
 184 ;;
 185 ;;      Keys
 186 ;;
 187 ;;      o   Jump to matching paren "{([". _Bound_ to key "%".
 188 ;;      o   Better word movement: LikeThisInC++Mode.
 189 ;;          Moving forward/backward always keeps cursor at the
 190 ;;          beginning of word. See also `c-forward-into-nomenclature'
 191 ;;          _Bound_ to keys `C-left', `C-right' in X and `Esc-b', `Esc-f'
 192 ;;          in non-windowed Emacs.
 193 ;;      o   PgUp and PgDown behave differently; they jump to
 194 ;;          window's beg/end first and only next key hit scrolls.
 195 ;;          _Bound_ to keys `prior' and `next'. Check if your keyboard
 196 ;;          produces another pgUp and PgDown events.
 197 ;;
 198 ;;      Line formatting
 199 ;;
 200 ;;      o   Fix all backslash(\) lines in current paragraph to the
 201 ;;          same column as the starting line. Very useful in makefile mode,
 202 ;;          shell mode or when writing C/C++ macros. It even inserts missing
 203 ;;          backslashes.
 204 ;;
 205 ;;      Mouse
 206 ;;
 207 ;;      o   Point window and it gets cursor focus: The frame is
 208 ;;          raised and window selected. No need to click window any more.
 209 ;;      o   Show File information in echo-area: Point mouse near
 210 ;;          the end of window and Displayed info contains
 211 ;;          BUFFER MODES SIZE PATH. You do not consume your mode line
 212 ;;          or frame title any more for buffer specific information.
 213 ;;          Example output:
 214 ;;
 215 ;;              TinyMy: -rw-r--r-- 108k /users/jaalto/elisp/tinymy.el
 216 ;;
 217 ;;      Shell
 218 ;;
 219 ;;      o   Easy shar/tar/UU commands. configure variables
 220 ;;          `tinymy-:shar-command' and `tinymy-:tar-command'
 221 ;;
 222 ;;      vc
 223 ;;
 224 ;;      o   Key C-x C-q now won't call vc blindly. To prevent mistakes,
 225 ;;          a confirmation will be asked. You can also just toggle the
 226 ;;          buffer's read-only flag, without engaging vc.
 227 ;;
 228 ;;      Window
 229 ;;
 230 ;;      o   Flip the order of two windows
 231 ;;
 232 ;;  Minor modes in this package
 233 ;;
 234 ;;     Sort minor mode
 235 ;;
 236 ;;      If you have data in columns, use `C-cmS' or `M-x' `tinymy-sort-mode'
 237 ;;      to toggle sort mode on and off. With it you can sort columns 1-9
 238 ;;      easily. Mode line indicator is "S"
 239 ;;
 240 ;;  Features immediately activated when package loads
 241 ;;
 242 ;;          Configure variable `tinymy-:save-buffer-modes' and
 243 ;;          `tinymy-:save-buffer-regexp'
 244 ;;      o   You mailbox lock is kept on eye on, if the lock remains,
 245 ;;          you won't be able to receive mail. (safety measure).
 246 ;;      o   If you use procmail you want to configure
 247 ;;          `tinymy-:mail-check-inbox-file-permissions'
 248 ;;          otherwise, your mailbox's mode permissions are kept eye on:
 249 ;;          "Permission error: -rw-------" warning will be show if the
 250 ;;          mailbox doesn't have right modes.
 251 ;;      o   Automatic window selection when you point it with mouse cursor.
 252 ;;          See `tinymy-:install-select-window-auto'.
 253 ;;      o   When buffer that has `#!' to indicate shell
 254 ;;          script, is save, the +x flag is set on for the file.
 255 ;;
 256 ;;  What commands are defined when you load this file?
 257 ;;
 258 ;;      It's better to look at the code of this file, than to explain all the
 259 ;;      key definitions here, because I may not remember update this
 260 ;;      text section every time I add new interactive commands to the file.
 261 ;;
 262 ;;      All the new interactive commands can be found from these two
 263 ;;      functions:
 264 ;;
 265 ;;          tinymy-define-keys
 266 ;;          tinymy-mail-common-keys
 267 ;;
 268 ;;      See their description, or alternatively hit
 269 ;;
 270 ;;          C-h m                                ;; to view all bindings
 271 ;;          M-x delete-non-matching-lines tinymy ;; show bound keys
 272 ;;
 273 ;;  Key bindings
 274 ;;
 275 ;;      When you load this package, you can also install global
 276 ;;      key-bindings that if you set the load hook:
 277 ;;
 278 ;;          (add-hook 'tinymy-:load-hook 'tinymy-install)
 279 ;;          (add-hook 'tinymy-:load-hook 'tinymy-define-keys)
 280 ;;          (add-hook 'tinymy-:load-hook 'tinymy-define-key-extra)
 281 ;;          (add-hook 'tinymy-:load-hook 'tinymy-alias)
 282 ;;
 283 ;;      If you want to use your own bindings, use it like this:
 284 ;;
 285 ;;          (add-hook 'tinymy-:load-hook 'tinymy-install
 286 ;;          (add-hook 'tinymy-:load-hook 'tinymy-alias)
 287 ;;          (add-hook 'tinymy-:load-hook 'my-tinymy-keys)
 288 ;;
 289 ;;          (defun my-tinymy-keys ()
 290 ;;            <define my own global key mappings>)
 291 ;;
 292 ;;      There is table of global bindings which you can modify if the
 293 ;;      bindings clash: the auto install will warn you about this
 294 ;;      automatically and your own bindings are not replaced by default.
 295 ;;      See variable: `tinymy-:define-key-table'
 296
 297 ;;}}}
 298
 299 ;;; Change Log:
 300
 301 ;;; Code:
 302
 303 ;;{{{ setup: require
 304
 305 ;;; ......................................................... &require ...
 306
 307 (require 'tinylibm)
 308
 309 (eval-and-compile
 310   (defvar track-mouse)                  ;ByteComp silencer for XEmacs
 311   (ti::package-package-require-timer)
 312   (autoload 'compile-internal               "compile")
 313   (autoload 'operate-on-rectangle           "rect")
 314   (defvar gnus-article-buffer)
 315   (defvar gnus-original-article-buffer)
 316   (defvar gnus-summary-buffer))
 317
 318 (eval-when-compile
 319   (ti::package-use-dynamic-compilation)
 320   (require 'advice))
 321
 322 (ti::package-defgroup-tiny TinyMy tinymy-: tools
 323   "Collection of small so called 'my' utility functions.
 324 The full feature list is in the source code documentation, read it well.")
 325
 326 ;;}}}
 327 ;;{{{ setup: variables
 328
 329 ;;; .......................................................... &v-bind ...
 330 ;;; Change this table if you have conflicting bindings.
 331 ;;;
 332
 333 (defcustom tinymy-:define-key-force nil
 334   "*If non-nil; assign keys without any check."
 335   :type 'boolean
 336   :group 'TinyMy)
 337
 338 (defcustom tinymy-:define-key-table
 339   '(
 340     ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. C-x . .
 341     ;;  The 'rectangle' map. This sould be free
 342
 343     ("\C-xrA"   . tinymy-add-rectangle)
 344
 345     ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. C-c . .
 346     ;; minor modes in 'm' map
 347
 348     ("\C-cmS"   . tinymy-sort-mode)
 349
 350     ;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. C-z . .
 351     ;; Pick "c" for all (c)ompile commads, now define additional
 352     ;; "c" for this particular command
 353
 354     ("\C-zcc"   . tinymy-compile-run-command)
 355
 356     ("\C-zm"    . tinymy-mail-buffer)
 357     ("\C-zS"    . ti::buffer-surround-with-char)
 358
 359     ;;  Oher miscellaneout to "x" extra map
 360
 361     ("\C-zxc"   . tinymy-copy-file) ;; Make backup (RCS version included)
 362
 363     ("\C-zxf"   . tinymy-package-save-to-file)
 364     ("\C-zxt"   . tinymy-trim-blanks)
 365
 366     ("\C-zxw"   . tinymy-flip-windows)
 367     ("\C-zxz"   . tinymy-buffer-file-gzip)
 368
 369     ;;  's' for shell commands
 370
 371     ("\C-zxss"  . tinymy-shar)
 372     ("\C-zxst"  . tinymy-tar))
 373   "*Define command to `global-map' keys.
 374 See also source code for `tinymy-define-keys' which will overwrite
 375 default Emacs keybindings if installed in `tinymy-:load-hook'.
 376
 377 Format:
 378
 379    '((KEY . FUNCTION)
 380       ...)"
 381
 382   :type '(repeat
 383           (cons
 384            (string :tag "Key Bind sequence")
 385            function))
 386   :group 'TinyMy)
 387
 388 ;;; ......................................................... &v-hooks ...
 389
 390 (defcustom tinymy-:load-hook '(tinymy-install)
 391   "*Hook that is run when package is loaded.
 392 The default value is '(tinymy-install)"
 393   :type  'hook
 394   :group 'TinyMy)
 395
 396 (defcustom tinymy-:mail-buffer-hook nil
 397   "*This hook run last in `tinymy-mail-buffer' function."
 398   :type  'hook
 399   :group 'TinyMy)
 400
 401 ;;; ....................................................... &vu-config ...
 402 ;;; all "vu" -- "variable user" sections are meant for user configurable
 403
 404 (defcustom tinymy-:install-select-window-auto 'no
 405   "*Variable is used only in window system.
 406 The automatic window selection function selects window by pointing
 407 at it with mouse . No clicking is needed. However if you use menu bar, it is
 408 a bit difficult to use this automatic selection feature, because the
 409 menu bar reflects the current window: When you are at lower window and reach
 410 for the menu bar, the upper window gets selected and the menu bar reflects
 411 that window. You never get menu bar for the other windows but for the
 412 topmost one. (Well, you can go round of Emacs, and then reach for
 413 menu-bar, but that's a bit awkward)
 414
 415 Values in this variable:
 416
 417   'yes
 418   'no
 419   'ask"
 420   :type '(choice
 421           (const yes)
 422           (const no)
 423           (const ask))
 424   :group 'TinyMy)
 425
 426 (defcustom tinymy-:register ?r
 427   "*An Emacs register where to put results of commands.
 428 User can then afterwards yank the result into desired buffer."
 429   :type  'character
 430   :group 'TinyMy)
 431
 432 (defcustom tinymy-:scroll-mode 'window
 433   "*If non-nil, then `tinymy-scroll-down' does not immediately scroll.
 434 The following happen if variable is non-nil.
 435 o  up: if the cursor is not at the window's start line, go there
 436 o  up: if cursor is at window's top, line, now scroll
 437 o  down: --''-- behaves same as up"
 438   :type  'boolean
 439   :group 'TinyMy)
 440
 441 (defcustom tinymy-:copy-file-suffix ".original"
 442   "Suffix to add when making copy of file with `tinymy-copy-file'.
 443 This variable is only used in interactive call. Default extension
 444 is \".original\", same as used by Unix 'patch' program to save original
 445 working file.
 446
 447 If the version number can be found from file, that is suggested instead
 448 of this suffix."
 449   :type  'string
 450   :group 'TinyMy)
 451
 452 ;;; ...................................................... &v-matching ...
 453
 454 (defcustom tinymy-:vi-type-paren-match-special-list '( ?\" ?\' ?\$ )
 455   "*List of special character to matched in \\[tinymy-vi-type-paren-match].
 456 If the sentence delimited by these chars spread multiple lines,
 457 the missing part is searched backward.
 458
 459 If you call \\[tinymy-vi-type-paren-match] with optional arg, then
 460 the search is forced FORWARD."
 461   :type  '(repeat character)
 462   :group 'TinyMy)
 463
 464 ;;  This could have been (CH . CH) list but because XEmacs20
 465 ;;  has different character handling that Emacs; we prefer to check
 466 ;;  strings.
 467 ;;
 468 ;;  This is not configurable variable right now, because the match
 469 ;;  function uses hard coded regexps.
 470
 471 (defconst tinymy-:vi-type-paren-match-list
 472   '( ( "(" . ")" )
 473      ;; NOPE, DO NOT add these. It won't work - the reason is currently unknown.
 474      ;;
 475      ;;     ( "<" . ">" )
 476      ( "{" . "}" )
 477      ( "[" . "]" ))
 478   "List of character string pairs to match.
 479
 480 Format:
 481
 482   ((BEGIN-CHARACTER-PAIR-STR . END-CHARACTER-PAIR-STR)
 483    (B . E)
 484    ..)
 485
 486 Example:
 487
 488   '( ( \"(\" . \")\" )
 489      ( \"{\" . \"}\" )
 490      ( \"[\" . \"]\" )))")
 491
 492 ;;; ......................................................... &vu-word ...
 493
 494 (defcustom tinymy-:move-word-set "-[]_$%@#&*\":;,.{}()<>/\\ \t\n"
 495   "*How to move forward/backward word. This is character set."
 496   :type  '(string :tag "Charset")
 497   :group 'TinyMy)
 498
 499 (defcustom tinymy-:move-word-case-set "-[]_$%@#&*\":{}()<>/\\ \t\na-z"
 500   "*How to move forward/backward word. This is character set.
 501 used only over mixed case words."
 502   :type  '(string :tag "Charset")
 503   :group 'TinyMy)
 504
 505 (defcustom tinymy-:move-word-case-modes
 506   '(c-mode
 507     c++-mode
 508     cc-mode
 509     java-mode
 510     sh-mode
 511     bash-mode
 512     csh-mnode
 513     ksh-mode
 514     jde-mode
 515     jdee-mode
 516     perl-mode
 517     cperl-mode
 518     php-mode
 519     jsp-mode
 520     text-mode)
 521   "*Modes where `tinymy-:move-word-case-set' is used."
 522   :type '(repeat function)
 523   :group 'TinyMy)
 524
 525 ;;; ........................................................ &vu-shell ...
 526
 527 (defcustom tinymy-:tar-command "tar -cf"
 528   "*Tar create command, e.g. used in `tinymy-tar'."
 529   :type  '(string :tag "Shell command")
 530   :group 'TinyMy)
 531
 532 (defcustom tinymy-:shar-command "shar -a -c -C -e -t -u"
 533   "*Shar command used by `tinymy-shar'.
 534 In HP-UX:
 535
 536  -a       do not protect them specially (uu)
 537  -c       data-integrity check using wc
 538  -C       Insert a line of the form --- cut here ---
 539  -e       code that prevents shar .. overwrite existing files.
 540  -t       Write diagnostics to stdout
 541  -u       Assume that the remote site has uudecode"
 542   :type '(string :tag "Shell command")
 543   :group 'TinyMy)
 544
 545 ;;; ...................................................... &vu-compile ...
 546
 547 (defcustom tinymy-:compile-table
 548   (list
 549    '("perl"              . "perl -w %s")
 550    '("code-shell-sh"     . "sh -x %s")
 551    '("code-shell-bash"   . "bash -x %s")
 552    '("code-shell-t?csh-" . "csh -x %s")
 553    '("code-shell-ksh"    . "ksh -x %s")
 554    '("awk"               . "awk -f %s")
 555    '("xml"               . tinymy-compile-xml-command)
 556    '("c[+]+\\|^cc?-\\|code-c"  . tinymy-compile-cc-command)
 557    '("bat"    . "%s")
 558    '("text-white-paper"  . tinymy-compile-tinytf-command)
 559    (cons "lisp"
 560          (concat
 561           (if (ti::emacs-p)
 562               "emacs"
 563             "xemacs")
 564           " -batch -f batch-byte-compile %s"))
 565    '("java" . "javac %s")
 566    (cons "php"
 567          (let ((php  (executable-find "php"))
 568                (php4  (executable-find "php4")))
 569            (if (or php php4)
 570                (concat (or php php4) " %s"))))
 571
 572    '("sql" . tinymy-compile-sql))
 573   "*Compilation table, how to run the code through interpreters.
 574 The command is put into %s in the COMPILE-COMMAND part.
 575
 576 format:
 577
 578   '((REGEXP-for-buffer-type  . COMPILE-COMMAND)
 579     (REGEXP-for-buffer-type  . COMPILE-COMMAND)
 580     ..)
 581
 582 REGEXP
 583
 584   The regexp is like 'code-c' 'code-pascal' or alternatively a
 585   `mode-name' if buffer content can't be identified. See
 586   tinylibid.el and function `ti::id-info' for more.
 587
 588 COMPILE-COMMAND
 589
 590   STRING with %s where `buffer-file-name' is inserted.
 591
 592   -- If string, then this command is suggested for file.
 593   -- if something else, the content is evaled and it should return
 594      compile command STRING with %s for file name.
 595   -- If function, function must return complete compile command,
 596      with _no_ %s.
 597
 598 Example:
 599
 600   Suppose you have several perl interpreters and you want to use the
 601   shebang interpreter (first line in the script) for your project's perl
 602   scripts. The following code:
 603
 604   -- Looks up the existing perl compile command and stores it to ELT
 605   -- Changes the right hand COMPILE-COMMAND to Lisp form that
 606      determines the perl command according to file name. Function
 607      `ti::buffer-shebang' reads the command interpreter from the first line.
 608
 609     (add-hook 'tinymy-load-hook 'my-tinymy-compile-customisations)
 610     (autoload 'aput \"assoc\")
 611
 612     (defun my-tinymy-compile-customisations ()
 613       (aput 'tinymy-:compile-table
 614             \"perl\"
 615             '(if (string-match \"project\" buffer-file-name)
 616                (concat (or (ti::buffer-shebang) \"perl\") \" -w  %s\")
 617              \"perl -w %s\")))
 618
 619   If you always want to use the shebang command interpreter, then you
 620   would simply write
 621
 622    (add-hook 'tinymy-load-hook 'my-tinymy-compile-customisations)
 623    (autoload 'aput \"assoc\")
 624
 625     (defun my-tinymy-compile-customisations ()
 626       (aput 'tinymy-:compile-table
 627             \"perl\"
 628             '(concat (or (ti::buffer-shebang) \"perl\") \" -w %s\")))
 629
 630   After this package has been loaded. (Place customizations like this
 631   to `tinymy-:load-hook'."
 632   :type '(retpeat
 633           (string :tag "Regexp")
 634           (string :tag "Shell command"))
 635   :group 'TinyMy)
 636
 637 ;;}}}
 638 ;;{{{ setup: other, version
 639
 640 (defvar tinymy-:buffer-info-cache nil
 641   "Cached buffer data values in function `tinymy-buffer-info'.
 642 Format:
 643   '((buffer-pointer size message-string)
 644     ...)")
 645
 646 ;;;###autoload (autoload 'tinymy-version "tinymy" "Display commentary." t)
 647
 648 (eval-and-compile
 649   (ti::macrof-version-bug-report
 650    "tinymy.el"
 651    "tinymy"
 652    tinymy-:version-id
 653    "$Id: tinymy.el,v 2.86 2007/05/07 10:50:08 jaalto Exp $"
 654    '(tinymy-:version-id
 655      tinymy-:debug
 656      tinymy-:vi-type-paren-match-list
 657      tinymy-:define-key-force
 658      tinymy-:define-key-table
 659      tinymy-:load-hook
 660      tinymy-:mail-buffer-hook
 661      tinymy-:install-select-window-auto
 662      tinymy-:register
 663      tinymy-:scroll-mode
 664      tinymy-:copy-file-suffix
 665      tinymy-:vi-type-paren-match-special-list
 666      tinymy-:move-word-set
 667      tinymy-:move-word-case-set
 668      tinymy-:move-word-case-modes
 669      tinymy-:tar-command
 670      tinymy-:shar-command
 671      tinymy-:compile-table
 672      tinymy-:save-buffer-modes
 673      tinymy-:save-buffer-regexp
 674      tinymy-:force-revert
 675      tinymy-:revert-in-progress
 676      tinymy-:revert-buffer-info-list
 677      tinymy-:window-previous)
 678    '(tinymy-:debug-buffer)))
 679
 680 ;;;### (autoload 'tinymy-debug-toggle "tinymy" t t)
 681
 682 (eval-and-compile (ti::macrof-debug-standard "tinymy" "-:"))
 683
 684 ;;}}}
 685 ;;{{{ install: main
 686
 687 ;;; ----------------------------------------------------------------------
 688 ;;;
 689 ;;;###autoload
 690 (defun tinymy-define-keys ()
 691   "Install keys."
 692   (interactive)
 693
 694   (when (boundp 'shared-lisp-mode-map)
 695     (defvar shared-lisp-mode-map nil) ;; Byte compiler silencer
 696     (define-key shared-lisp-mode-map    "%" 'tinymy-vi-type-paren-match))
 697
 698   (define-key emacs-lisp-mode-map       "%" 'tinymy-vi-type-paren-match)
 699   (define-key lisp-mode-map             "%" 'tinymy-vi-type-paren-match)
 700
 701   ;;  was C-xq was kbd-macro-query
 702
 703   (global-set-key "\C-xq"    'tinymy-buffer-file-chmod)
 704
 705   ;;  Redefine scroll keys, we don't confirm these...
 706
 707   (global-set-key [(prior)]             'tinymy-scroll-up)
 708   (global-set-key [(next)]              'tinymy-scroll-down)
 709
 710   ;;  In XEmacs these already have default bindings, but we override them.
 711
 712   (global-set-key [(control right)]     'tinymy-word-forward)
 713   (global-set-key [(control left)]      'tinymy-word-backward)
 714   (global-set-key [(control up)]        'tinymy-beginning-of-defun)
 715   (global-set-key [(control down)]      'tinymy-end-of-defun)
 716
 717   (unless (ti::compat-window-system)
 718     (global-set-key [(meta f)] 'tinymy-word-forward)
 719     (global-set-key [(meta b)] 'tinymy-word-backward))
 720
 721   ;; Use C-z prefix because it is most user friendly to pinky
 722   ;; Pretty useless in X-windowed Emacs, and in windowed
 723   ;; Emacs you seldom use suspend-emacs because emacs has M-x shell
 724
 725   (ti::use-prefix-key global-map "\C-z")
 726
 727   ;;  Set global keys, confirm these
 728
 729   (mapcar
 730    (function
 731     (lambda (x)
 732       (if tinymy-:define-key-force
 733           (define-key global-map (car x) (cdr x))
 734         (ti::define-key-if-free global-map
 735                                 (car x)
 736                                 (cdr x)
 737                                 'tinymy-define-key-error))))
 738    tinymy-:define-key-table)
 739
 740   ;; .................................................... &emacs-modes ...
 741
 742   (add-hook 'makefile-mode-hook 'tinymy-makefile-mode-hook)
 743
 744   (defun tinymy-makefile-mode-hook ()
 745     "Define key C-c/ to adjust \\ continuing lines."
 746     (define-key
 747       (symbol-value 'makefile-mode-map) "\C-c\\"
 748       'ti::buffer-backslash-fix-paragraph)))
 749
 750 ;;; ----------------------------------------------------------------------
 751 ;;;
 752 ;;;###autoload
 753 (defun tinymy-define-keys-extra ()
 754   "Define extra global keys."
 755   (interactive)
 756   (global-set-key "%"         'tinymy-vi-type-paren-match)
 757   (global-set-key "\C-x\C-q"  'tinymy-buffer-read-only))
 758
 759 ;;; ----------------------------------------------------------------------
 760 ;;;
 761 (defun tinymy-install-mouse-movement-handler (&optional uninstall)
 762   "Install or UNINSTALL `tinymy-mouse-movement-handler'
 763 References:
 764   `tinymy-:install-select-window-auto'."
 765
 766   (when (and (not uninstall)
 767              (ti::compat-window-system))
 768     (let ((ok
 769            (or (eq tinymy-:install-select-window-auto 'yes)
 770                (and
 771                 (eq tinymy-:install-select-window-auto 'ask)
 772                 (null
 773                  (y-or-n-p
 774                   (concat
 775                    "TinyMy: Are you sure? "
 776                    "This feature conflicts with menubar usage")))))))
 777       (cond
 778        ((and ok
 779              (ti::emacs-p)
 780              (ti::win32-p) ;; Bug in Win32; works in Unix Emacs
 781              (ti::emacs-type-win32-p) ;; Cygwin Emacs is ok
 782              (string-match "^21" emacs-version))
 783         ;;  Bug in Win32 21.[123] makes Emacs to behave starangely
 784         ;;  when mouse-movement tracking is enabled.
 785         ;;
 786         ;;  Use this code to check your Emacs: Start fresh emacs, and run it.
 787         ;;  If the Frame's menu-bar
 788         ;;  line constantly flickers, then Emacs is broken. This code
 789         ;;  does not work in XEmacs (there is no track-mouse)
 790         ;;
 791         ;;  (progn
 792         ;;    (defun test (event)
 793         ;;      (interactive "e")
 794         ;;      (message "mouse movement ok")
 795         ;;      (discard-input))
 796         ;;    (setq track-mouse t)
 797         ;;    (global-set-key [(mouse-movement)] 'test))
 798         ;;
 799         (message "Tinymy: [NOTICE] `mouse-movement' \
 800 has changed in Emacs 21.x. Unable to install handler."))
 801        ((and ok
 802              (ti::emacs-p))
 803         (setq track-mouse t)            ;This is essential
 804         ;;  Make sure that this handler is not occupied yet
 805         (if (memq (lookup-key global-map [(mouse-movement)])
 806                   '(tinymy-mouse-movement-handler
 807                     tooltip-mouse-motion
 808                     ignore
 809                     nil))
 810             (global-set-key [(mouse-movement)]
 811                             'tinymy-mouse-movement-handler)
 812           (message "\
 813 ** tinymy.el: can't install mouse-movement handler, already occupied.")))
 814        ((and ok
 815              (ti::xemacs-p))
 816         ;;   See also package mode-motion+.el
 817         ;;
 818         ;;   `mode-motion-hook' is buffer local. Hm. And it is called from
 819         ;;   `default-mouse-motion-handler' inside `save-window-excursion'.
 820         ;;   Not good. Window can't be changed form that hook, so we must
 821         ;;   replace function in `mouse-motion-handler'.
 822         ;;
 823         (defvar mouse-motion-handler nil) ;ByteComp silencer in Emacs
 824         (if  (eq (symbol-value 'mouse-motion-handler)
 825                  'default-mouse-motion-handler)
 826             (defconst mouse-motion-handler
 827               'tinymy-default-mouse-motion-handler-xemacs)
 828           (message "\
 829 ** tinymy.el: Can't install:  `mouse-motion-handler' is not default."))
 830         (defun tinymy-default-mouse-motion-handler-xemacs (event)
 831           "Call `default-mouse-motion-handler' and
 832 `tinymy-mouse-movement-handler'."
 833           (prog1 (ti::funcall 'default-mouse-motion-handler event)
 834             (tinymy-mouse-movement-handler event))))))))
 835
 836 ;;; ----------------------------------------------------------------------
 837 ;;;
 838 ;;;###autoload
 839 (defun tinymy-install-after-save-hook (&optional uninstall)
 840   "Intall or UNINSTALL functions to `after-save-hook'."
 841   (let ((func 'executable-make-buffer-file-executable-if-script-p))
 842     (when (and (fboundp func)
 843                (memq func after-save-hook))
 844       ;; #todo: Watch Emacs version when this is fixed.
 845       ;; Latest Emacs versons have this in executable.el
 846       ;; Un fortortunately Emacs 21.3 has bug for Ange-FTP remote
 847       ;; files, where this signals error, so don't use it.
 848       (message
 849        (concat
 850         "TinyMy: `%s' does not work for remote files. Removed from"
 851         " `after-save-hook'.")
 852        (symbol-name func)))
 853     (remove-hook 'after-save-hook func))
 854   (ti::add-hooks 'after-save-hook
 855                  'tinymy-maybe-make-file-executable
 856                  uninstall))
 857
 858 ;;; ----------------------------------------------------------------------
 859 ;;;
 860 ;;;###autoload
 861 (defun tinymy-install (&optional uninstall)
 862   "Intall or UNINSTALL package. Configure Emacs variables and bindings."
 863   (interactive)
 864   (when (ti::compat-window-system)
 865     (tinymy-install-mouse-movement-handler uninstall))
 866   (tinymy-install-after-save-hook uninstall))
 867
 868 ;;; ----------------------------------------------------------------------
 869 ;;;
 870 (defun tinymy-define-key-error (key def)
 871   "Call back function. Warn about conflicting key binding for KEY and DEF."
 872   (message "TinyMy: Cannot auto-install, key already occupied: %s %s"
 873            key def))
 874
 875 ;;}}}
 876 ;;{{{ buffer: chmod
 877
 878 ;;; ----------------------------------------------------------------------
 879 ;;;
 880 ;;;###autoload
 881 (defun tinymy-buffer-file-chmod (&optional verb)
 882   "Toggle current buffer's Read-Write permission permanently on disk. VERB.
 883 Does nothing if buffer is not visiting a file or file is not owned by us."
 884   (interactive)
 885   (let* ((file  (buffer-file-name))
 886          stat)
 887     (ti::verb)
 888     (when (and file (file-modes file))  ;File modes is nil in Ange-ftp
 889       (setq stat (ti::file-chmod-w-toggle file))
 890       (when verb
 891         (cond
 892          ((eq stat 'w+)
 893           (message "TinyMy: chmod w+")
 894           (setq buffer-read-only nil))
 895          ((eq stat 'w-)
 896           (message "TinyMy: chmod w-")
 897           (setq buffer-read-only t))
 898          (t
 899           (message "TinyMy: couldn't chmod")))
 900         (ti::compat-modeline-update)))))
 901
 902 ;;}}}
 903 ;;{{{ buffers: gzip
 904
 905 ;;; ----------------------------------------------------------------------
 906 ;;;
 907 (defun tinymy-buffer-file-gzip ()
 908   "Compress or uncompress current file buffer with gzip."
 909   (interactive)
 910   (save-buffer)
 911   (let* ((gzip "gzip"))
 912     (cond
 913      ((or (not (stringp buffer-file-name))
 914           (null (file-modes buffer-file-name))) ;Ange ftp
 915       (message "timy. Can't gzip this buffer."))
 916      ((or (ti::vc-rcs-file-exists-p buffer-file-name)
 917           (and (fboundp 'vc-registered)
 918                (ti::funcall 'vc-registered buffer-file-name)))
 919       (message "TinyMy: This file is VC controlled. No gzip allowed."))
 920      ((string-match "\\.gz$" buffer-file-name)
 921       (call-process gzip nil nil nil "-d" buffer-file-name)
 922       (setq buffer-file-name (replace-regexp-in-string
 923                               "\\.gz$" "" buffer-file-name))
 924       (rename-buffer (file-name-nondirectory buffer-file-name))
 925       (set-visited-file-modtime))
 926      (t
 927       (call-process gzip nil nil nil "-9" buffer-file-name)
 928       (unless (string-match "\\.gz$" buffer-file-name)
 929         (setq buffer-file-name (concat buffer-file-name ".gz")))
 930       (rename-buffer (file-name-nondirectory buffer-file-name))
 931       (set-visited-file-modtime)))))
 932
 933 ;;; ----------------------------------------------------------------------
 934 ;;;
 935 (defun tinymy-buffer-read-only ()
 936   "Put buffer in `view-mode' if read-only is turned on.
 937
 938 Important, If file is vc controlled:
 939
 940     This function is ment for changing the
 941     buffer characteristics without changing the version control state.
 942
 943     Normally \\[toggle-read-only] would do CheckOut if the file was
 944     read-only, but sometimes it is convenient to put buffer to read-only
 945     state to prevent changing anything in there for a while."
 946   (interactive)
 947   (let* ((fid      "tinymy-buffer-read-only")
 948          (key-func (if (or (featurep 'vc)
 949                            (featurep 'vc-hooks))
 950                        'vc-toggle-read-only
 951                      'toggle-read-only))
 952          state
 953          call
 954          turn-mode)
 955     (unless fid ;; No-op. XEmacs byte compiler silencer
 956       (setq fid nil))
 957     (tinymy-debug fid
 958                   "VC"        (featurep 'vc)
 959                   "mode"      major-mode
 960                   key-func
 961                   "FILE"      buffer-file-name)
 962     (ti::save-line-column-macro nil nil
 963       (cond
 964        ((memq major-mode '(dired-mode)) ;plain C-x C-q for these modes...
 965         (toggle-read-only))
 966        (t
 967         (cond
 968          ((and (eq key-func 'vc-toggle-read-only)
 969                buffer-file-name            ;maybe *temp* buffer ?
 970                (vc-name buffer-file-name)) ;is file registered ?
 971
 972           (if (y-or-n-p "Call vc? ")
 973               (call-interactively 'vc-toggle-read-only)
 974             (toggle-read-only)))
 975          (t
 976           (call-interactively key-func)))
 977         (tinymy-debug fid "STATE after" buffer-read-only)
 978         (setq state buffer-read-only)   ;what happened ?
 979         (setq turn-mode             ;can't use nil, because it toggles
 980               (if state 1 0))
 981         (view-mode turn-mode))))))
 982
 983 ;;}}}
 984 ;;{{{ buffers: other
 985
 986 ;;; ----------------------------------------------------------------------
 987 ;;;
 988 (defun tinymy-flip-windows ()
 989   "Switch window order. There must be only 2 windows."
 990   (interactive)
 991   (when (> (count-windows) 1)
 992     (let ((first-buffer (window-buffer (selected-window)))
 993           (second-buffer (window-buffer (next-window (selected-window)))))
 994       (set-window-buffer (selected-window) second-buffer)
 995       (set-window-buffer (next-window (selected-window)) first-buffer))))
 996
 997 ;;}}}
 998 ;;{{{ Mouse, cursors
 999
1000 ;;; ----------------------------------------------------------------------
1001 ;;;
1002 (defun tinymy-cursor-set-type (cursor &optional frame)
1003   "Set the CURSOR type for the named FRAME."
1004   (if (not frame)
1005       (setq frame (selected-frame)))
1006   ;; Do the modification.
1007   (modify-frame-parameters
1008    frame
1009    (list (cons 'cursor-type cursor))))
1010
1011 ;;; ----------------------------------------------------------------------
1012 ;;;
1013 (defun tinymy-cursor-overwrite-mode ()
1014   "Set the cursor-type according to the insertion mode"
1015   (cond
1016    (overwrite-mode
1017     (let ((cursor (or (frame-parameter (selected-frame) 'cursor-type)
1018                       'block)))
1019       (put 'tinymy-cursor-overwrite-mode 'saved-cursor-type cursor)
1020       ;;  The type is going to change to 'bar, but if user has it
1021       ;;  on by default, pick the opposite.
1022       (tinymy-cursor-set-type (if (equal cursor 'bar)
1023                                   'block
1024                                 'bar))))
1025    (t
1026     (tinymy-cursor-set-type
1027      (get 'tinymy-cursor-overwrite-mode 'saved-cursor-type)))))
1028
1029 ;;; ----------------------------------------------------------------------
1030 ;;;
1031 (if (fboundp 'overwrite-mode-hook)
1032     (add-hook 'overwrite-mode-hook 'tinymy-cursor-overwrite-mode-hook)
1033   (defadvice overwrite-mode (around tinymy act)
1034     "Change cursor to 'block or 'bar according to `overwrite-mode'."
1035     ad-do-it
1036     (tinymy-cursor-overwrite-mode)))
1037
1038 ;;; ----------------------------------------------------------------------
1039 ;;;
1040 (defsubst tinymy-buffer-info-cache-string (buffer)
1041   "If same size, return cached string from  `tinymy-:buffer-info-cache'."
1042   (when (and (setq buffer (assq buffer tinymy-:buffer-info-cache))
1043              (or (eq (nth 1 buffer) (buffer-size))
1044                  ;; It it's modified, it hasn't been written to disk yet,
1045                  (buffer-modified-p)))
1046     (nth 2 buffer)))
1047
1048 ;;; ----------------------------------------------------------------------
1049 ;;;
1050 (defun tinymy-buffer-info-1 ()
1051   "Display buffer information:
1052 If buffer is associated to file:  -rwx-rw-r-- 20k /absolute/path/file.txt
1053 If no file: SIZEk SIZE-IN-BYTES"
1054   (interactive)
1055   (let* ((file  buffer-file-name)
1056          (ssize (buffer-size))
1057          (size  (/ ssize 1000)) ;; well, it's 1024 to exact but this suffices
1058          (modes "")
1059          lines)
1060     ;;  E.g. Gnus defines `buffer-file-name' for Draft messages,
1061     ;;  but the file is not actually written, so we test for existense
1062     ;;  to prevent suprises from happening.
1063     (cond
1064      ((and (memq major-mode '(dired-mode vc-dired-mode))
1065            (boundp 'dired-directory))
1066       (setq lines (- (count-lines (point-min) (point-max)) 2))
1067       (format "Tinymy: count %d %s"
1068               lines
1069               (symbol-value 'dired-directory)))
1070      (file
1071       (or (string-match "@" file) ;; Ange-ftp file is ok.
1072           (and (file-exists-p file)
1073                (setq modes
1074                      (ti::file-access-mode-to-string (file-modes file)))))
1075       (format "%s %dk %s"  (or modes "") size file))
1076      (t
1077       (format "buffer size %dk (%d bytes)"  size ssize)))))
1078
1079 ;;; ----------------------------------------------------------------------
1080 ;;;
1081 (defun tinymy-buffer-info ()
1082   "Display buffer information."
1083   (let ((old-message (tinymy-buffer-info-cache-string (current-buffer))))
1084     (if old-message
1085         (message old-message)
1086       (setq old-message (tinymy-buffer-info-1))
1087       (setq tinymy-:buffer-info-cache
1088             (delq (current-buffer) tinymy-:buffer-info-cache))
1089       (push (list
1090              (current-buffer)
1091              (buffer-size)
1092              old-message)
1093             tinymy-:buffer-info-cache))))
1094
1095 ;;; ----------------------------------------------------------------------
1096 ;;; >How can I get the selected window to change as I move the mouse cursor
1097 ;;; >into that window?  In other words, I don't want to have to click the
1098 ;;; >mouse in the new window every time I move between windows (windows, not
1099 ;;; >frames, this is not a click-to-focus window manager question).
1100 ;;;
1101 ;;; This function was elp'ed to see how heavy it is for `mouse-handler'.
1102 ;;; In byte compiled format the results in HP 10.20/9000/715
1103 ;;;
1104 ;;; Function Name                Call Count  Elapsed Time  Average Time
1105 ;;; ===========================  ==========  ============  ============
1106 ;;; tinymy-mouse-movement-handler  29        0.0571780000  0.0019716551
1107
1108 (defvar tinymy-:window-previous nil
1109   "Used in `tinymy-mouse-movement-handler'.")
1110
1111 (defun tinymy-mouse-movement-handler (event)
1112   "Nice mouse movement EVENT handler.
1113
1114 Change window automatically:
1115
1116     If you point a nother window where cursor was, the new window is
1117     automatically made active.
1118
1119 Show information on echo-area:
1120
1121     If you point mouse near the end of botton line (right hand corner),
1122     a brief file information is shown in echo area. If window is bigger
1123     than the text that is at the beginning of it, pointing to the end
1124     of text is sufficient. Example output:
1125
1126     TinyMy: -rw-r--r-- 108k /users/jaalto/elisp/tinymy.el"
1127
1128   (interactive "e")
1129   (let* ((case-fold-search  t)
1130          frame
1131          win
1132          mini
1133          bottom
1134          point
1135          p)
1136     (cond
1137      ((and (fboundp 'event-window)
1138            (eventp  event))
1139       ;;  XEmacs calls us from motion hook
1140       ;;  #<motion-event 644, 221>
1141       (setq win (ti::funcall 'event-window event)))
1142      ((and (fboundp 'posn-window)
1143            (fboundp 'event-start)
1144            (eventp  event))
1145       (setq win (posn-window (event-start event))))
1146      (t
1147       ;;  Unknown Emacs or interface changed radically
1148       (message "Tinymy: tinymy-mouse-movement-handler error.\
1149 Contact maintaner with M-x tinymy-submit-bug-report.")))
1150
1151     (setq bottom    (and win (window-end))
1152           point     (posn-point
1153                      (if (ti::emacs-p)
1154                          (event-start event)
1155                        event)))
1156     ;; ............................................ auto window select ...
1157     ;;  The WIN could be frame pointer too, that's why we check it.
1158     (cond
1159      ((null win)) ;; WE HAVE NO WINDOW INFORMATION, stop.
1160      ;; ............................................. different window ...
1161      ((and (windowp win)
1162            (window-live-p win)
1163            ;;  Motion in same window as prereviously?
1164            (not (eq tinymy-:window-previous win)))
1165       (setq tinymy-:window-previous win
1166             mini                    (window-minibuffer-p win))
1167       ;;    1. Select window if it's not minibuffer
1168       ;;    2. if it's minibuffer, select it _only_ if it's active
1169       (when (or (not mini)
1170                 (minibuffer-window-active-p win))
1171         (setq frame (window-frame (select-window win)))
1172         (raise-frame frame)
1173         ;; FIXME: Is this really needed?
1174         (select-frame frame)))
1175      ;; ....................................... Special 'info' handler ...
1176      ((and (not (window-minibuffer-p (selected-window)))
1177            (not (eq (point-min) (point-max)))) ;Not empty buffer?
1178       ;; ........................................... pointing with mouse ...
1179       (when (integerp point)            ;POINT could be 'mode-line
1180         (setq p point)                  ;Crossing window border
1181         ;;      (message "%d %d %d "  p bottom (- bottom p) )
1182         ;;  Threshold of NN characters, near the right hand lower corner.
1183         ;;  Make the call `inline' because `tinymy-mouse-movement-handler'
1184         ;;  is called very often
1185         (when (and p (< (- bottom p) 50))
1186           (inline (tinymy-buffer-info))
1187           ;;   mic paren: If your cursor is at end of defun
1188           ;;   parenthesis, and this function is called, the
1189           ;;   mic-paren will still display the beginning of function
1190           ;;   info. Out info is not show...
1191           (defvar mic-paren-backw-overlay nil) ;No-op, ByteComp
1192           (if (and (featurep 'mic-paren)
1193                    ;; This overlay exists if cursor was on paren
1194                    mic-paren-backw-overlay)
1195               (sit-for 2))))))
1196     ;; Integrate with Emacs 21.3
1197     (when (fboundp 'tooltip-mouse-motion)
1198       (ti::funcall 'tooltip-mouse-motion event))))
1199
1200 ;;}}}
1201 ;;{{{ elisp: package saving from mail, gnus
1202
1203 ;;; ----------------------------------------------------------------------
1204 ;;;
1205 (defun tinymy-package-save-get-file-name ()
1206   "See `tinymy-package-save-to-file'. Find out package file name.
1207 Return '(file-name  point)."
1208   (let* ((fid "tinymy-package-save-get-file-name:")
1209          ;;  - the file start and it's name
1210          ;;  - The regexp will jump until there is a-zA-Z0-9
1211          (com "^\\(#\\|;;+\\)")
1212          (re1 (concat com "[ \t]+\\([^ \t]+\\.el\\)[ \t]+[-][-]+"))
1213          (re2 (concat com "[ \t]+\\([^ \t]+\\)[ \t]+[-][-]+[ \t]"))
1214          (re3 (concat com "[ \t]+\\(.*\\)[ \t]+[-][-]+"))
1215          (re4 (concat com "[ \t]+\\(.*\\)[ \t]+[-]+"))
1216          (re5 "^\\(;;;*\\)[ \t]+\\([^ \t\n]+\\.el\\)[ \t]+")
1217          file
1218          point)
1219     (unless fid ;; No-op. XEmacs byte compiler silencer
1220       (setq fid nil))
1221     (save-excursion
1222       (ti::pmin)
1223       ;;  See if we can detect the package name in this buffer
1224       (when (dolist (re (list re5 re1 re2 re3 re4))
1225               (when (re-search-forward re nil t)
1226                 (tinymy-debug fid 'MATCH re 'LINE (ti::read-current-line) "\n")
1227                 (return t)))
1228         (setq file  (match-string 2)
1229               com   (match-string 1)
1230               point (line-beginning-position))
1231         ;;  Verify that we found correct point
1232         (goto-char point)
1233         (when (or (looking-at "^.*end.*here")
1234                   ;;  If the point is near the end of file, reject it
1235                   (> (- (point-max) (* 3 80))
1236                      point))
1237           ;; Nope, wrong position found. Try again.
1238           (goto-char (point-min))
1239           (when (re-search-forward "^;;;")
1240             (setq point (line-beginning-position))))
1241         ;;  Suppose this is a lisp file, because comment mark is colon(;)
1242         ;;  make sure the filename has .el at the end
1243         (tinymy-debug fid 'BUFFER (buffer-name) 'FILE file "\n")
1244         (beginning-of-line)
1245         (when (looking-at "^[ \t]*;")
1246           (setq file (ti::string-verify-ends file "\\.el" ".el")
1247                 file (or (locate-library file) file)))))
1248     (tinymy-debug fid 'BUFFER (current-buffer) 'RET file 'POINT point)
1249     (cond
1250      (file
1251       (list file point))
1252      (t
1253       (message "TinyMy: (package save) No proper File header found.")
1254       nil))))
1255
1256 ;;; ----------------------------------------------------------------------
1257 ;;;
1258 (defun tinymy-package-save-to-file-buffer-beginning (file)
1259   "Find proper file beginning point.
1260
1261 Return:
1262
1263   point or nil."
1264   (let* ((fid   "tinymy-package-save-to-file-buffer-beginning:")
1265          (fname (file-name-sans-extension (file-name-nondirectory file)))
1266          (ext   (file-name-extension file))
1267          (regexp
1268           ;;  file\\(.ext\\)? -- description
1269           ;;  ;;; @(#) file.ext --- description
1270           ;;      |
1271           ;;      see unix SunOS what(1) command
1272           (format "^\\([^ \t\n:,.-]+\\) +\\(%s[ \t]*\\)?%s[ \t]+-+[ \t]+"
1273                   (regexp-quote "@(#)")
1274                   (concat
1275                    (regexp-quote fname)
1276                    "\\(\\." (regexp-quote ext) "\\)?")))
1277          point)
1278     (unless fid ;; No-op. XEmacs byte compiler silencer
1279       (setq fid nil))
1280     (save-excursion
1281       (ti::pmin)
1282       (when (re-search-forward regexp nil t)
1283         (setq point   (line-beginning-position))))
1284     (tinymy-debug fid
1285                   'FILE file
1286                   'BUFFER (current-buffer)
1287                   'REGEXP regexp
1288                   'POINT  point)
1289     point))
1290
1291 ;;; ----------------------------------------------------------------------
1292 ;;;
1293 (defun tinymy-package-save-to-file-buffer-ending (&optional start-point)
1294   "Find proper file ending starting from START-POINT.
1295 Return point or nil."
1296   (let* ((fid "tinymy-package-save-to-file-buffer-ending:")
1297          ;;  - the file start and it's name
1298          ;;  - The regexp will jump until there is a-zA-Z0-9
1299          (com    "^\\(#\\|;;+\\)")
1300          (regexp (concat
1301                   com
1302                   "[ \t]+\\(end[ \t]+of[ \t]\\(file\\)?\\|^;.*&eof\\)"
1303                   "\\|^;;+[ \t]+.*ends here"))
1304          ;; Yes, it really does have trailing space
1305          ;; "- -- \n" is for PGP signed message which breaks the
1306          ;; dashes.
1307          (signature-end "^\\(- \\)?-- \n")
1308          end-point)
1309     (unless fid ;; No-op. XEmacs byte compiler silencer
1310       (setq fid nil))
1311     (save-excursion
1312       (if start-point
1313           (goto-char start-point)
1314         (ti::pmin))
1315       (cond
1316        ((re-search-forward regexp nil t)
1317         (beginning-of-line)
1318         (tinymy-debug fid 'REGEXP regexp (point) (ti::read-current-line))
1319         (setq end-point (line-beginning-position)))
1320        ((progn
1321           (ti::pmax)
1322           (re-search-backward signature-end start-point t))
1323         (tinymy-debug fid 'SIGNATURE (point))
1324         (setq end-point (line-beginning-position)))))
1325     end-point))
1326
1327 ;;; ----------------------------------------------------------------------
1328 ;;;
1329 (defun tinymy-package-save-to-file-buffer ()
1330   "Return correct code buffer, usually `current-buffer'.
1331 For Gnus this is `gnus-original-article-buffer'."
1332   (cond
1333    ((and (featurep 'gnus)
1334          (or (string= (buffer-name)
1335                       gnus-article-buffer)
1336              (and (equal (current-buffer) gnus-summary-buffer)
1337                   (not (string-match
1338                         "Dead "
1339                         (buffer-name gnus-summary-buffer))))))
1340     (let ((buffer (get-buffer gnus-original-article-buffer)))
1341       (if (and buffer
1342                (y-or-n-p "TinyMy: Use unformatted *Original Article Buffer*? "))
1343           ;;  For Gnus, use the unformatted buffer
1344           buffer
1345         (current-buffer))))
1346    (t
1347     (current-buffer))))
1348
1349 ;;; ----------------------------------------------------------------------
1350 ;;; - Imagine that you're reading gnu.emacs.sources and want to get
1351 ;;;   that package in the post.
1352 ;;; - Or you receive a package in private mail message...
1353 ;;; - This does the job of saving that package to file very easily.
1354 ;;;
1355 (defun tinymy-package-save-to-file (file &optional code-buffer save-start)
1356   "Save FILE in current buffer starting at optional SAVE-START.
1357
1358 The file is supposed to have special heading and when the heading
1359 is found the file ends at `point-max' or when the footer is found
1360 The following are valid heading. See unix what(1) for the second line.
1361
1362     ;; file.el -- description
1363     # @(#) file.txt -- description
1364
1365 If function can't find footer
1366
1367      End of XXX.txt
1368      End of file XXX.txt
1369      &eof
1370      XXX ends here
1371
1372 it'll add one and include everything to the end of buffer,
1373 before writing."
1374   (interactive
1375    (let ((buffer (tinymy-package-save-to-file-buffer)))
1376      (with-current-buffer buffer
1377        (multiple-value-bind (file point buf)
1378            (tinymy-package-save-get-file-name)
1379          (unless file
1380            (error
1381             "TinyMy: Can't find filename. Select a region, M-x write-region."))
1382          (list
1383           (read-file-name "Save to file: "
1384                           (file-name-directory file)
1385                           nil ;; users null string
1386                           (not 'must-match)
1387                           (file-name-nondirectory file))
1388           buffer
1389           point)))))
1390   (let* ((fid           "tinymy-package-save-to-file:")
1391          (orig-point    (point))
1392          p1
1393          p2
1394          ans
1395          str
1396          point)
1397     (unless fid ;; No-op. XEmacs byte compiler silencer
1398       (setq fid nil))
1399     (or code-buffer
1400         (setq code-buffer
1401               (tinymy-package-save-to-file-buffer)))
1402     ;;  See if we can detect the package name in this buffer
1403     (when file
1404       (with-current-buffer code-buffer
1405         (ti::pmin)
1406         (setq p1     (or save-start
1407                          (tinymy-package-save-to-file-buffer-beginning file)
1408                          (point))
1409               p2     (point-max))
1410         ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ end ^^^
1411         (setq point (tinymy-package-save-to-file-buffer-ending p1))
1412         (cond
1413          (point
1414           (setq p2 point))
1415          (t
1416           (setq str "TinyMy: Hm, No proper save ending. Using point-max ")
1417           (tinymy-debug fid str)
1418           (message str)
1419           (sit-for 1)))
1420         ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ existing file ^^^
1421         (when (file-exists-p file)
1422           (setq ans (read-from-minibuffer "overwrite?: " file))
1423           (cond
1424            ((string= ans file)
1425             (delete-file file))
1426            ((ti::nil-p ans)
1427             (error "TinyMy: Aborted."))
1428            (t
1429             (setq file ans))))
1430         (tinymy-debug fid 'SAVE-FROM code-buffer p1 p2 'TO file)
1431         (when (or (eq p1 p2)
1432                   (> p1 p2))
1433           (error "\
1434 TinyMy: [ERROR] Can't find region. Save manually (See M-x tinymy-version)."))
1435         ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ saving ^^^
1436         (with-temp-buffer
1437           (insert-buffer-substring code-buffer p1 p2)
1438           (ti::pmin)
1439           (when (string-match "\\.\\(zip\\|gz\\)$" file)
1440             (ti::use-file-compression))
1441           (write-file file)             ;jka handles compressing
1442           (not-modified)
1443           (message (concat "TinyMy: Package saved to " file)))
1444         ;; Restore point
1445         (goto-char orig-point)))))
1446
1447 ;;}}}
1448 ;;{{{ file
1449
1450 ;;; ----------------------------------------------------------------------
1451 ;;;
1452 (defun tinymy-maybe-make-file-executable ()
1453   "If file's first line starts with #!, make file executable.
1454 Ignores file whose `file-modes' can't be read, e.g. for ange-ftp files."
1455   (let* ((file (buffer-file-name))
1456          (mode (and file
1457                     (not (ti::file-name-remote-p file))
1458                     (file-modes file))))
1459     (when (and file
1460                mode
1461                (save-excursion
1462                  (ti::pmin)
1463                  (let ((stat (looking-at "^#!")))
1464                    (if (and (not stat)
1465                             (looking-at
1466                              (concat
1467                               "^"
1468                               ;;  Do not use ".+", because it overflows
1469                               ;;  Emacs egexp matcher in files which are
1470                               ;;  one big line, like in Gnus
1471                               ".?.?.?.?.?.?.?.?.?.?.?.?.?.?.?"
1472                               "#!")))
1473                        (message "Tinymy: Suspicious #! first line."))
1474                    stat)))
1475       (unless (eq 64 (logand 64 mode))
1476         (set-file-modes file (ti::file-mode-make-executable mode))))))
1477
1478 ;;; ----------------------------------------------------------------------
1479 ;;;
1480 (defun tinymy-trim-blanks ()
1481   "Delete trailing blanks from all lines; including lines from end of buffer."
1482   (interactive)
1483   (save-excursion
1484     (unless buffer-read-only
1485       (ti::buffer-trim-blanks (point-min) (point-max))
1486       ;;  Now delete extra lines from the end of buffer
1487       (goto-char (point-max))
1488       (when (not (zerop (skip-chars-backward " \t\n")) )
1489         (forward-char 1)                ;Leave newline
1490         (unless (eq (point) (point-max))
1491           (delete-region (point-max) (point))))))
1492   (if (interactive-p)
1493       (message "TinyMy: Blanks trimmed"))
1494   nil)                                  ;Clean return code
1495
1496 ;;; ----------------------------------------------------------------------
1497 ;;; - Especially when I'm making diff to the Author I find this
1498 ;;;   very useful.
1499 ;;;
1500 ;;;
1501 (defun tinymy-copy-file (file1 file2 &optional arg)
1502   "Make copy of current buffer FILE1 to FILE2 (FILE1.orig or FILE1.VER).
1503 Function tries to find possible RCS version.
1504 You usually make backup if you make a change and send diff to author.
1505
1506 If you supply PREFIX ARG, then
1507
1508   C - u remove the copy files; namely,     (buffer-file-name).*
1509   nbr   Copy back: this like doing
1510         FILE.VER  --> FILE
1511         FILE.orig --> FILE
1512
1513         If you had made a safe copy previously, this restores
1514         the safe copy to original file."
1515   (interactive
1516    (let* ((suf   tinymy-:copy-file-suffix)
1517           (ver   (or (ti::vc-rcs-buffer-version)
1518                      ;;  No rcs string found, then try Regular lisp package
1519                      ;;  syntax.
1520                      ;;
1521                      ;;  Version:       2.37
1522                      (ti::re-search-check
1523                       "^;+[ \t]+Version:[ \t]*\\([0-9.]+\\)" 1 nil 'read)))
1524           (file1 (or (buffer-file-name)
1525                      (error "Buffer does not visit a file.")))
1526           (ext   (if ver
1527                      (concat "." ver)
1528                    suf))
1529           file2)
1530      (if current-prefix-arg
1531          (list file1 nil current-prefix-arg)
1532        (setq file2 (read-from-minibuffer "Make copy to: " (concat file1 ext)))
1533        (list file1 file2))))
1534
1535   (let* ((re        (format "^%s\\." (file-name-nondirectory file1)))
1536          (file-list (ti::directory-files (file-name-directory file1)
1537                                          re 'abs t)))
1538     (cond
1539      ((null arg)
1540       (cond
1541        ((or (not (file-exists-p file2))
1542             (and (file-exists-p file2)
1543                  (y-or-n-p (format "%s exists. Remove? " file2))
1544                  (progn
1545                    (delete-file file2)
1546                    t)))
1547         (ti::file-delete-safe file2)
1548         (copy-file file1 file2)
1549         (message "TinyMy: safe copy done."))
1550        (t
1551         (message "TinyMy: sorry; cannot decide how to do the copying."))))
1552      ((equal arg '(4))
1553       (if (null file-list)
1554           (message "TinyMy: There are no safe copy files matching %s" re)
1555         (dolist (file1 file-list)
1556           (if (y-or-n-p (format "Delete %s ? " file1))
1557               (delete-file file1)))))
1558      ((integerp arg)
1559       (cond
1560        ((null file-list)
1561         (message "TinyMy: There is no safe copy for %s" file1))
1562        ((eq 1 (length file-list))
1563         (when (y-or-n-p
1564                (message "TinyMy: Found safe copy %s; copy it over original? "))
1565           (delete-file file1)           ;copy-file barfs otherwise
1566           (copy-file (car file-list) file1)
1567           (message "TinyMy: Safe copy restored.")))
1568        ((> (length file-list) 1)
1569         (setq file2
1570               (completing-read
1571                "Don't know which one to use as source, complete: "
1572                (ti::list-to-assoc-menu
1573                 (mapcar 'file-name-nondirectory file-list))
1574                nil 'must-match))
1575         (setq file2 (concat (file-name-directory file1) file2))
1576         (delete-file file1)
1577         (copy-file file2 file1)
1578         (message "TinyMy: Safe copy restored: %s --> %s"
1579                  (file-name-nondirectory file2 )
1580                  (file-name-nondirectory file1))))))))
1581
1582 ;;}}}
1583 ;;{{{ key: % matching
1584
1585 ;;; ----------------------------------------------------------------------
1586 ;;; All the posts so far in the internet to make the "%" match parens
1587 ;;; right in every possible _mode_ failed. That's why I started writing
1588 ;;; my own function, which you see here.
1589 ;;;
1590 (defun tinymy-vi-type-paren-match (&optional arg)
1591   "Match engine: find {[( or )]} pairs. ARG is character repeat count.
1592 See also 'tinymy-:vi-type-paren-match-special-list
1593
1594 References:
1595   `tinymy-:vi-type-paren-match-list'
1596   `tinymy-:vi-type-paren-match-special-list'"
1597   (interactive "P")
1598   (let* ((p         (point))
1599          (ptable    (syntax-table))     ;previous, the original
1600          (ch        (following-char))
1601          (ch-next   (ti::buffer-read-char nil 1))
1602          (ch-prev   (preceding-char))
1603          (pairs     tinymy-:vi-type-paren-match-list)
1604          (left      (car-safe (assoc  (char-to-string ch) pairs)))
1605          (right     (car-safe (rassoc (char-to-string ch) pairs)))
1606          (m-list    tinymy-:vi-type-paren-match-special-list) ;match list
1607          (spread-limit   (* 10 60))     ;approx 10 lines of code.
1608          table
1609          s-func add-func max-func bigger-func
1610          self-insert
1611          go
1612          max)
1613     (catch 'terminate
1614       ;;  check if the parens are "closed", ie. there is nothing beween them
1615       (cond
1616        ((and (ti::char-in-list-case ch m-list) ch-next)
1617         (setq self-insert
1618               (not (string= (char-to-string ch-next) (char-to-string ch)))))
1619        (right
1620         ;;  If NEXT == RIGHT
1621         (setq self-insert
1622               (string= (char-to-string ch-prev) left)))
1623        (left
1624         (setq self-insert
1625               (string= (char-to-string ch-next) right))))
1626       (when (and ch self-insert)
1627         (self-insert-command (or arg 1))
1628         (throw 'terminate t))
1629       ;;  already calculated ? No ?
1630       (unless (setq table (get 'tinymy-:vi-type-paren-match-list 'syntax-table))
1631         (setq table (make-syntax-table))
1632         ;;   We want everything to look like word
1633         (ti::dotimes counter 0 255 (modify-syntax-entry counter "w" table))
1634         (mapcar
1635          (function
1636           (lambda (x)
1637             (modify-syntax-entry (string-to-char (car x)) "(" table)
1638             (modify-syntax-entry (string-to-char (cdr x)) ")" table)))
1639          pairs)
1640         (put 'tinymy-:vi-type-paren-match-list 'syntax-table table))
1641       ;;  In lisp; only () are matched.
1642       (when (not (string-match "lisp" (symbol-name major-mode)))
1643         (set-syntax-table table))
1644       (unwind-protect
1645           (condition-case nil
1646               (cond
1647                ;; ........................................ handle quotes ...
1648                ((ti::char-in-list-case ch m-list)
1649                 (setq ch (regexp-quote (char-to-string ch)))
1650                 (setq s-func   're-search-forward
1651                       add-func '+
1652                       max-func 'point-max
1653                       bigger-func '>)
1654                 (cond
1655                  ((looking-at (concat ch "[ \t]*$"))
1656                   ;; Only search backward if no ARG given.
1657                   ;; if the " char is at the end of line,
1658                   ;; then it propably is the 'closing' one.
1659                   (if (null arg)
1660                       (setq s-func   're-search-backward
1661                             add-func '-
1662                             max-func 'point-min
1663                             bigger-func '<))))
1664                 ;; Do not go too far away....
1665                 (setq go (funcall add-func p  spread-limit))
1666                 (setq max (funcall max-func))
1667                 (setq max
1668                       (if (funcall bigger-func go max)
1669                           max go))
1670                 ;; ... ... ... ... ... ... ... ... ... ... ... do search . .
1671                 (if (eq s-func 're-search-forward)
1672                     (forward-char 1))   ;move out of way
1673                 (funcall s-func ch go t)
1674                 ;; This is funny, it both a) restores the position
1675                 ;; if search failed, b) adjusts the "after" search
1676                 ;; point back to char.
1677                 (if (eq s-func 're-search-forward)
1678                     (forward-char -1)))
1679                ;; ..................................... handle BEG pairs ...
1680                ((looking-at "[[({<]")
1681                 (forward-sexp 1)
1682                 (backward-char)
1683                 (cond ((not (looking-at "[])}>]"))
1684                        (error "..booomerang"))))
1685                ;; ..................................... handle END pairs ...
1686                ((looking-at "[])}>]")
1687                 (forward-char 1)
1688                 (forward-sexp -1)
1689                 (when (not (eq p (point))) ;moved ?
1690                   ;;  In lisp, jumping from closing ) to starting
1691                   ;;  "'(lambda" puts cursor at "'"?? Correct it.
1692                   (if (and (not (eq (following-char) ?\( ))
1693                            (looking-at ".[]({<]"))
1694                       (forward-char 1))))
1695                ;; ...................................... no special char ...
1696                (t
1697                 (self-insert-command (or arg 1))))
1698             (error
1699              (goto-char p)              ;restore position
1700              (message "TinyMy: No match.")))
1701         ;; make sure we restore this
1702         (set-syntax-table ptable)))))
1703
1704 ;;}}}
1705 ;;{{{ mail
1706
1707 ;;; ----------------------------------------------------------------------
1708 ;;;
1709 (defun tinymy-mail-subject-get ()
1710   "Look buffer content and return subject for mail message.
1711
1712 diff buffer:
1713
1714   'context diff file.txt'
1715
1716 rcsdiff buffer:
1717
1718   'diff 1.23 --> 1.25 file.txt'
1719
1720 Regular buffer:
1721
1722    '1.25 file.txt'       ;; possibly without version information
1723
1724 buffer with no filename:
1725
1726    nil"
1727   (let* ((rcs-re    "retrieving revision +\\(.*\\)")
1728          (v1        "")
1729          (v2        "")
1730          type
1731          ver
1732          file
1733          msg)
1734     (save-excursion
1735       (ti::pmin)
1736       (cond
1737        ;;  See if this is rcsdiff
1738        ;;
1739        ;;  RCS file: RCS/tinylib.el,v
1740        ;;  retrieving revision 1.95
1741        ;;  retrieving revision 1.97
1742        ;;  diff -c -r1.95 -r1.97
1743        ;;  *** 1.95     1997/03/22 12:26:59
1744        ;;  --- 1.97     1997/03/22 15:17:22
1745        ((re-search-forward "^RCS file:[^/]*/?\\(.*\\),v" nil t)
1746         (setq file (match-string 1))
1747         (and (re-search-forward rcs-re nil t)
1748              (setq v1 (match-string 1))
1749              (re-search-forward rcs-re nil t)
1750              (setq v2 (match-string 1)))
1751         (setq msg (format "patch: %s --> %s %s" v1 v2 file)))
1752        (buffer-file-name
1753         ;;  Regular file, see if this one has RCS version information
1754         (if (setq ver (ti::vc-rcs-buffer-version))
1755             (setq ver (concat " " ver " ")))
1756         (setq msg (concat
1757                    (or ver "")
1758                    (file-name-nondirectory buffer-file-name))))
1759        ((setq type (ti::buffer-diff-type-p))
1760         ;; *** /users/jaalto/T.orig  Sun Mar 23 16:37:43 1997
1761         ;; --- /users/jaalto/T       Sat Mar 22 14:44:34 1997
1762         (save-excursion
1763           (ti::pmin)
1764           (if (or (re-search-forward "^--- \\([^ \t\n]+\\)" nil t)
1765                   (re-search-forward "^\\*\\*\\* \\([^ \t\n]+\\)" nil t)
1766                   (re-search-forward "^\\+\\+\\+ \\([^ \t\n]+\\)" nil t))
1767               (setq file (match-string 1))))
1768         (setq msg (format "%s diff %s"
1769                           (prin1-to-string (car type))
1770                           (if file
1771                               (file-name-nondirectory file )
1772                             ""))))))
1773     msg))
1774
1775 ;;; ----------------------------------------------------------------------
1776 ;;;
1777 (defun tinymy-mail-buffer ()
1778   "Mail current buffer.
1779 The subject line is constructed by looking at the buffer content:
1780 eg if buffer contains rcsdiff of diff,
1781 The subject line will tell the versions."
1782   (interactive)
1783   (let* ((data-buffer   (current-buffer))
1784          subj)
1785     (setq subj (tinymy-mail-subject-get))
1786     (compose-mail)
1787     ;;  This package gives nice alias expansion
1788     (ti::package-require-mail-abbrevs)
1789     (ti::mail-text-start 'move)
1790     (insert "\n\n\n\n")
1791     (save-excursion (insert-buffer data-buffer))
1792     ;; Make sure the outlline/folding is opened first
1793     (ti::buffer-outline-widen)
1794     (if subj
1795         (ti::mail-kill-field "Subject:" subj))
1796     (ti::pmin)
1797     (end-of-line)                       ;"TO:" field
1798     (run-hooks 'tinymy-:mail-buffer-hook)))
1799
1800 ;;}}}
1801 ;;{{{ Programming: function bounds, debug
1802
1803 ;;; ----------------------------------------------------------------------
1804 ;;;
1805 (defun tinymy-function-bounds (&optional forward)
1806   "Find function area. Return (beg . end).
1807 The search is first done backward, unless FORWARD is given,
1808 to find function beginning.
1809
1810 Notes:
1811  All function start lines must be left flushed, ie. no empty spaces before
1812  function name declaration. Functions must start/end with left flushed
1813  \"{\" and \"}\".
1814
1815 Supported modes:
1816   C/C++
1817   perl
1818   awk
1819   lisp"
1820   (let* ((mode                (or (ti::id-info) (symbol-name major-mode)))
1821          (max-lines           1500)   ;rows, function cannot be bigger
1822          (skip-lines          1300)     ;maximum skip lines backward
1823          (start               (point))
1824          beg end
1825          range point
1826          fwd-flag)
1827     (cond
1828      ((string-match "lisp" mode)
1829       ;;  Only lisp has decent find functions
1830       (save-excursion
1831         (if forward
1832             (ignore-errors
1833               (end-of-defun)
1834               (forward-line 2)
1835               (setq fwd-flag t)))
1836         (ignore-errors
1837           (beginning-of-defun)
1838           (setq beg (point)))
1839         (if (or (and beg (null forward))
1840                 (and beg forward fwd-flag))
1841             (ignore-errors
1842               (end-of-defun)
1843               (setq end (point))))))
1844      ((string-match "perl\\|awk" mode)
1845       (save-excursion
1846         (cond
1847          (forward
1848           (if (re-search-forward "^sub\\|^function" nil t)
1849               (setq fwd-flag t))))
1850         (cond
1851          ((and (or (null forward)
1852                    (and forward fwd-flag))
1853                (re-search-backward "^sub\\|^function" nil t))
1854           (beginning-of-line)
1855           (setq beg (point))
1856           (if (re-search-forward "^}" nil t)
1857               (setq end (point)))))))
1858      ((string-match "code-c\\|c-\\|cc-\\|c[+]" mode)
1859       ;;  The opening block says where is function start, this is only
1860       ;;  possible for NEW styled programming, not K&R styled 'hanging'
1861       ;;
1862       ;;  C++: int funtion() {             ;; nope, too diffucult to detect.
1863       ;;  perl sub funtion   {             ;; allowed
1864       (save-excursion
1865         (cond
1866          (forward
1867           (if (re-search-forward "^{" nil t)
1868               (setq fwd-flag t))))
1869         (cond
1870          ((and (or (null forward)
1871                    (and forward fwd-flag))
1872                (re-search-backward "^{" nil t)
1873                (re-search-backward "(" nil t)) ;find parameter list beginning
1874           ;;  There is a problem in writing the C++ funcs:
1875           ;;
1876           ;;  // Comment
1877           ;;  /* Comment
1878           ;;  */
1879           ;;  int
1880           ;;  functionName
1881           ;;  ( parameters
1882           ;;
1883           (beginning-of-line)
1884           (setq point (point))
1885           ;; We just search line by line backward until no comment,
1886           ;; or empty line
1887           (while (not (looking-at " *//+\\| *[*]+/\\| *[*]+ \\|^[ \t]*$"))
1888             (forward-line -1))
1889           (if (not (eq point (point)))  ;if the while loop moved.
1890               (forward-line 1))         ;go to func beginning.
1891           (setq beg (point))
1892           (if (re-search-forward "^}" nil t) ;;  This is easy.
1893               (setq end (point))))))))
1894     (if (and beg end
1895              ;; must not be too far away from current point
1896              (< (count-lines beg start) skip-lines))
1897         (setq range (count-lines beg end)))
1898     ;;  The return value
1899     (if (and range (< range max-lines))
1900         (cons beg end)
1901       nil)))
1902
1903 ;;; ----------------------------------------------------------------------
1904 ;;;
1905 (defun tinymy-beginning-of-defun (&optional end-of-fun)
1906   "See `tinymy-function-bounds'. END-OF-FUN must be nil or t."
1907   (interactive)
1908   (let* ((bounds (tinymy-function-bounds  end-of-fun))
1909          (beg    (car-safe bounds))
1910          (end    (cdr-safe bounds))
1911          (point  (if end-of-fun end beg)))
1912     (if (null bounds)
1913         (message "TinyMy: Sorry, can't find function.")
1914       (goto-char point))))
1915
1916 ;;; ----------------------------------------------------------------------
1917 ;;;
1918 (defun tinymy-end-of-defun ()
1919   "See `tinymy-function-bounds'."
1920   (interactive)
1921   (tinymy-beginning-of-defun 'end))
1922
1923 ;;}}}
1924 ;;{{{ rectangle
1925
1926 ;;; ----------------------------------------------------------------------
1927 ;;;
1928 (defun tinymy-add-rectangle (START END &optional insert)
1929   "Add or Multiply columns in rectangle in START END.
1930 With optional arg INSERT, insert the sum and product to
1931 the current point."
1932
1933   (interactive "r\nP")
1934   (require 'rect)
1935   (let ((sum        0)
1936         (rownum     0)
1937         (prod       1)
1938         (rowval     0))
1939     (operate-on-rectangle
1940      (lambda (POS BEFORE AFTER)
1941        (setq rownum (1+ rownum))
1942        (setq rowval (string-to-number (buffer-substring POS (point))))
1943        (setq sum  (+ sum  rowval))
1944        (setq prod (* prod rowval)))
1945      START END 't)
1946     (if (interactive-p)
1947         (message "TinyMy: For %d rows, sum=%f, product=%f" rownum sum prod))
1948     (if insert
1949         (insert (format "%0.2f %0.2f" sum  prod)))))
1950
1951 ;;}}}
1952 ;;{{{ scrolling
1953
1954 ;;; ----------------------------------------------------------------------
1955 ;;;
1956 (defun tinymy-scroll-up ()
1957   "Call `tinymy-scroll-down'."
1958   (interactive)
1959   (tinymy-scroll-down 'up))
1960
1961 ;;; ----------------------------------------------------------------------
1962 ;;;
1963 (defun tinymy-scroll-down (&optional up)
1964   "Scrolls down, optionally UP. No errors generated.
1965 Cursor is positioned at first call to the top or bottom of window and
1966 and only next call scrolls the window. If possible, cursor in kept at the
1967 yop or bottom line of window. (Caveat: for long lines, this cannot be done)."
1968   (interactive "P")
1969   ;; Don't know which Emacs version introduced this function.
1970   ;; Use old trusted implementation if it doesn't exist
1971   (let ((point (point)))
1972     (if (not (fboundp 'move-to-window-line))
1973         (tinymy-scroll-old up)
1974       (cond
1975        ((and up (ti::window-pmin-visible-p))
1976         (ti::pmin))
1977        ((and up (eq (point) (window-start)))
1978         (scroll-down)
1979         (move-to-window-line 0))
1980        (up
1981         (move-to-window-line 0)
1982         (when (eq point (point))
1983           ;; Point didn't move? Use Emacs function.
1984           (ignore-errors
1985             (scroll-down))
1986           (move-to-window-line 0)))
1987        ;;
1988        ;;   Down movements
1989        ;;
1990        ((ti::window-pmax-visible-p)
1991         (ti::pmax))
1992        ((eq (point) (ti::window-pmax-line-bol))
1993         (scroll-up)
1994         ;;  Keep cursor at bottom
1995         (move-to-window-line -1))
1996        ((move-to-window-line -1)
1997         (beginning-of-line)
1998         (when (eq point (point))
1999           ;; Point didn't move? Use Emacs function.
2000           (ignore-errors
2001             (scroll-up))
2002           (move-to-window-line -1))))
2003       ;;  Make sure point is at the beginning
2004       (move-to-column 0))))
2005
2006 ;;; ----------------------------------------------------------------------
2007 ;;;
2008 (defun tinymy-scroll-old (&optional up)
2009   "Scrolls down, optionally UP. No errors generated.
2010 This function behaves like DOS/windows scroll commands, where cursor jumps
2011 to the end or beginning of window first and only next scrolls. It also
2012 keeps the cursor in the bottom or top of window according to the direction
2013 of scroll.
2014
2015 Note:
2016
2017   This function does not work properly if the lines in the window
2018   exceed the length of the window. If the current line is longer than
2019   window length, then normal Emacs scroll command will be called."
2020
2021   ;;  - the 'error' call is most disturbing if you have
2022   ;;  - debug-on-error t
2023   ;;  - This is for *interactive* only! Lisp manual forbids using scroll
2024   ;;    command in normal lisp code.
2025
2026   (interactive "P")
2027   (let* ((mode   tinymy-:scroll-mode)
2028          lines)
2029     (cond
2030      ((ti::line-wrap-p)
2031       ;; ............................................. wrapping line ...
2032       (cond
2033        (up
2034         (if (ti::window-pmin-visible-p)
2035             (ti::pmin)
2036           (scroll-down)))
2037        (t
2038         (if (ti::window-pmax-visible-p)
2039             (ti::pmax)
2040           (scroll-up)))))
2041      (t
2042       ;; ........................................... non wrapping line ...
2043       (cond
2044        (up
2045         (if (bobp)
2046             (message "TinyMy: beg of buffer.")
2047           (if (ti::window-pmin-visible-p) ;if top is visible
2048               (goto-char (point-min))
2049             (if (or (null mode)
2050                     (and mode
2051                          (ti::window-pmin-line-p)))
2052                 (scroll-down))
2053             (goto-char (window-start))
2054             (beginning-of-line))))
2055        (t
2056         (if (eobp)
2057             (message "TinyMy: end of buffer.")
2058           (if (ti::window-pmax-visible-p)
2059               (goto-char (point-max))
2060
2061             (if (or (null mode)
2062                     (and mode
2063                          (ti::window-pmax-line-p)))
2064                 (progn
2065                   ;;   - if outline/folding mode is on, we can't determine
2066                   ;;     line count with count-lines function
2067                   ;;   - The count gives 1 extra line, check with M-x =
2068                   ;;     around the window region
2069                   (setq lines
2070                         (1-
2071                          (count-char-in-region
2072                           (window-start) (window-end) ?\n)))
2073                   ;; the scroll command does not update window points
2074                   ;; in 19.28! That means that the function window-end
2075                   ;; can't be trusted. only when this function ends,
2076                   ;; the window is updated.
2077                   (scroll-up)
2078                   ;;  We must manually go to the end line
2079                   ;;  - The cursor is always left in the line 2, after
2080                   ;;    scrolling in window. We have to go N lines downward
2081                   ;;    to put cursor at window end line
2082                   ;;  - next-line is used, because it hanbdles folding/outline.
2083                   ;;    forward-line can't be used.
2084                   ;;
2085                   ;;  Note:
2086                   ;;  - If the lines are longer than window-width; then this
2087                   ;;    whole next-line call may end anywhere...can't help
2088                   ;;    that
2089                   ;;  - The safe do is here in case this calls error,
2090                   ;;    which it does if the buffer size has changes, like
2091                   ;;    in live *Messages* buffer
2092                   (ignore-errors (next-line (- lines 1))))
2093               (goto-char (ti::window-pmax-line-bol)))))))))))
2094
2095 ;;}}}
2096 ;;{{{ shell -- shar, tar, uu
2097
2098 ;;; ----------------------------------------------------------------------
2099 ;;;
2100 (defun tinymy-shar (single-or-list)
2101   "Generate SHAR file using SINGLE-OR-LIST.
2102 List of  files can include shell regexps. The result is put into
2103 `tinymy-:register'."
2104   (interactive
2105    (let* (arg1)
2106      (setq arg1
2107            (ti::file-complete-filename-minibuffer-macro
2108              (read-from-minibuffer
2109               (format "[%s] Shar files: " default-directory)
2110               nil
2111               map)))
2112      (list arg1)))
2113   (let* ((cmd         (concat tinymy-:shar-command " "))
2114          (register    tinymy-:register)
2115          (verb        (interactive-p))
2116          out)
2117     (if (ti::nil-p single-or-list)
2118         (error "Missing args")
2119       (setq out
2120             (shell-command-to-string
2121              (format "cd %s; %s %s"
2122                      default-directory
2123                      cmd
2124                      (ti::list-to-string (ti::list-make single-or-list)))))
2125       (set-register register out)
2126       (if verb
2127           (message (format "TinyMy: Register %s has shar"
2128                            (char-to-string register)))))))
2129
2130 ;;; ----------------------------------------------------------------------
2131 ;;;
2132 (defun tinymy-tar (tar-file file-list)
2133   "Generate TAR-FILE using FILE-LIST.
2134 Return:
2135  t or nil       if tar created."
2136   (interactive
2137    (let* ((default-directory    default-directory)
2138           (default-tar-name     "pkg.tar")
2139           (default-tar          (concat default-directory default-tar-name))
2140           arg1 arg2
2141           tar-dir)
2142      (setq arg1
2143            (ti::file-complete-filename-minibuffer-macro
2144              (read-from-minibuffer
2145               (format "[%s] Tar name: " default-tar)
2146               nil map)))
2147      (cond
2148       ((ti::nil-p arg1)
2149        (setq arg1 default-tar))
2150       ((file-directory-p arg1)
2151        (setq arg1 (concat arg1 default-tar))))
2152
2153      (setq tar-dir (or (file-name-directory arg1)
2154                        default-directory))
2155      (setq default-directory tar-dir)
2156      (setq
2157       arg2
2158       (ti::file-complete-filename-minibuffer-macro
2159         (read-from-minibuffer
2160          (format "[%s] Files: " arg1)
2161          nil
2162          map)))
2163      (list arg1 arg2)))
2164   ;; ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...  main . .
2165   (if (or (ti::nil-p tar-file)
2166           (ti::nil-p file-list))
2167       (error "Missing args"))
2168   (let* ((tar-cmd       (concat tinymy-:tar-command " "))
2169          (edir          (file-name-directory
2170                          (expand-file-name tar-file)))
2171          (cmd           (concat "cd " edir "; "
2172                                 tar-cmd
2173                                 (file-name-nondirectory tar-file)
2174                                 " " file-list))
2175          ret)
2176     ;; ................................................... then case ...
2177     (if (and (file-exists-p edir)                ;; must exist
2178              (or (not  (file-exists-p tar-file)) ;; good if not exist
2179                  (and  (file-exists-p tar-file) ;; we have to remove it
2180                        (y-or-n-p "Tar exists, remove ? ")
2181                        (progn
2182                          (delete-file tar-file) t))))
2183         (progn
2184           (setq cmd (read-from-minibuffer "cmd: " cmd))
2185           (shell-command cmd)
2186           (setq ret (file-exists-p tar-file)))
2187       (message "TinyMy: Aborted"))
2188     ret))
2189
2190 ;;}}}
2191 ;;{{{ compilation
2192
2193 ;;; ----------------------------------------------------------------------
2194 ;;;  Some special compile commands for C/C++, which usually
2195 ;;;  have .mak files
2196 ;;;
2197 (defun tinymy-compile-command-search (type)
2198   "Search match car of `tinymy-:compile-table' against TYPE and return cdr."
2199   (dolist (elt tinymy-:compile-table)
2200     (when (string-match (car elt) type)
2201       (return (cdr elt)))))
2202
2203 ;;; ----------------------------------------------------------------------
2204 ;;;
2205 (defun tinymy-compile-tinytf-command ()
2206   "Compile .txt file into HTML."
2207   (concat "perl -S t2html.pl --Out --print-url "
2208           (file-name-nondirectory
2209            (buffer-file-name))))
2210
2211 ;;; ----------------------------------------------------------------------
2212 ;;;
2213 (defun tinymy-compile-xml-command ()
2214   "Compile .xml file by running validator."
2215   ;; #todo: incomplete
2216   (let ((list '(("xmlwf") ;;  Expat, included in Cygwin
2217                 ( ;; http://xml.coverpages.org/rxpWindows19991018.html
2218                  ;; Richard Tobin "rxp XML parser"
2219                  ;; -> Compiles under Cygwin
2220                  "rxp"
2221                  ;; verbose, Validate
2222                  "-v -V"))))
2223     (dolist (elt list)
2224       (multiple-value-bind (cmd args)
2225           elt
2226         (when (executable-find cmd)
2227           (return (format "%s %s %s"
2228                           cmd
2229                           (or args "")
2230                           (file-name-nondirectory
2231                            (buffer-file-name)))))))))
2232
2233 ;;; ----------------------------------------------------------------------
2234 ;;;
2235 (defun tinymy-compile-sql ()
2236   "Compile .sql file.
2237 The correct SQL compile command is determined by
2238
2239 1) searching first word from the file that matches string:
2240    PostgreSQL, MySQL, Oracle.
2241
2242 2) Or if the last part of the directory contains portion
2243     /pg /postgre  /postgres /postgresql
2244     /mysql
2245     /oracle
2246
2247 E.g. file in location ~/sql/pg/my-file.sql is supposed to belong
2248 to PostgreSQL."
2249   (when buffer-file-name
2250     (let* ((file  buffer-file-name)
2251            (last (and file
2252                       (ti::directory-part-last
2253                        (file-name-directory file))))
2254            cmd)
2255       (flet ((type-p (regexp1 regexp2)
2256                      (or (ti::re-search-check regexp1)
2257                          (string-match regexp2 (or last "")))))
2258         (or (and (type-p "postgreSQL"
2259                          "\\(^pg$\\|postgres?\\|postgresql\\)")
2260                  (executable-find "psql")
2261                  (setq cmd
2262                        "psql -h HOST -U user -d database < %s"))
2263 ;;;                                ;;  PostgreSQL is native Cygwin application
2264 ;;;                                ;;  and must see Cygwin path.
2265 ;;;                                (if (and (ti::win32-p)
2266 ;;;                                         (ti::emacs-type-win32-p))
2267 ;;;                                    (w32-cygwin-dos-path-to-cygwin file)
2268 ;;;                                  file))))
2269             (and (type-p "MySQL" "mysql")
2270                  (executable-find "mysql")
2271                  (setq cmd "mysql -h HOST -u USER database < %s"))
2272             (and (type-p "Oracle" "oracle")
2273                  (executable-find "sqlplus")
2274                  (setq cmd "sqlplus USER/LOGIN@DATABASE < %s")))
2275         (or (and cmd
2276                  (if (string-match "%" cmd)
2277                      (format cmd (file-name-nondirectory buffer-file-name))
2278                    cmd))
2279             "")))))
2280
2281 ;;; ----------------------------------------------------------------------
2282 ;;;  Some special compile commands for C/C++, which usually
2283 ;;;  have .mak files
2284 ;;;
2285 (defun tinymy-compile-cc-command ()
2286   "Construct C/C++ compile command"
2287   (let* ( ;;  Check if there are any .mak files in directory ?
2288          (file       (file-name-nondirectory (buffer-file-name)))
2289          (make-files (and file
2290                           (ti::directory-files
2291                            (file-name-directory (buffer-file-name))
2292                            "\\.make?$\\|makefile$\\|Makefile$")))
2293          (cc-cmd     (or (getenv "CC") "gcc"))
2294          (flags      (or (getenv "CFLAGS") "-g")))
2295     (if make-files
2296         "make"
2297       (format "%s %s %s -o %s "
2298               cc-cmd
2299               file
2300               flags
2301               ;;  Drop extension
2302               (ti::string-match "^[^.]+" 0 file)))))
2303
2304 ;;; ----------------------------------------------------------------------
2305 ;;;
2306 (defun tinymy-compile-command-for-buffer (mode &optional buffer value)
2307   "Use MODE to control BUFFER' compile command VALUE.
2308 If mode is 'get, recall the buffer's value.
2309 If mode is 'clear, clear previous compile command.
2310 Any other value is equal to 'put with BUFFER and VALUE.
2311
2312 References:
2313
2314   `tinymy-:compile-table'  Values are stored to property list
2315                            '(<buffer> compile-command ..)"
2316   (or buffer
2317       (setq buffer (current-buffer)))
2318   (cond
2319    ((eq mode 'get)
2320     (get 'tinymy-:compile-table buffer))
2321    ((eq mode 'clear)
2322     (put 'tinymy-:compile-table buffer nil))
2323    (t
2324     (put 'tinymy-:compile-table buffer value))))
2325
2326 ;;; ----------------------------------------------------------------------
2327 ;;;
2328 (defun tinymy-compile-command-for-buffer-clear ()
2329   "Clear buffer's compile command."
2330   (tinymy-compile-command-for-buffer 'clear))
2331
2332 ;;; ----------------------------------------------------------------------
2333 ;;;
2334 (defun tinymy-compile-run-command-ask (&optional clear)
2335   "Run current buffer through compile buffer.
2336 This function remembers what command you have used for each buffer
2337 and offers it next time you call it.
2338
2339 Parameter CLEAR instructs to \"forget\" any previously
2340 acched command try the search again from fresh. You can
2341 supply the \\[universal-argument\\] if you have made changes
2342 to `tinymy-:compile-table'.
2343
2344 If mode 'text' or 'fundamental'
2345
2346     Do not try to identify buffer, but ask compile command directly
2347
2348 If mode is not 'text' or 'fundamental'
2349
2350     Try to find suitable compile command by identifying the buffer
2351     and looking at the command table.
2352
2353     For C/C++ code the default command suggested if 'mak', but if there
2354     is no makefile in the directory, then a normal compile command
2355     is proposed.
2356
2357 References:
2358
2359   `tinymy-:compile-table'
2360   `tinymy-:compile-command-c-code'"
2361   (interactive "P")
2362   (if clear
2363       (tinymy-compile-command-for-buffer-clear))
2364   (let* ( ;;  We change this so that compile goes to right dir
2365          (fid       "tinymy-compile-run-command")
2366          (file      (buffer-file-name))
2367          (mname     (symbol-name major-mode))
2368
2369          (type      (or (ti::id-info)
2370                         mname))
2371
2372          (buffer    (current-buffer))
2373          elt
2374          run-it
2375          filename                       ;without directory part
2376          cmd)
2377     (unless fid ;; No-op. XEmacs byte compiler silencer
2378       (setq fid nil))
2379     (tinymy-debug fid  file "type" type)
2380     (if (null file)
2381         (message "TinyMy: Can't compile, no file in this buffer.")
2382       ;;  Try to find last typed commad first, only if there is
2383       ;;  no previous command, make one.
2384       (unless (setq cmd (tinymy-compile-command-for-buffer 'get))
2385         (setq filename (file-name-nondirectory file)
2386               elt      (tinymy-compile-command-search type))
2387         (unless filename ;; No-op, XEmacs byte compiler silencer
2388           (setq filename nil))
2389         (tinymy-debug "No prev cmd" filename elt)
2390         ;; .............................................. make command ...
2391         ;;  Only if the compile command is constant string: save it
2392         ;;  Dynamically evaled compile commands cannot be saved.
2393         (setq cmd
2394               (cond
2395                ((stringp elt)
2396                 (format elt file))
2397                ((functionp elt)
2398                 (funcall elt))
2399                ((setq elt (eval elt))
2400                 (format elt file))))) ;; unless
2401       ;; ............................................... ask from user ...
2402       (setq run-it
2403             (ti::file-complete-filename-minibuffer-macro
2404               (read-from-minibuffer
2405                "Compile: " (or cmd "make")
2406                map
2407                nil
2408                'compile-history)))
2409       ;; ......................................... per buffer cmd save ...
2410       ;;  Save command per buffer basis
2411       (tinymy-debug "CMD" cmd)
2412       (when (or (not (setq cmd (tinymy-compile-command-for-buffer 'get)))
2413                 ;;  User gave different command. Update
2414                 (not (string= cmd run-it)))
2415         (tinymy-compile-command-for-buffer 'put buffer run-it))
2416       run-it)))
2417
2418 ;;; ----------------------------------------------------------------------
2419 ;;;
2420 (defun tinymy-compile-run-command (&optional clear)
2421   "See `tinymy-compile-run-command-ask'."
2422   (interactive "P")
2423   (let* ((cmd (tinymy-compile-run-command-ask clear)))
2424     (when (not (ti::nil-p cmd))
2425       (compile-internal cmd "No more errors.")
2426       (pop-to-buffer "*compilation*"))))
2427
2428 ;;; ----------------------------------------------------------------------
2429 ;;;
2430 (defadvice compile (around tinymy dis)
2431   "Change interactive SPEC to determine default compile command.
2432 See `tinymy-compile-run-command-ask'."
2433   (interactive
2434    (list
2435     (or (tinymy-compile-run-command)
2436         (if (or compilation-read-command
2437                 current-prefix-arg)
2438             (read-from-minibuffer "Compile command: "
2439                                   (eval compile-command) nil nil
2440                                   '(compile-history . 1))
2441           (eval compile-command)))))
2442   ad-do-it)
2443
2444 ;;; ----------------------------------------------------------------------
2445 ;;;
2446 ;;;###autoload
2447 (defun tinymy-compile-run-command-advice (&optional disable)
2448   "Activate or DISABLE smart compile command vie \\[compile\\].
2449 See `tinymy-compile-run-command-ask' for more."
2450   (interactive "P")
2451   (ti::advice-control 'compile "^tinymy"
2452                       disable 'verb
2453                       "TinyMy: smart M-x compile advice support "))
2454
2455 ;;}}}
2456 ;;{{{ word movement
2457
2458 ;;; --------------------------------------------------- &word-movement ---
2459 ;;; #todo: Uhm; rewrite sometime.
2460 ;;;
2461 (defun tinymy-word-move-1 (&optional back)
2462   "Low level word movement control. Optionally move BACK."
2463   (let* ((up-case (memq major-mode tinymy-:move-word-case-modes))
2464          (regexp "[a-z0-9]*[A-Z]+[a-z0-9]+[A-Z]+")
2465          (case-fold-search (not up-case))
2466          (charset
2467           (cond
2468            ((and up-case
2469                  (or (if back
2470                          (save-excursion
2471                            (cond
2472                             ((not (eq 0 (skip-chars-backward "a-z")))
2473                              (let (case-fold-search)
2474                                (string-match
2475                                 "[A-Z]"
2476                                 (char-to-string (preceding-char)))))
2477                             ((not (eq 0 (skip-chars-backward " \t")))
2478                              (bolp))))
2479                        (looking-at regexp))
2480                      ;; Cursor is at the end of word
2481                      (and
2482                       (member (char-to-string (char-syntax (preceding-char)))
2483                               '("w" "."))
2484                       (not
2485                        (member (char-to-string (char-syntax (following-char)))
2486                                '("w" "."))))))
2487             ;;  This Upcase charset is only used if the cursor is
2488             ;;  within AnUpCaseWord.
2489             tinymy-:move-word-case-set)
2490            (t
2491             tinymy-:move-word-set))))
2492     (cond
2493      ;;  Skip to the end of word if at EOL
2494      ;;  (this-he-is-word sse-it-now?)
2495      ;;                          *     cursor here
2496      ;;                            *   after
2497      ;;  otherwise it would skip to next line's word begin.
2498      ((and (null back)
2499            (or (looking-at "\\([A-Z]+\\)[^a-zA-Z \t]*$")
2500                (looking-at "\\([a-z]+\\)[^a-zA-Z \t]*$")
2501                (looking-at "\\([A-Z][a-z]+\\)[^a-zA-Z \t]*$")))
2502       (goto-char (match-end 1)))
2503      (t
2504       (ti::buffer-word-move charset back)))))
2505
2506 ;;; ----------------------------------------------------------------------
2507 ;;;
2508 (defun tinymy-word-move-2 (&optional back)
2509   "If at whitespace, skip to next non-whitespace. Optionally BACK.
2510 Otherwise call `tinymy-word-move-1'."
2511   (when (and (looking-at "[ \t\f\r\n]")
2512              (not (ti::buffer-looking-at-one-space)))
2513     (cond
2514      (back
2515       (skip-chars-backward  " \t\f\r\n")
2516       (unless (bobp)
2517         (forward-char -1)))
2518      (t
2519       (skip-chars-forward  " \t\f\r\n"))))
2520   (tinymy-word-move-1 back))
2521
2522 ;;; ----------------------------------------------------------------------
2523 ;;;
2524 (defun tinymy-word-backward ()
2525   "Word backward See `tinymy-:move-word-case-set'."
2526   (interactive)
2527   (tinymy-word-move-2 'back))
2528
2529 ;;; ----------------------------------------------------------------------
2530 ;;;
2531 (defun tinymy-word-forward ()
2532   "Word forward. See `tinymy-:move-word-case-set'."
2533   (interactive)
2534   (tinymy-word-move-2))
2535
2536 ;;}}}
2537 ;;{{{ minor mode: sort
2538
2539 ;;;### (autoload 'turn-off-tinymy-sort-mode "tinymy" "" t)
2540 ;;;### (autoload 'turn-on-tinymy-sort-mode  "tinymy" "" t)
2541 ;;;### (autoload 'tinymy-sort-mode          "tinymy" "" t)
2542
2543 (add-hook 'tinymy-sort-:mode-define-keys-hook ;To be sure
2544           'tinymy-sort-mode-define-keys)
2545
2546 (eval-and-compile
2547
2548   (ti::macrof-minor-mode-wizard
2549    "tinymy-sort-" " S" "\C-cS" "Tsort" 'TinySort "tinymy-sort-:" ;1-6
2550
2551    "Minor mode for sorting lines (by columns) in the buffer easily.
2552 Remember to select region to sort.
2553
2554 When you sort by columns, the line must have enough columns, e.g.
2555 if you select following area and try to sort by clumn 3, that is
2556 not possible. Also, There must be no empty lines inside sorted area.
2557
2558     123 123 123
2559     123 123
2560     123 123 123
2561
2562 Mode description:
2563 \\{tinymy-sort-:mode-map}"
2564
2565    "TinySort"
2566
2567    nil
2568
2569    "Column sort minor mode"
2570
2571    (list
2572     tinymy-sort-:mode-easymenu-name
2573     ["By column 1"                 tinymy-sort-column-1  t]
2574     ["By column 2"                 tinymy-sort-column-2  t]
2575     ["By column 3"                 tinymy-sort-column-3  t]
2576     ["By column 4"                 tinymy-sort-column-4  t]
2577     ["By column 5"                 tinymy-sort-column-5  t]
2578     ["By column 6"                 tinymy-sort-column-6  t]
2579     ["By column 7"                 tinymy-sort-column-7  t]
2580     ["By column 8"                 tinymy-sort-column-8  t]
2581     ["By column 9"                 tinymy-sort-column-9  t])
2582    (progn
2583      (define-key map "1"  'tinymy-sort-mode-column-1)
2584      (define-key map "2"  'tinymy-sort-mode-column-2)
2585      (define-key map "3"  'tinymy-sort-mode-column-3)
2586      (define-key map "4"  'tinymy-sort-mode-column-4)
2587      (define-key map "5"  'tinymy-sort-mode-column-5)
2588      (define-key map "6"  'tinymy-sort-mode-column-6)
2589      (define-key map "7"  'tinymy-sort-mode-column-7)
2590      (define-key map "8"  'tinymy-sort-mode-column-8)
2591      (define-key map "9"  'tinymy-sort-mode-column-9)
2592      (define-key map "?"  'tinymy-sort-mode-help))))
2593
2594 ;; Create functions like this:
2595 ;;
2596 ;; (defun tinymy-sort-column-0 (beg end)
2597 ;;    (interactive "*r") (tinymy-sort-column beg end 0))
2598 (mapcar
2599  (function
2600   (lambda (x)
2601     (let ((sym (intern (format "tinymy-sort-mode-column-%d" x)))
2602           def)
2603       (setq def
2604             (` (defun (, sym) (beg end)
2605                  (interactive "*r")
2606                  (tinymy-sort-column beg end (, x) ))))
2607       (eval def))))
2608  '(1 2 3 4 5 6 7 8 9))
2609
2610 ;;; ----------------------------------------------------------------------
2611 ;;;
2612 (defun tinymy-sort-column (beg end nbr)
2613   "Sort region BEG END according to column NBR."
2614   (interactive "r\np")
2615   (let* ((opoint (point)))
2616     (untabify beg end)
2617     (goto-char (min beg end))           ;Sort breaks otherwise
2618     (sort-fields nbr beg end)
2619     (goto-char opoint)))
2620
2621 ;;}}}
2622 ;;{{{ alias definitions and others
2623
2624 (defun tinymy-alias ()
2625   "Install some aliases."
2626   ;;  Say always y-or-n-p; so that there is no need to type "yes" or "no"
2627   (defalias 'yes-or-no-p 'y-or-n-p))
2628
2629 ;;; ----------------------------------------------------------------------
2630 ;;; Idea by 1997-11-05 Kevin Rodgers gnu-emacs.help
2631 ;;;
2632 (defun tinymy-maybe-disable-auto-save ()
2633   "If the directory is read only, do not keep auto save files."
2634   (when (and (stringp buffer-file-name)
2635              (not (file-writable-p
2636                    (file-name-directory buffer-file-name))))
2637     (auto-save-mode nil)
2638     (set (make-variable-buffer-local 'auto-save-interval) 0)))
2639
2640 ;;; ----------------------------------------------------------------------
2641 ;;;
2642 (defun tinymy-find-file-hook ()
2643   "Activate DOS display table for dos files (in UNIX) ."
2644   (tinymy-maybe-disable-auto-save)
2645   ;; hook return value
2646   nil)
2647
2648 ;;}}}
2649
2650 (provide   'tinymy)
2651 (run-hooks 'tinymy-:load-hook)
2652
2653 ;;; tinymy.el ends here