| 1 | ;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode |
| 2 | |
| 3 | ;; Copyright (C) 1994 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Kevin Broadey <KevinB@bartley.demon.co.uk> |
| 6 | ;; Created: 27 Jan 1994 |
| 7 | ;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12 |
| 8 | ;; Keywords: folding, outlines |
| 9 | |
| 10 | ;; This file is part of GNU Emacs. |
| 11 | |
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 13 | ;; it under the terms of the GNU General Public License as published by |
| 14 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 15 | ;; any later version. |
| 16 | |
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 20 | ;; GNU General Public License for more details. |
| 21 | |
| 22 | ;; You should have received a copy of the GNU General Public License |
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 25 | ;; Boston, MA 02111-1307, USA. |
| 26 | |
| 27 | ;;; Commentary: |
| 28 | |
| 29 | ;; This file provides folding editor extensions for outline-mode and |
| 30 | ;; outline-minor-mode buffers. What's a "folding editor"? Read on... |
| 31 | ;; |
| 32 | ;; Imagine you're in an outline-mode buffer and you've hidden all the text and |
| 33 | ;; subheadings under your level-1 headings. You now want to look at the stuff |
| 34 | ;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry) |
| 35 | ;; to expose the body or C-c C-i to expose the child (level-2) headings. |
| 36 | ;; |
| 37 | ;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body |
| 38 | ;; and child subheadings and narrows the buffer so that only the level-1 |
| 39 | ;; heading, the body and the level-2 headings are visible. If you now want to |
| 40 | ;; look under one of the level-2 headings, position the cursor on it and do C-c |
| 41 | ;; C-z again. This exposes the level-2 body and its level-3 child subheadings |
| 42 | ;; and narrows the buffer again. You can keep on zooming in on successive |
| 43 | ;; subheadings as much as you like. A string in the modeline tells you how |
| 44 | ;; deep you've gone. |
| 45 | ;; |
| 46 | ;; When zooming in on a heading you might only want to see the child |
| 47 | ;; subheadings. You do this by specifying a numeric argument: C-u C-c C-z. |
| 48 | ;; You can specify the number of levels of children too (c.f. show-children): |
| 49 | ;; e.g. M-2 C-c C-z exposes two levels of child subheadings. Alternatively, |
| 50 | ;; you might only be interested in the body. You do this by specifying a |
| 51 | ;; negative argument: M-- C-c C-z. You can also cause the whole subtree to be |
| 52 | ;; expanded, similar to C-c C-s (show-subtree), by specifying a zero argument: |
| 53 | ;; M-0 C-c C-z. |
| 54 | ;; |
| 55 | ;; While you're zoomed in you can still use outline-mode's exposure and hiding |
| 56 | ;; functions. It won't upset foldout at all. Also, since the buffer is |
| 57 | ;; narrowed, "global" editing actions will only affect the stuff under the |
| 58 | ;; zoomed-in heading. This is useful for restricting changes to a particular |
| 59 | ;; chapter or section of your document. |
| 60 | ;; |
| 61 | ;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides |
| 62 | ;; all the text and subheadings under the top-level heading and returns you to |
| 63 | ;; the previous view of the buffer. Specifying a numeric argument exits that |
| 64 | ;; many folds. Specifying a zero argument exits *all* folds. |
| 65 | ;; |
| 66 | ;; You might want to exit a fold *without* hiding the text and subheadings. |
| 67 | ;; You do this by specifying a negative argument. For example, M--2 C-c C-x |
| 68 | ;; exits two folds and leaves the text and subheadings exposed. |
| 69 | ;; |
| 70 | ;; Foldout also provides mouse bindings for entering and exiting folds and for |
| 71 | ;; showing and hiding text. Hold down Meta and Control, then click a mouse |
| 72 | ;; button as follows:- |
| 73 | ;; |
| 74 | ;; mouse-1 (foldout-mouse-zoom) zooms in on the heading clicked on:- |
| 75 | ;; |
| 76 | ;; single click expose body |
| 77 | ;; double click expose subheadings |
| 78 | ;; triple click expose body and subheadings |
| 79 | ;; quad click expose entire subtree |
| 80 | ;; |
| 81 | ;; mouse-2 (foldout-mouse-show) exposes text under the heading clicked on:- |
| 82 | ;; |
| 83 | ;; single click expose body |
| 84 | ;; double click expose subheadings |
| 85 | ;; triple click expose body and subheadings |
| 86 | ;; quad click expose entire subtree |
| 87 | ;; |
| 88 | ;; mouse-3 (foldout-mouse-hide-or-exit) hides text under the heading clicked |
| 89 | ;; on or exits the fold:- |
| 90 | ;; |
| 91 | ;; single click hide subtree |
| 92 | ;; double click exit fold and hide text |
| 93 | ;; triple click exit fold without hiding text |
| 94 | ;; quad click exit all folds and hide text |
| 95 | ;; |
| 96 | ;; You can change the modifier keys used by setting `foldout-mouse-modifiers'. |
| 97 | |
| 98 | ;;; Installation: |
| 99 | |
| 100 | ;; To use foldout, put this in your .emacs:- |
| 101 | ;; |
| 102 | ;; (require 'foldout) |
| 103 | ;; |
| 104 | ;; If you don't want it loaded until you need it, try this instead:- |
| 105 | ;; |
| 106 | ;; (eval-after-load "outline" '(require 'foldout)) |
| 107 | |
| 108 | ;;; Advertisements: |
| 109 | |
| 110 | ;; Get out-xtra.el by Per Abrahamsen <abraham@iesd.auc.dk> for more |
| 111 | ;; outline-mode goodies. In particular, `outline-hide-sublevels' makes |
| 112 | ;; setup a lot easier. |
| 113 | ;; |
| 114 | ;; folding.el by Jamie Lokier <u90jl@ecs.ox.ac.uk> supports folding by |
| 115 | ;; recognising special marker text in you file. |
| 116 | ;; |
| 117 | ;; c-outline.el (by me) provides outline-mode support to recognise `C' |
| 118 | ;; statements as outline headings, so with foldout you can have a folding `C' |
| 119 | ;; code editor without having to put in start- and end-of-fold markers. This |
| 120 | ;; is a real winner! |
| 121 | |
| 122 | ;;; ChangeLog: |
| 123 | |
| 124 | ;; 1.10 21-Mar-94 |
| 125 | ;; foldout.el is now part of the GNU Emacs distribution!! |
| 126 | ;; Put in changes made by RMS to version 1.8 to keep the diffs to a minimum. |
| 127 | ;; bugfix: numeric arg to foldout-exit-fold wasn't working - looks like I don't |
| 128 | ;; know how to use the Common LISP `loop' macro after all, so use `while' |
| 129 | ;; instead. |
| 130 | |
| 131 | ;; 1.9 15-Mar-94 |
| 132 | ;; Didn't test that very well, did I? The change to foldout-zoom-subtree |
| 133 | ;; affected foldout-mouse-zoom: if the heading under the `level n' one clicked |
| 134 | ;; on was at `level n+2' then it didn't get exposed. Sorry about that! |
| 135 | |
| 136 | ;; 1.8 15-Mar-94 |
| 137 | ;; Changed meaning of prefix arg to foldout-zoom-subtree. arg > 0 now means |
| 138 | ;; "expose that many children" instead of just "expose children" so it is more |
| 139 | ;; like `show-children' (C-c C-i). Arg of C-u on its own only shows one level |
| 140 | ;; of children, though, so you can still zoom by doing C-u C-c C-z. |
| 141 | ;; |
| 142 | ;; I can't think of a good meaning for the value of a negative prefix. Any |
| 143 | ;; suggestions? |
| 144 | ;; |
| 145 | ;; Added advertisement for my c-outline.el package. Now you can have a folding |
| 146 | ;; editor for c-mode without any effort! |
| 147 | |
| 148 | ;; 1.7 7-Mar-94 |
| 149 | ;; I got fed up trying to work out how many blank lines there were outside the |
| 150 | ;; narrowed region when inside a fold. Now *all* newlines before the following |
| 151 | ;; heading are *in* the narrowed region. Thus, if the cursor is at point-max, |
| 152 | ;; the number of blank lines above it is the number you'll get above the next |
| 153 | ;; heading. |
| 154 | ;; |
| 155 | ;; Since all newlines are now inside the narrowed region, when exiting a fold |
| 156 | ;; add a newline at the end of the region if there isn't one so that the |
| 157 | ;; following heading doesn't accidentally get joined to the body text. |
| 158 | ;; |
| 159 | ;; Bugfix: `foldout-mouse-modifiers' should be `defvar', not `defconst'. |
| 160 | ;; |
| 161 | ;; Use "cond" instead of "case" so that lemacs-19.9 users can use the mouse. |
| 162 | ;; |
| 163 | ;; Improve "Commentary" entry on using the mouse. |
| 164 | ;; |
| 165 | ;; Add "Installation" keyword. |
| 166 | |
| 167 | ;; 1.6 3-Mar-94 |
| 168 | ;; Add mouse support functions foldout-mouse-zoom, foldout-mouse-show, |
| 169 | ;; foldout-mouse-hide-or-exit. |
| 170 | |
| 171 | ;; 1.5 11-Feb-94 |
| 172 | ;; Rename `foldout-enter-subtree' to `foldout-zoom-subtree' and change |
| 173 | ;; keystroke from C-g to C-z. This is more mnemonic and leaves C-g alone, as |
| 174 | ;; users expect this to cancel the current key sequence. |
| 175 | ;; |
| 176 | ;; Added better commentary at the request of RMS. Added stuff to comply with |
| 177 | ;; the lisp-mnt.el conventions. Added instructions on how best to load the |
| 178 | ;; package. |
| 179 | |
| 180 | ;; 1.4 2-Feb-94 |
| 181 | ;; Bugfix: end-of-fold marking was wrong:- |
| 182 | ;; |
| 183 | ;; End of narrowed region should be one character on from |
| 184 | ;; (outline-end-of-subtree) so it includes the end-of-line at the end of the |
| 185 | ;; last line of the subtree. |
| 186 | ;; |
| 187 | ;; End-of-fold marker should be outside the narrowed region so text inserted |
| 188 | ;; at the end of the region goes before the marker. Need to make a special |
| 189 | ;; case for end-of-buffer because it is impossible to set a marker that will |
| 190 | ;; follow eob. Bummer. |
| 191 | |
| 192 | ;; 1.3 28-Jan-94 |
| 193 | ;; Changed `foldout-zoom-subtree'. A zero arg now makes it expose the entire |
| 194 | ;; subtree on entering the fold. As before, < 0 shows only the body and > 0 |
| 195 | ;; shows only the subheadings. |
| 196 | |
| 197 | ;; 1.2 28-Jan-94 |
| 198 | ;; Fixed a dumb bug - didn't make `foldout-modeline-string' buffer-local :-( |
| 199 | ;; |
| 200 | ;; Changed `foldout-exit-fold' to use prefix arg to say how many folds to exit. |
| 201 | ;; Negative arg means exit but don't hide text. Zero arg means exit all folds. |
| 202 | ;; |
| 203 | ;; Added `foldout-inhibit-key-bindings' to inhibit key bindings. |
| 204 | |
| 205 | ;; 1.1 27-Jan-94 |
| 206 | ;; Released to the net. Inspired by a question in gnu.emacs.help from |
| 207 | ;; Jason D Lohn <jlohn@eng.umd.edu>. |
| 208 | |
| 209 | ;;; Code: |
| 210 | |
| 211 | (require 'outline) |
| 212 | |
| 213 | ;; something has gone very wrong if outline-minor-mode isn't bound now. |
| 214 | (if (not (boundp 'outline-minor-mode)) |
| 215 | (error "Can't find outline-minor-mode")) |
| 216 | |
| 217 | (defvar foldout-fold-list nil |
| 218 | "List of start and end markers for the folds currently entered. |
| 219 | An end marker of nil means the fold ends after (point-max).") |
| 220 | (make-variable-buffer-local 'foldout-fold-list) |
| 221 | |
| 222 | (defvar foldout-modeline-string nil |
| 223 | "Modeline string announcing that we are in an outline fold.") |
| 224 | (make-variable-buffer-local 'foldout-modeline-string) |
| 225 | |
| 226 | ;; put our minor mode string immediately following outline-minor-mode's |
| 227 | (or (assq 'foldout-modeline-string minor-mode-alist) |
| 228 | (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist) |
| 229 | minor-mode-alist)) |
| 230 | (foldout-entry '((foldout-modeline-string foldout-modeline-string)))) |
| 231 | |
| 232 | ;; something's wrong with outline if we can't find it |
| 233 | (if (null outl-entry) |
| 234 | (error "Can't find outline-minor-mode in minor-mode-alist")) |
| 235 | |
| 236 | ;; slip our fold announcement into the list |
| 237 | (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) |
| 238 | )) |
| 239 | |
| 240 | ;; outline-flag-region has different `flag' values in outline.el and |
| 241 | ;; noutline.el for hiding and showing text. |
| 242 | |
| 243 | (defconst foldout-hide-flag |
| 244 | (if (featurep 'noutline) t ?\^M)) |
| 245 | |
| 246 | (defconst foldout-show-flag |
| 247 | (if (featurep 'noutline) nil ?\n)) |
| 248 | \f |
| 249 | |
| 250 | (defun foldout-zoom-subtree (&optional exposure) |
| 251 | "Open the subtree under the current heading and narrow to it. |
| 252 | |
| 253 | Normally the body and the immediate subheadings are exposed, but |
| 254 | optional arg EXPOSURE \(interactively with prefix arg\) changes this:- |
| 255 | |
| 256 | EXPOSURE > 0 exposes n levels of subheadings (c.f. show-children) |
| 257 | EXPOSURE < 0 exposes only the body |
| 258 | EXPOSURE = 0 exposes the entire subtree" |
| 259 | (interactive "P") |
| 260 | (save-excursion |
| 261 | (widen) |
| 262 | (outline-back-to-heading) |
| 263 | (let* ((exposure-value (prefix-numeric-value exposure)) |
| 264 | (start (point)) |
| 265 | (start-marker (point-marker)) |
| 266 | (end (progn (outline-end-of-subtree) |
| 267 | (skip-chars-forward "\n\^M") |
| 268 | (point))) |
| 269 | ;; I need a marker that will follow the end of the region even when |
| 270 | ;; text is inserted right at the end. Text gets inserted *after* |
| 271 | ;; markers, so I need it at end+1. Unfortunately I can't set a |
| 272 | ;; marker at (point-max)+1, so I use nil to mean the region ends at |
| 273 | ;; (point-max). |
| 274 | (end-marker (if (eobp) nil (set-marker (make-marker) (1+ end)))) |
| 275 | ) |
| 276 | |
| 277 | ;; narrow to this subtree |
| 278 | (narrow-to-region start end) |
| 279 | |
| 280 | ;; show the body and/or subheadings for this heading |
| 281 | (goto-char start) |
| 282 | (cond |
| 283 | ((null exposure) |
| 284 | (show-entry) |
| 285 | (show-children)) |
| 286 | ((< exposure-value 0) |
| 287 | (show-entry)) |
| 288 | ((consp exposure) |
| 289 | (show-children)) |
| 290 | ((> exposure-value 0) |
| 291 | (show-children exposure-value)) |
| 292 | (t |
| 293 | (show-subtree)) |
| 294 | ) |
| 295 | |
| 296 | ;; save the location of the fold we are entering |
| 297 | (setq foldout-fold-list (cons (cons start-marker end-marker) |
| 298 | foldout-fold-list)) |
| 299 | |
| 300 | ;; update the modeline |
| 301 | (foldout-update-modeline) |
| 302 | ))) |
| 303 | \f |
| 304 | |
| 305 | (defun foldout-exit-fold (&optional num-folds) |
| 306 | "Return to the ARG'th enclosing fold view. With ARG = 0 exit all folds. |
| 307 | |
| 308 | Normally causes exited folds to be hidden, but with ARG < 0, -ARG folds are |
| 309 | exited and text is left visible." |
| 310 | (interactive "p") |
| 311 | (let (start-marker end-marker (hide-fold t)) |
| 312 | |
| 313 | ;; check there are some folds to leave |
| 314 | (if (null foldout-fold-list) |
| 315 | (error "Not in a fold!")) |
| 316 | |
| 317 | (cond |
| 318 | ;; catch a request to leave all folds |
| 319 | ((zerop num-folds) |
| 320 | (setq num-folds (length foldout-fold-list))) |
| 321 | |
| 322 | ;; have we been told not to hide the fold? |
| 323 | ((< num-folds 0) |
| 324 | (setq hide-fold nil |
| 325 | num-folds (- num-folds))) |
| 326 | ) |
| 327 | |
| 328 | ;; limit the number of folds if we've been told to exit too many |
| 329 | (setq num-folds (min num-folds (length foldout-fold-list))) |
| 330 | |
| 331 | ;; exit the folds |
| 332 | (widen) |
| 333 | (while (not (zerop num-folds)) |
| 334 | ;; get the fold at the top of the stack |
| 335 | (setq start-marker (car (car foldout-fold-list)) |
| 336 | end-marker (cdr (car foldout-fold-list)) |
| 337 | foldout-fold-list (cdr foldout-fold-list) |
| 338 | num-folds (1- num-folds)) |
| 339 | |
| 340 | ;; Make sure there is a newline at the end of this fold, |
| 341 | ;; otherwise the following heading will get joined to the body |
| 342 | ;; text. |
| 343 | (if end-marker |
| 344 | (progn |
| 345 | (goto-char end-marker) |
| 346 | (forward-char -1) |
| 347 | (or (memq (preceding-char) '(?\n ?\^M)) |
| 348 | (insert ?\n)))) |
| 349 | |
| 350 | ;; If this is the last fold to exit, hide the text unless we've |
| 351 | ;; been told not to. Note that at the moment point is at the |
| 352 | ;; beginning of the following heading if there is one. |
| 353 | |
| 354 | ;; Also, make sure that the newline before the following heading |
| 355 | ;; is \n otherwise it will be hidden. If there is a newline |
| 356 | ;; before this one, make it visible too so we do the same as |
| 357 | ;; outline.el and leave a blank line before the heading. |
| 358 | (if (zerop num-folds) |
| 359 | (let ((beginning-of-heading (point)) |
| 360 | (end-of-subtree (if end-marker |
| 361 | (progn |
| 362 | (forward-char -1) |
| 363 | (if (memq (preceding-char) |
| 364 | '(?\n ?\^M)) |
| 365 | (forward-char -1)) |
| 366 | (point)) |
| 367 | (point-max)))) |
| 368 | ;; hide the subtree |
| 369 | (if hide-fold |
| 370 | (outline-flag-region start-marker end-of-subtree |
| 371 | foldout-hide-flag)) |
| 372 | |
| 373 | ;; make sure the next heading is exposed |
| 374 | (if end-marker |
| 375 | (outline-flag-region end-of-subtree beginning-of-heading |
| 376 | foldout-show-flag)) |
| 377 | )) |
| 378 | |
| 379 | ;; zap the markers so they don't slow down editing |
| 380 | (set-marker start-marker nil) |
| 381 | (if end-marker (set-marker end-marker nil)) |
| 382 | ) |
| 383 | |
| 384 | ;; narrow to the enclosing fold if there is one |
| 385 | (if foldout-fold-list |
| 386 | (progn |
| 387 | (setq start-marker (car (car foldout-fold-list)) |
| 388 | end-marker (cdr (car foldout-fold-list))) |
| 389 | (narrow-to-region start-marker |
| 390 | (if end-marker |
| 391 | (1- (marker-position end-marker)) |
| 392 | (point-max))) |
| 393 | )) |
| 394 | (recenter) |
| 395 | |
| 396 | ;; update the modeline |
| 397 | (foldout-update-modeline) |
| 398 | )) |
| 399 | \f |
| 400 | |
| 401 | (defun foldout-update-modeline () |
| 402 | "Set the modeline string to indicate our fold depth." |
| 403 | (let ((depth (length foldout-fold-list))) |
| 404 | (setq foldout-modeline-string |
| 405 | (cond |
| 406 | ;; if we're not in a fold, keep quiet |
| 407 | ((zerop depth) |
| 408 | nil) |
| 409 | ;; in outline-minor-mode we're after "Outl:xx" in the modeline |
| 410 | (outline-minor-mode |
| 411 | (format ":%d" depth)) |
| 412 | ;; otherwise just announce the depth (I guess we're in outline-mode) |
| 413 | ((= depth 1) |
| 414 | " Inside 1 fold") |
| 415 | (t |
| 416 | (format " Inside %d folds" depth)) |
| 417 | )))) |
| 418 | \f |
| 419 | |
| 420 | (defun foldout-mouse-zoom (event) |
| 421 | "Zoom in on the heading clicked on. |
| 422 | |
| 423 | How much is exposed by the zoom depends on the number of mouse clicks:- |
| 424 | |
| 425 | 1 expose body |
| 426 | 2 expose subheadings |
| 427 | 3 expose body and subheadings |
| 428 | 4 expose entire subtree" |
| 429 | (interactive "@e") |
| 430 | |
| 431 | ;; swallow intervening mouse events so we only get the final click-count. |
| 432 | (setq event (foldout-mouse-swallow-events event)) |
| 433 | |
| 434 | ;; go to the heading clicked on |
| 435 | (foldout-mouse-goto-heading event) |
| 436 | |
| 437 | ;; zoom away |
| 438 | (foldout-zoom-subtree |
| 439 | (let ((nclicks (event-click-count event))) |
| 440 | (cond |
| 441 | ((= nclicks 1) -1) ; body only |
| 442 | ((= nclicks 2) '(1)) ; subheadings only |
| 443 | ((= nclicks 3) nil) ; body and subheadings |
| 444 | (t 0))))) ; entire subtree |
| 445 | |
| 446 | (defun foldout-mouse-show (event) |
| 447 | "Show what is hidden under the heading clicked on. |
| 448 | |
| 449 | What gets exposed depends on the number of mouse clicks:- |
| 450 | |
| 451 | 1 expose body |
| 452 | 2 expose subheadings |
| 453 | 3 expose body and subheadings |
| 454 | 4 expose entire subtree" |
| 455 | (interactive "@e") |
| 456 | |
| 457 | ;; swallow intervening mouse events so we only get the final click-count. |
| 458 | (setq event (foldout-mouse-swallow-events event)) |
| 459 | |
| 460 | ;; expose the text |
| 461 | (foldout-mouse-goto-heading event) |
| 462 | (let ((nclicks (event-click-count event))) |
| 463 | (cond |
| 464 | ((= nclicks 1) (show-entry)) |
| 465 | ((= nclicks 2) (show-children)) |
| 466 | ((= nclicks 3) (show-entry) (show-children)) |
| 467 | (t (show-subtree))))) |
| 468 | |
| 469 | (defun foldout-mouse-hide-or-exit (event) |
| 470 | "Hide the subtree under the heading clicked on, or exit a fold. |
| 471 | |
| 472 | What happens depends on the number of mouse clicks:- |
| 473 | |
| 474 | 1 hide subtree |
| 475 | 2 exit fold and hide text |
| 476 | 3 exit fold without hiding text |
| 477 | 4 exit all folds and hide text" |
| 478 | (interactive "@e") |
| 479 | |
| 480 | ;; swallow intervening mouse events so we only get the final click-count. |
| 481 | (setq event (foldout-mouse-swallow-events event)) |
| 482 | |
| 483 | ;; hide or exit |
| 484 | (let ((nclicks (event-click-count event))) |
| 485 | (if (= nclicks 1) |
| 486 | (progn |
| 487 | (foldout-mouse-goto-heading event) |
| 488 | (hide-subtree)) |
| 489 | (foldout-exit-fold |
| 490 | (cond |
| 491 | ((= nclicks 2) 1) ; exit and hide |
| 492 | ((= nclicks 3) -1) ; exit don't hide |
| 493 | (t 0)))))) ; exit all |
| 494 | \f |
| 495 | |
| 496 | (defun foldout-mouse-swallow-events (event) |
| 497 | "Swallow intervening mouse events so we only get the final click-count. |
| 498 | Signal an error if the final event isn't the same type as the first one." |
| 499 | (let ((initial-event-type (event-basic-type event))) |
| 500 | (while (null (sit-for 0 double-click-time 'nodisplay)) |
| 501 | (setq event (read-event))) |
| 502 | (or (eq initial-event-type (event-basic-type event)) |
| 503 | (error ""))) |
| 504 | event) |
| 505 | |
| 506 | (defun foldout-mouse-goto-heading (event) |
| 507 | "Go to the heading where the mouse event started. Signal an error |
| 508 | if the event didn't occur on a heading." |
| 509 | (goto-char (posn-point (event-start event))) |
| 510 | (or (outline-on-heading-p) |
| 511 | ;; outline.el sometimes treats beginning-of-buffer as a heading |
| 512 | ;; even though outline-on-heading returns nil. |
| 513 | (save-excursion (beginning-of-line) (bobp)) |
| 514 | (error "Not a heading line"))) |
| 515 | \f |
| 516 | |
| 517 | ;;; Keymaps: |
| 518 | |
| 519 | (defvar foldout-inhibit-key-bindings nil |
| 520 | "Set non-nil before loading foldout to inhibit key bindings.") |
| 521 | |
| 522 | (defvar foldout-mouse-modifiers '(meta control) |
| 523 | "List of modifier keys to apply to foldout's mouse events. |
| 524 | |
| 525 | The default (meta control) makes foldout bind its functions to |
| 526 | M-C-down-mouse-{1,2,3}. |
| 527 | |
| 528 | Valid modifiers are shift, control, meta, alt, hyper and super.") |
| 529 | |
| 530 | (if foldout-inhibit-key-bindings |
| 531 | () |
| 532 | (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) |
| 533 | (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold) |
| 534 | (let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix))) |
| 535 | (unless map |
| 536 | (setq map (make-sparse-keymap)) |
| 537 | (define-key outline-minor-mode-map outline-minor-mode-prefix map)) |
| 538 | (define-key map "\C-z" 'foldout-zoom-subtree) |
| 539 | (define-key map "\C-x" 'foldout-exit-fold)) |
| 540 | (let* ((modifiers (apply 'concat |
| 541 | (mapcar (function |
| 542 | (lambda (modifier) |
| 543 | (vector |
| 544 | (cond |
| 545 | ((eq modifier 'shift) ?S) |
| 546 | ((eq modifier 'control) ?C) |
| 547 | ((eq modifier 'meta) ?M) |
| 548 | ((eq modifier 'alt) ?A) |
| 549 | ((eq modifier 'hyper) ?H) |
| 550 | ((eq modifier 'super) ?s) |
| 551 | (t (error "invalid mouse modifier %s" |
| 552 | modifier))) |
| 553 | ?-))) |
| 554 | foldout-mouse-modifiers))) |
| 555 | (mouse-1 (vector (intern (concat modifiers "down-mouse-1")))) |
| 556 | (mouse-2 (vector (intern (concat modifiers "down-mouse-2")))) |
| 557 | (mouse-3 (vector (intern (concat modifiers "down-mouse-3"))))) |
| 558 | |
| 559 | (define-key outline-mode-map mouse-1 'foldout-mouse-zoom) |
| 560 | (define-key outline-mode-map mouse-2 'foldout-mouse-show) |
| 561 | (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit) |
| 562 | |
| 563 | (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom) |
| 564 | (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show) |
| 565 | (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit) |
| 566 | )) |
| 567 | |
| 568 | (provide 'foldout) |
| 569 | |
| 570 | ;;; arch-tag: 19d095a2-1f09-42a7-a5ac-e2a3078cfe95 |
| 571 | ;;; foldout.el ends here |