emacs_el/tiny-tools/tiny/tinypage.el

   1 ;;; tinypage.el --- Handling ^L pages, select, cut, copy, head renumber.
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C)    1996-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 tinypage-version.
  13 ;; Look at the code with folding.el.
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;; ....................................................... &t-install ...
  38 ;;  Put this file on your Emacs-Lisp load path, add following into your
  39 ;;  ~/.emacs startup file
  40 ;;
  41 ;;      (require 'tinypage)
  42 ;;
  43 ;;  or use this; your .emacs loads quicker. Preferred.
  44 ;;
  45 ;;      (global-set-key "\C-cmp" 'tinypage-mode)   ;; "m" for minor modes
  46 ;;      (autoload 'tinypage-mode "tinypage" "" t)
  47 ;;
  48 ;;  If you make any changes to keybindings, always run command
  49 ;;
  50 ;;      M-x tinypage-mode-install
  51 ;;
  52 ;;  to see what this mode offers, look at the mode description
  53 ;;
  54 ;;      M-x tinypage-mode
  55 ;;      C-h m
  56 ;;
  57 ;;  If you have any questions, use this function
  58 ;;
  59 ;;      M-x tinypage-submit-bug-report       ,send bug report
  60 ;;
  61
  62 ;;}}}
  63
  64 ;;{{{ Documentation
  65
  66 ;; ..................................................... &t-commentary ...
  67 ;;; Commentary:
  68
  69 ;;  Preface, jun 1996
  70 ;;
  71 ;;      I had found paged.el by Michelangelo Grigni <mic@mathcs.emory.edu>
  72 ;;      one year or so ago and had liked it very much. Unfortunately
  73 ;;      it used narrowing and didn't offer easy page select, copy, cut
  74 ;;      actions which belong to basic page editing.
  75 ;;
  76 ;;      Paged.el has one nice feature: It can renumber pages and make summary
  77 ;;      out of them. If I have time I will include those features to
  78 ;;      package too.
  79 ;;
  80 ;;  Overview of features
  81 ;;
  82 ;;      o   Copy, cut, paste, yank (after/before current page) ^L pages.
  83 ;;      o   Show  page-nbr/page-count/page-size in modeline.
  84 ;;      o   Can renumber numbered header levels, where last level is indicated
  85 ;;          with number. Eg. "A.1 A.2"  or "1.2.1.1 "1.2.1.2"
  86 ;;      o   Shows popup in X to jump to headings
  87 ;;      o   Create table of contents.
  88 ;;
  89 ;;  About making pages -- basics
  90 ;;
  91 ;;      If you're totally unfamiliar to the concept of page: you make
  92 ;;      pages in emacs by adding the linefeed marker in the text, normally
  93 ;;      on its own line, just before your topics or headings.
  94 ;;
  95 ;;          C-q C-l  --> ^L
  96 ;;
  97 ;;      That inserts the ^L character in the buffer. That is where your
  98 ;;      page starts. The layout of your doc may look like this:
  99 ;;
 100 ;;         ^L
 101 ;;         1.0 Topic one
 102 ;;             txt txt txt txt txt txt txt txt
 103 ;;             txt txt txt txt txt txt txt txt
 104 ;;
 105 ;;         ^L
 106 ;;         1.1
 107 ;;              txt txt txt txt txt txt ..
 108 ;;
 109 ;;         ^L
 110 ;;         1.1.1.1
 111 ;;              txt txt txt txt txt txt txt txt
 112 ;;              txt txt txt txt txt txt txt ...
 113 ;;
 114 ;;
 115 ;;  About renumbering
 116 ;;
 117 ;;      This package offers simple renumbering features, but it
 118 ;;      won't do everything for you! Let's first tell what it won't
 119 ;;      do. Renumbering these is piece of cake:
 120 ;;
 121 ;;          1.1
 122 ;;          1.7.1.5             (1)
 123 ;;          1.5
 124 ;;          1.5.4.1             (2)
 125 ;;          1.5.4.5
 126 ;;          1.9
 127 ;;
 128 ;;      The result is
 129 ;;
 130 ;;          1.1
 131 ;;          1.7.1.5
 132 ;;          1.2
 133 ;;          1.5.4.1
 134 ;;          1.5.4.2
 135 ;;          1.3
 136 ;;
 137 ;;      tsk-tsk, before you say anything... It went all right.
 138 ;;      Now you see what it won't do for you.
 139 ;;
 140 ;;      .   It can't know that the 1.7.1.5 belongs under previous 1.1,
 141 ;;          because no back tracking is done. I won't even try!
 142 ;;          [write a separate package if you want that...I won't do it]
 143 ;;
 144 ;;      .   Same goes here, it can't know that the 1.5.4.1 should actually
 145 ;;          start from 1.5.1.1
 146 ;;
 147 ;;      The thumb rule is, that you _go_ and make sure all the _first_
 148 ;;      level headings (those that end to X.X.1.1) are right before doing
 149 ;;      renumbering. In the above case, you should have done these before
 150 ;;      calling M-x tinypage-renumber-forward.
 151 ;;
 152 ;;      .   --> 1.1.1.1
 153 ;;      .   --> 1.5.1.1  _AND_ do replace M-% 1.5.4 with 1.5.1
 154 ;;
 155 ;;      Then all the renumberin would have gone just fine.
 156 ;;      Little handy work and this package helps you to number your doc easily.
 157 ;;
 158 ;;
 159 ;;  Renumbering -- be cautious
 160 ;;
 161 ;;      If you have index section in you file, you have a little problem,
 162 ;;      because this package does not know nothing about such things.
 163 ;;      If the Index section is at the beginning, just go past it and
 164 ;;      use function:
 165 ;;
 166 ;;          M-x tinypage-renumber-forward
 167 ;;
 168 ;;      Using
 169 ;;
 170 ;;          M-x tinypage-renumber-buffer
 171 ;;
 172 ;;      Would be disaster. It can only be used for non-index buffers.
 173 ;;
 174 ;;  Creating index
 175 ;;
 176 ;;      After you have renumbered all, your old index section is useless,
 177 ;;      Just call function
 178 ;;
 179 ;;          M-x tinypage-toc
 180 ;;
 181 ;;      And copy the showed buffer in place of the old index.
 182 ;;
 183 ;;  Limitations
 184 ;;
 185 ;;      Since the numbering is done according to regexp, there is
 186 ;;      no way to avoid the following false hit:
 187 ;;
 188 ;;          1.1 Overview
 189 ;;          This is highly technical document concerning the latest
 190 ;;          NASA ultrawave reflective shield technique. You should
 191 ;;          refer to chapter:
 192 ;;
 193 ;;              1.5
 194 ;;
 195 ;;          Where the Daddy-Cool portable sondium emission detector is
 196 ;;          described in full...
 197 ;;
 198 ;;      The Number 1.5 is unfortunately renumbered to 1.2, and possibly
 199 ;;      causing headache in the NASA and in the spying countries...
 200 ;;      If you know elegant way to prevent these false hits, please
 201 ;;      drop me a mail. At this time I haven't much payed attention to this.
 202 ;;
 203 ;;  Code Note
 204 ;;
 205 ;;      The renumbering used here uses brute force, so the execution time
 206 ;;      is O(n2). If you have more that 30-40 sections, the renumbering
 207 ;;      might take 15-40 minutes. If you care to send me more pleasant
 208 ;;      numbering I'd be very gratefull and you're name would be carved to
 209 ;;      this module. For now, I'm just too lazy to change anything.
 210
 211 ;;}}}
 212
 213 ;;; Change Log:
 214
 215 ;;; Code:
 216
 217 ;;{{{ setup: require
 218
 219 (require 'tinylibm)
 220 (require 'easymenu)
 221
 222 (eval-and-compile
 223   (if (ti::xemacs-p)
 224       (or (load "overlay" 'noerr)
 225           (message "\n\
 226 tinypage: ** you need XEmacs overlay.el library.
 227           ** TinyPage may not work correctly without it."))))
 228
 229 (eval-when-compile (ti::package-use-dynamic-compilation))
 230
 231 (ti::package-defgroup-tiny TinyPage tinypage-: tools
 232   "Minor mode for Handling ^L delimeted text rerions (pages).
 233   Overview of features
 234         o   Copy, cut, paste, yank (after/before current page) ^L pages.
 235         o   Show  page-nbr/page-count/page-size in modeline.
 236         o   Can renumber numbered header levels, where last level is indicated
 237             with number. Eg. \"A.1 A.2\"  or \"1.2.1.1\" \"1.2.1.2\"
 238         o   Shows popup in X to jump to headings
 239         o   Create table of contents.")
 240
 241 ;;}}}
 242 ;;{{{ setup: private
 243
 244 (defcustom tinypage-:load-hook nil
 245   "*Hook that is run when package is loaded."
 246   :type 'hook
 247   :group 'TinyPage)
 248
 249 ;;}}}
 250 ;;{{{ setup: private variables
 251
 252 (defvar tinypage-:post-command-wakeup-counter nil
 253   "Updated by program.")
 254
 255 (make-variable-buffer-local 'tinypage-:post-command-wakeup-counter)
 256
 257 (defvar tinypage-:buffer-toc "*toc*"
 258   "Where to create index.")
 259
 260 ;;}}}
 261 ;;{{{ setup: public, user configurable
 262
 263 (defcustom tinypage-:register ?p
 264   "*Register used for clipboard."
 265   :type  'character
 266   :group 'TinyPage)
 267
 268 ;;; This is _not_ one char "^L", it is two chars "^" + "L"
 269
 270 (defcustom tinypage-:mode-name-string " ^L"
 271   "*Minor mode name. User variable."
 272   :type  'string
 273   :group 'TinyPage)
 274
 275 (defcustom tinypage-:post-command-wakeup-count 40
 276   "*How often to wake up to update modeline info.
 277 Don't put too low value, since it slows down Emacs."
 278   :type ' integer
 279   :group 'TinyPage)
 280
 281 (defcustom tinypage-:x-coord 170
 282   "*Default X menu coordinate."
 283   :type  'integer
 284   :group 'TinyPage)
 285
 286 (defcustom tinypage-:y-coord 170
 287   "*Default Y menu coordinate."
 288   :type  'integer
 289   :group 'TinyPage)
 290
 291 (defcustom tinypage-:x-popup-line-len 35
 292   "*Maximum line length in popup."
 293   :type  'integer
 294   :group 'TinyPage)
 295
 296 ;;  Do not change this ! Unless you know what you do...
 297
 298 (defcustom tinypage-:renumber-format
 299   '( "^[ \t]*\\([0-9.]+\\.\\)\\([0-9]+\\)"  1 2)
 300   "*Regexp for renumbered lines.
 301
 302 Format is
 303
 304     (REGEXP SAME-LEVEL RENUM-LEVEL),
 305
 306 where the match in RENUM-LEVEL match must return a valid number.
 307 Value SAME-LEVEL is examined only once and the _dots_ that is holds
 308 are counted. The dots tell which mail-level was picked.
 309 Eg, when renumbering the following, only the last number is incremented.
 310
 311     1.2 Section one is here, this is picked first and examined.
 312     1.2.1.1 This subsection is skipped, since it's not in the same level.
 313     1.3 This level will be picked.
 314
 315 There _must_ be dots in the matched level string, because the section
 316 level is calculated by counting the dots.  The following
 317 section numbers won't do:
 318
 319     1
 320     2"
 321   :type '(list
 322           (string :tag "Regexp")
 323           (integer :tag "Submatch in regexp")
 324           (integer :tag "Submatch in regexp"))
 325   :group 'TinyPage)
 326
 327 (defcustom tinypage-:modeline-function 'tinypage-update-mode-line
 328   "*The modeline function that keep it up to date whenever called."
 329   :type 'integer
 330   :group 'TinyPage)
 331
 332 ;;}}}
 333 ;;{{{ version
 334
 335 ;;;###autoload (autoload 'tinypage-version "tinypage" "Display commentary." t)
 336 (eval-and-compile
 337   (ti::macrof-version-bug-report
 338    "tinypage.el"
 339    "tinypage"
 340    tinypage-:version-id
 341    "$Id: tinypage.el,v 2.47 2007/05/07 10:50:08 jaalto Exp $"
 342    '(tinypage-:version-id
 343      map
 344      tinypage-:load-hook
 345      tinypage-:mode-define-keys-hook
 346      tinypage-:mode-hook
 347      tinypage-mode
 348      tinypage-:mode-name
 349      tinypage-:mode-menu
 350      tinypage-:buffer-toc
 351      tinypage-:register
 352      tinypage-:mode-name-string
 353      tinypage-:mode-menu-name
 354      tinypage-:mode-prefix-key
 355      tinypage-:post-command-wakeup-count
 356      tinypage-:x-coord
 357      tinypage-:y-coord
 358      tinypage-:x-popup-line-len
 359      tinypage-:modeline-function
 360      tinypage-:renumber-format
 361      tinypage-:post-command-wakeup-counter
 362      tinypage-:version-id)))
 363
 364 ;;}}}
 365 ;;{{{ Minor Mode
 366
 367 ;;;###autoload (autoload 'tinypage-mode          "tinypage" "" t)
 368 ;;;###autoload (autoload 'turn-on-tinypage-mode  "tinypage" "" t)
 369 ;;;###autoload (autoload 'turn-off-tinypage-mode "tinypage" "" t)
 370 ;;;###autoload (autoload 'tinypage-commentary    "tinypage" "" t)
 371
 372 (defvar tinypage-:mode-name " ^L"
 373   "Minor mode name. Changed by program. not user variable.")
 374
 375 (make-variable-buffer-local 'tinypage-:mode-name)
 376
 377 (eval-and-compile
 378
 379 ;;; Prefix keys is "\" by default: this one
 380 ;;; was nicely non-shifted and near HP-UX return key. You can Change it
 381 ;;; prior loading the package with (setq tinypage-:pref
 382
 383   (ti::macrof-minor-mode-wizard
 384    "tinypage-" " ^L" "\\" "Tpage" 'TinyPage "tinypage-:" ;1-6
 385
 386    "Paged minor mode. This mode allows you to handle ^L delimited
 387 region as page: you can e.g. cut, copy, and select it.
 388
 389 The page counter is _not_ updated all the time in the modeline, because
 390 it'd be too heavy task to monitor user constantly. Please use command
 391 \\[tinypage-modeline] if you want up to date information.
 392
 393 To adjust the user tracking threshold, modify value:
 394
 395   `tinypage-:post-command-wakeup-count'
 396
 397 Mode description:
 398
 399   \\{tinypage-:mode-prefix-map}"
 400
 401    "Paged ^L mode"
 402
 403    (progn
 404      ;; Make sure it's there...
 405      (or (assq 'tinypage-post-command post-command-hook)
 406          (add-hook 'post-command-hook 'tinypage-post-command))
 407      ;;  - We could leave the hook there because it's no-op if
 408      ;;    the mode variable is nil.
 409      ;;  - But i think if user looks at post-command-hook's contents
 410      ;;    to spot some problems, he appreciates if there is no extra
 411      ;;    functions in the hook -- only those that need to active
 412      ;;    in the current buffer/modes.
 413      (if (null tinypage-mode)
 414          (remove-hook 'post-command-hook 'tinypage-post-command)
 415        ;; Make sure it's there...
 416        (or (assq 'tinypage-post-command post-command-hook)
 417            (add-hook 'post-command-hook 'tinypage-post-command)))
 418      (tinypage-modeline)
 419      (ti::compat-modeline-update))
 420    "TinyPage menu"
 421    (list
 422     tinypage-:mode-easymenu-name
 423     ["Cut"                     tinypage-cut                            t]
 424     ["Copy"                    tinypage-copy                           t]
 425     ["Select"                  tinypage-select                         t]
 426     ["Yank"                    tinypage-yank                           t]
 427     ["Yank before page"        tinypage-yank-before                    t]
 428     ["Yank after page"         tinypage-yank-after                     t]
 429     "----"
 430     ["Renumber buffer"         tinypage-renumber-buffer                t]
 431     ["Renumber forward"        tinypage-renumber-forward               t]
 432     ["Renumber Level forward"  tinypage-renumber-level-forward         t]
 433     "----"
 434     ["Index"                   tinypage-toc                            t]
 435     ["Index occur"             tinypage-toc-occur                      t]
 436     ["Index popup"             tinypage-toc-x-popup                    t]
 437     "----"
 438     ["Update modeline info"    tinypage-modeline                       t]
 439     ["Previous heading"        tinypage-go-previous                    t]
 440     ["Next heading"            tinypage-go-next                        t]
 441     ["Scroll down"             scroll-down                             t]
 442     ["Scroll up"               scroll-up                               t]
 443     "----"
 444     ["Package version"         tinypage-version                        t]
 445     ["Package commentary"      tinypage-commentary                     t]
 446     ["Mode help"               tinypage-mode-help                      t]
 447     ["Mode off"                tinypage-mode                           t])
 448    (progn
 449      (define-key map  "?"  'tinypage-mode-off)
 450      (define-key map  "Hm" 'tinypage-mode-help)
 451      (define-key map  "Hc" 'tinypage-commentary)
 452      (define-key map  "Hv" 'tinypage-version)
 453      ;; These are the DOS standard keys, mimic them
 454      ;; Alt c  = copy
 455      ;; Alt t  = cut
 456      ;; Alt p  = paste
 457      (define-key   map  "c" 'tinypage-copy)
 458      (define-key   map  "t" 'tinypage-cut)
 459      (define-key   map  "p" 'tinypage-yank)
 460      (define-key   map  "s" 'tinypage-select)
 461      ;; ....................................................... yanking ...
 462      ;; Emacs users are more familiar with this
 463      (define-key   map  "y"  'tinypage-yank)
 464      ;;  Some handy paste commands. Moving pages around
 465      ;;  See the keyboads: < >       which mean before , after
 466      ;;  I don't want to use shift...
 467      (define-key   map  "," 'tinypage-yank-before)
 468      (define-key   map  "." 'tinypage-yank-after)
 469      ;; ..................................................... numbering ...
 470      ;; key "n" for numbering.
 471      (define-key   map  "nl"  'tinypage-renumber-level-forward)
 472      (define-key   map  "nf"  'tinypage-renumber-forward)
 473      (define-key   map  "nb"  'tinypage-renumber-buffer)
 474      ;; ......................................................... index ...
 475      ;; key "i" for indexing
 476      ;;  I didn't pick "x" for X-popup because it's too far away
 477      ;;  from the "i" key. The "p" for "popup" is much closer.
 478      (define-key   map  "ii"  'tinypage-toc)
 479      (define-key   map  "io"  'tinypage-toc-occur)
 480      (define-key   map  "ip"  'tinypage-toc-x-popup-keyboard)
 481      ;; ...................................................... events ...
 482      ;; Too bad the delete key is not standard, we have to define
 483      ;; many symbols
 484      (define-key   map [(delete)]       'tinypage-cut)
 485      (define-key   map [(del)]          'tinypage-cut)
 486      (define-key   map [(deletechar)]   'tinypage-cut)
 487      (define-key   map [(hpDeleteChar)] 'tinypage-cut)
 488      (define-key   map [(backspace)]    'tinypage-copy)
 489      (define-key   map [(insert)]       'tinypage-yank)
 490      (define-key   map [(insertchar)]   'tinypage-yank)
 491      (define-key   map [(hpInsertChar)] 'tinypage-yank)
 492      (if (ti::emacs-p)
 493          (define-key   map [(mouse-1)]   'tinypage-toc-x-popup)
 494        (define-key     map [(button1up)] 'tinypage-toc-x-popup))
 495      ;; .................................................... go, update ...
 496      (define-key   map  "u" 'tinypage-modeline)
 497      (define-key   map [(prior)]         'tinypage-go-previous)
 498      (define-key   map [(next)]          'tinypage-go-next)
 499      (define-key   map [(control prior)] 'scroll-down)
 500      (define-key   map [(control next)]   'scroll-up))))
 501
 502 ;;}}}
 503 ;;{{{ misc, engine funcs
 504
 505 ;;; ----------------------------------------------------------------------
 506 ;;;
 507 (defun tinypage-modeline ()
 508   "Update modeline information."
 509   (interactive)
 510   (funcall tinypage-:modeline-function))
 511
 512 ;;; ----------------------------------------------------------------------
 513 ;;;
 514 (defun tinypage-page-region (&optional verb)
 515   "Return region (BEG . END) of page. VERB."
 516   (interactive)
 517   (let* (beg
 518          end
 519          ret)
 520     (save-excursion
 521       (beginning-of-line)
 522       (if (looking-at "^[ \t]*\C-l")
 523           (setq beg (point))
 524         (setq beg (tinypage-go-next 'back)))
 525       (when (setq end (tinypage-go-next))
 526         (goto-char end)                 ;adjust point, do not take ^L
 527         (beginning-of-line)
 528         (setq end (point))))
 529     (if (and beg end)
 530         (setq ret (cons beg end))
 531       (if verb
 532           (message "Couldn't find region")))
 533     ret))
 534
 535 ;;; ----------------------------------------------------------------------
 536 ;;;
 537 (defun tinypage-count-pages ()
 538   "Count page characters ^L."
 539   (let* ((count 0))
 540     (save-excursion
 541       (ti::pmin)
 542       (while (re-search-forward "^[ \t]*\C-l" nil t)
 543         (incf  count)))
 544     count))
 545
 546 ;;; ----------------------------------------------------------------------
 547 ;;;
 548 (defun tinypage-count-lines-in-page ()
 549   "Count lines."
 550   (let* ((elt (tinypage-page-region))
 551          (beg (car-safe elt))
 552          (end (cdr-safe elt))
 553          ret)
 554     (when elt
 555       (setq ret (count-lines beg end)))
 556     ret))
 557
 558 ;;; ----------------------------------------------------------------------
 559 ;;;
 560 (defun tinypage-current-page ()
 561   "Current page."
 562   (interactive)
 563   (let* ((re    "^[ \t]*\C-l")
 564          (p     (point))
 565          (count 0))
 566     (save-excursion
 567       (ti::pmin)
 568       (while (re-search-forward re p t)
 569         (incf  count)))
 570     (if (looking-at re)
 571         (incf  count))
 572     count))
 573
 574 ;;; ----------------------------------------------------------------------
 575 ;;;
 576 (defun tinypage-update-mode-line ()
 577   "Update modeline info."
 578   (interactive)
 579   (let* ((mode-string  tinypage-:mode-name-string)
 580          pages
 581          now
 582          lines)
 583     (setq pages (tinypage-count-pages))
 584     (setq now   (tinypage-current-page))
 585     (setq lines (tinypage-count-lines-in-page))
 586     (setq tinypage-:mode-name
 587           (format  " %s %s/%s/%s" mode-string now pages (or lines "-")))))
 588
 589 ;;; ----------------------------------------------------------------------
 590 ;;;
 591 (defun tinypage-post-command ()
 592   "Keep page info in modeline up to date."
 593   (when tinypage-mode                   ;only now!
 594     (if (not (integerp tinypage-:post-command-wakeup-counter))
 595         (setq tinypage-:post-command-wakeup-counter 0))
 596     (incf  tinypage-:post-command-wakeup-counter)
 597
 598     (when (eq 0 (% tinypage-:post-command-wakeup-counter
 599                    tinypage-:post-command-wakeup-count))
 600       (tinypage-modeline))))
 601
 602 ;;; ----------------------------------------------------------------------
 603 ;;;
 604 (defun tinypage-overlay (act &optional beg end)
 605   "If ACT is 'hide, hide overlay, otherwise highlight BEG END."
 606   (let* ((ov (ti::compat-overlay-some)))
 607     (cond
 608      ((eq act 'hide)
 609       (ti::compat-overlay-move ov 1 1))
 610      (t
 611       (ti::compat-overlay-move ov beg end)
 612       (setq ov (symbol-value ov))
 613       (push-mark
 614        (if (ti::emacs-p)
 615            (ti::funcall 'overlay-start ov)
 616          (ti::funcall 'extent-start-position ov))
 617        t t)
 618       (push-mark
 619        (if (ti::emacs-p)
 620            (ti::funcall 'overlay-end ov)
 621          (ti::funcall 'extent-end-position ov))
 622        t t)
 623       (setq this-command 'set-mark)))))
 624
 625 ;;; ----------------------------------------------------------------------
 626 ;;;
 627 (defun tinypage-page-mark-region (beg end &optional act maybe)
 628   "Mark region and do some command act.
 629
 630 Input:
 631
 632   BEG           region beg
 633   END           region end
 634   ACT           action name, default is 'copy. Can be also 'cut 'select
 635   MAYBE         flag to check is BEG END are valid: if not then do
 636                 nothing. If vallid; then select and do ACT.
 637
 638 References:
 639
 640   `tinypage-:register'
 641
 642 Return:
 643
 644   t             if successfull
 645   nil"
 646   (let* ((doit (if maybe
 647                    (and beg end)
 648                  t))
 649          (reg tinypage-:register))
 650     (cond
 651      ((null doit)
 652       nil)
 653      (t
 654       (tinypage-overlay 'show beg end)
 655       (cond
 656        ((eq 'cut act)
 657         (delete-region beg end)
 658         (goto-char beg))
 659        ((memq act '(nil copy))
 660         (set-register
 661          reg
 662          (ti::remove-properties (buffer-substring beg end)))))
 663       ;;  something done
 664       t))))
 665
 666 ;;}}}
 667 ;;{{{ application functions
 668
 669 ;;; ----------------------------------------------------------------------
 670 ;;;
 671 (defun tinypage-renumber-level-forward (&optional verb)
 672   "Renumber current level starting from current line. VERB.
 673 Only the last level number is incremented. Put cursor line above
 674 the level and call this function
 675
 676     1.2
 677     *               <-- cursor here and it'll renumber level 1.2.1.x
 678     1.2.1.1
 679
 680 References:
 681
 682   `tinypage-:renumber-format'"
 683   (interactive "P")
 684   (let* ((data   tinypage-:renumber-format)
 685          (re     (nth 0 data))
 686          (lev1   (nth 1 data))
 687          (lev2   (nth 2 data))
 688          nbr
 689          counter
 690          dots-exact
 691          dots
 692          level-string
 693          orig-level-string)
 694     (ti::verb)
 695     (save-excursion
 696       (while (re-search-forward re nil t)
 697         (setq level-string (match-string lev1))
 698         (when level-string
 699           (setq dots (count-char-in-string ?. level-string)))
 700         (when (and (null dots-exact)    ;do only once
 701                    dots)
 702           (setq dots-exact              dots
 703                 orig-level-string       level-string))
 704         (when (and dots-exact
 705                    (eq dots-exact dots) ;only same level accepted
 706                    ;;  Must have same beginning "1.2.1.1" "1.2.1.x"
 707                    ;;
 708                    (string= orig-level-string level-string)
 709                    (setq nbr (match-string lev2)))
 710           (if (null counter)            ;first value ?
 711               (setq counter (string-to-int nbr))
 712             (incf  counter)
 713             ;;  Replace the last number with the right increment
 714             (ti::replace-match lev2 (int-to-string counter))))))
 715     (when verb
 716       (cond
 717        ((null counter)
 718         (message "No matches."))
 719        (t
 720         (message "Last heading was %s%s" orig-level-string counter))))
 721     counter))
 722
 723 ;;; ----------------------------------------------------------------------
 724 ;;;
 725 (defun tinypage-renumber-forward (&optional verb)
 726   "Renumber all found headings forward. VERB."
 727   (interactive "P")
 728   (let* ((data   tinypage-:renumber-format)
 729          (re     (nth 0 data)))
 730     (ti::verb)
 731     ;; Well, we do lot of extra work here, because the
 732     ;; tinypage-renumber-level-forward goes alway to the bottom,
 733     ;; but what the heck... it won't take long.
 734     ;;
 735     ;; And code is much cleaner this way.
 736     (if verb
 737         (message "Renumbering..."))
 738     (while (re-search-forward re nil t)
 739       (beginning-of-line)
 740       (tinypage-renumber-level-forward)
 741       (forward-line 1))
 742     (if verb
 743         (message "Renumbering...done"))))
 744
 745 ;;; ----------------------------------------------------------------------
 746 ;;;
 747 (defun tinypage-renumber-buffer ()
 748   "Renumber all headings in buffer starting from `point-min'."
 749   (interactive)
 750   (save-excursion
 751     (ti::pmin)
 752     (tinypage-renumber-forward 'verb)))
 753
 754 ;;; ----------------------------------------------------------------------
 755 ;;;
 756 (defsubst tinypage-get-index-list ()
 757   "Return list of strings."
 758   (let* ((list (ti::buffer-grep-lines (nth 0 tinypage-:renumber-format)))
 759          ret)
 760     (dolist (elt list)
 761       (push (ti::string-remove-whitespace elt) ret))
 762     ret))
 763
 764 ;;; ----------------------------------------------------------------------
 765 ;;;
 766 (defun tinypage-toc (&optional ragged no-show)
 767   "Create toc to temporary buffer.
 768 Optional argument RAGGED makes the heading to 'hang'.
 769 With nil RAGGED, the headings are lined up.
 770
 771 NO-SHOW doesn't show buffer after creating table of content.
 772
 773 Return:
 774   buffer"
 775   (interactive "P")
 776   (let* ((list          (ti::buffer-grep-lines (nth 0 tinypage-:renumber-format)))
 777          (buffer        (ti::temp-buffer tinypage-:buffer-toc 'clear))
 778          dots
 779          padd
 780          heading
 781          text)
 782     (with-current-buffer buffer
 783       (dolist (elt list)
 784         (setq elt (ti::string-remove-whitespace elt))
 785         (setq heading (ti::string-match "^[^ \t]+" 0 elt))
 786         (setq text    (or (ti::string-match "^[^ \t]+[ \t]+\\(.*\\)" 1 elt)
 787                           "<no heading found>"))
 788         ;; How to indent this line
 789         (setq dots (count-char-in-string ?. heading))
 790         (if (<= dots 1)
 791             (setq padd "")
 792           (setq padd (make-string (* 2 (- dots 2)) ?\  )))
 793         ;;  Separate 1.0  topics
 794         (if (string-match "0$" heading)
 795             (insert "\n"))
 796         (setq heading (concat padd heading))
 797         (if ragged
 798             (insert heading "    " text "\n")
 799           (insert (format "%s %s\n" heading text)))))
 800     (unless no-show
 801       ;; Display it, but do not select/go to it.
 802       ;;
 803       (display-buffer buffer)
 804       (ti::save-excursion-macro
 805         (select-window (get-buffer-window buffer))
 806         (shrink-window-if-larger-than-buffer)))
 807     buffer))
 808
 809 ;;; ----------------------------------------------------------------------
 810 ;;;
 811 (defun tinypage-toc-x-popup-keyboard ()
 812   "Create index. Show it in X-popup."
 813   (interactive)
 814   (tinypage-toc-x-popup
 815    (ti::compat-make-fake-event tinypage-:x-coord tinypage-:y-coord)))
 816
 817 ;;; ----------------------------------------------------------------------
 818 ;;;
 819 (defun tinypage-toc-x-popup (event)
 820   "Create index. Show it in X-popup with EVENT."
 821   (interactive "e")
 822   (let* ((len    tinypage-:x-popup-line-len)
 823          (title  "Index")
 824          list
 825          val
 826          point)
 827     (cond
 828      ((null (ti::compat-window-system))
 829       (message "Sorry, Requires X to use X-popup"))
 830      (t
 831       (setq list (tinypage-get-index-list))
 832       (setq list (mapcar
 833                   (function
 834                    (lambda (x)
 835                      (ti::string-left x len)))
 836                   list))
 837       (when (setq val (ti::compat-popup list event nil title))
 838         ;;  See if we can find the heading...
 839         (ti::save-excursion-macro
 840           (ti::pmin)
 841           (if (re-search-forward (regexp-quote val) nil t)
 842               (setq point (line-beginning-position))
 843             (message "Cannot find heading..."))))
 844       (if point
 845           (goto-char point))))))
 846
 847 ;;; ----------------------------------------------------------------------
 848 ;;;
 849 (defun tinypage-toc-occur ()
 850   "Create occur buffer for jumpig to Headings easily."
 851   (interactive)
 852   (occur (nth 0 tinypage-:renumber-format)))
 853
 854 ;;}}}
 855 ;;{{{ interactive funcs
 856
 857 ;;; ----------------------------------------------------------------------
 858 ;;;
 859 ;;;###autoload
 860 (defun tinypage-region-action (act &optional verb)
 861   "Execute action ACT. Return t or nil. VERB."
 862   (let* ((elt   (tinypage-page-region verb))
 863          (beg   (car-safe elt))
 864          (end   (cdr-safe elt)))
 865     (ti::verb)
 866     (tinypage-page-mark-region beg end act 'maybe)))
 867
 868 ;;; ----------------------------------------------------------------------
 869 ;;;
 870 ;;;###autoload
 871 (defun tinypage-select (&optional verb)
 872   "Select page. If sitting on page Marker, use page below. VERB."
 873   (interactive "P")
 874   (ti::verb)
 875   (and (tinypage-region-action 'select verb)
 876        (if verb
 877            (message "Page selected."))))
 878
 879 ;;; ----------------------------------------------------------------------
 880 ;;;
 881 ;;;###autoload
 882 (defun tinypage-copy (&optional verb)
 883   "Select page. If sitting on page Marker, use page below. VERB."
 884   (interactive "P")
 885   (ti::verb)
 886   (and (tinypage-region-action 'copy verb)
 887        (if verb
 888            (message "Page copied."))))
 889
 890 ;;; ----------------------------------------------------------------------
 891 ;;;
 892 ;;;###autoload
 893 (defun tinypage-cut (&optional verb)
 894   "Select page. If sitting on page Marker, use page below. VERB."
 895   (interactive "P")
 896   (ti::verb)
 897   (tinypage-region-action 'cut verb))
 898
 899 ;;; ----------------------------------------------------------------------
 900 ;;;
 901 ;;;###autoload
 902 (defun tinypage-yank (&optional verb)
 903   "Yank page from register. VERB."
 904   (interactive "P")
 905   (insert-register tinypage-:register)
 906   (tinypage-overlay 'hide))
 907
 908 ;;; ----------------------------------------------------------------------
 909 ;;;
 910 ;;;###autoload
 911 (defun tinypage-yank-before (&optional verb)
 912   "Yank page from register, but _before_ current page. VERB."
 913   (interactive)
 914   (ti::verb)
 915   (tinypage-yank-after 'before "Yanked before this page." verb))
 916
 917 ;;; ----------------------------------------------------------------------
 918 ;;;
 919 ;;;###autoload
 920 (defun tinypage-yank-after (&optional before msg verb)
 921   "Yank page from register, but _after_ current page.
 922 Optionally BEFORE with MSG and VERB."
 923   (interactive)
 924   (let* ((msg   (or msg  "Yanked after this page.")))
 925     (ti::verb)
 926     (ti::save-with-marker-macro
 927       (when (tinypage-go-next before verb)
 928         (insert-register tinypage-:register)
 929         (tinypage-overlay 'hide)
 930         (if (and verb msg)
 931             (message msg))))))
 932
 933 ;;; ----------------------------------------------------------------------
 934 ;;;
 935 ;;;###autoload
 936 (defun tinypage-go-previous (&optional verb)
 937   "Go to previous page. VERB."
 938   (interactive)
 939   (ti::verb)
 940   (tinypage-go-next  'back verb))
 941
 942 ;;; ----------------------------------------------------------------------
 943 ;;;
 944 ;;;###autoload
 945 (defun tinypage-go-next (&optional back verb)
 946   "Go to next page, optionally BACK. Return point if moved. VERB."
 947   (interactive)
 948   (let* ((point (point))
 949          func
 950          ret)
 951     (ti::verb)
 952     (cond
 953      (back
 954       (setq func 're-search-backward)
 955       (beginning-of-line))
 956      (t
 957       (setq func 're-search-forward)
 958       (end-of-line)))
 959     (unless (setq ret (funcall func "\C-l" nil t))
 960       (goto-char point))
 961     (if verb
 962         (tinypage-modeline))
 963     (if (and verb (null ret))
 964         (message "No more page marks."))
 965     ret))
 966
 967 ;;}}}
 968
 969 (add-hook 'tinypage-:mode-define-keys-hook 'tinypage-mode-define-keys)
 970
 971 (provide   'tinypage)
 972 (run-hooks 'tinypage-:load-hook)
 973
 974 ;;; tinypage.el ends here