cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/kotl/kvspec.el

   1 ;;; kvspec.el --- Koutline view specification.
   2
   3 ;; Copyright (C) 1995, 2006 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: outlines, wp
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole 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 GNU
  20 ;; 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., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;; Koutliner view specs
  30 ;; + means support code has been written already.
  31 ;;
  32 ;; +      all:     Show all lines of cells and all cells in the outline.
  33 ;; +      blank:   Blank lines are on.
  34 ;;          b - on
  35 ;; +      cutoff:  Show only NUM lines per cell, 0 = all
  36 ;;          c - set default cutoff lines
  37 ;;          cNUM - set cutoff lines to NUM
  38 ;;        descend: Only entries below this entry
  39 ;; +      elide:   Ellipses are on.
  40 ;;          e - ellipses on
  41 ;;        filter:  Regexp or filter program to select entries for view,
  42 ;;                 off=select non-matching entries
  43 ;;        glue:    Freeze any group of entries selected to stay at top of
  44 ;;                 window, off=freeze those not-in-group.
  45 ;;        include: Include an entry referenced by a link.
  46 ;; +      level:   Some levels are hidden.
  47 ;;          l - set default level clipping
  48 ;;          lNUM - set level clipping to NUM
  49 ;;        name:    Display leading names within cells.
  50 ;;          m  -  show names
  51 ;; +      number:  Cell numbers are on
  52 ;;          n  - set default labels
  53 ;;          n0 - display idstamp labels
  54 ;;          n1 - display alpha labels
  55 ;;          n2 - display partial alpha labels
  56 ;;          n. - display legal labels
  57 ;;          n* - display star labels
  58 ;;          n~ - turn off labels
  59 ;;        rest:    Only following cells.
  60 ;;        synthesize: Use a named generator function to generate entries for
  61 ;;                    view.
  62 ;;        view:    Turn koutliner view mode on.  Standard insertion keys then
  63 ;;                 can be used for browsing and view setting.
  64 ;;
  65
  66 ;;; Code:
  67
  68 ;;;
  69 ;;; Other required Elisp libraries
  70 ;;;
  71
  72 (require 'kview)
  73
  74 ;;;
  75 ;;; Public variables
  76 ;;;
  77
  78 (defvar kvspec:current nil
  79   "String that represents the current view spec.
  80 It is local to each koutline.  Nil value means it has not been set yet.")
  81
  82 ;;;
  83 ;;; Public functions
  84 ;;;
  85
  86 (defun kvspec:activate (&optional view-spec)
  87   "Activate optional VIEW-SPEC or existing view spec in the current koutline.
  88 VIEW-SPEC is a string or t, which means recompute the current view spec.  See
  89 <${hyperb:dir}/kotl/EXAMPLE.kotl, 2b17=048> for details on valid view specs."
  90   (interactive (list (read-string "Set view spec: " kvspec:current)))
  91   (kotl-mode:is-p)
  92   (if (or (equal view-spec "") (equal view-spec kvspec:current))
  93       (setq view-spec nil))
  94   (kvspec:initialize)
  95   (kvspec:update view-spec)
  96   (kvspec:update-view))
  97
  98 (defun kvspec:initialize ()
  99   "Ensure that view spec settings will be local to the current buffer."
 100   (if (and (fboundp 'local-variable-p)
 101            (local-variable-p 'kvspec:current (current-buffer)))
 102       nil
 103     (make-local-variable 'kvspec:current)
 104     (make-local-variable 'kvspec:string)))
 105
 106 (defun kvspec:levels-to-show (levels-to-keep)
 107   "Hide all cells in outline at levels deeper than LEVELS-TO-KEEP (a number).
 108 Shows any hidden cells within LEVELS-TO-KEEP.  1 is the first level.  0 means
 109 display all levels of cells."
 110   (if (null levels-to-keep)
 111       (setq levels-to-keep
 112             (read-from-minibuffer "Show cells down to level (0 = show all levels): "
 113                                   nil nil t)))
 114   (setq levels-to-keep (prefix-numeric-value levels-to-keep))
 115   (if (< levels-to-keep 0)
 116       (error "(kvspec:levels-to-show): Must display at least one level."))
 117   (kview:map-tree
 118    (function (lambda (kview)
 119                (if (/= (kcell-view:level) levels-to-keep)
 120                    (kotl-mode:show-tree)
 121                  (kotl-mode:hide-subtree)
 122                  ;; Move to last cell in hidden subtree, to skip further
 123                  ;; processing of these cells.
 124                  (if (kcell-view:next t)
 125                      (kcell-view:previous)
 126                    (goto-char (point-max))))))
 127    kview t)
 128   (kview:set-attr kview 'levels-to-show levels-to-keep))
 129
 130 (defun kvspec:show-lines-per-cell (num)
 131   "Show NUM lines per cell."
 132   (if (and (integerp num) (>= num 0))
 133       nil
 134     (error "(kvspec:show-lines-per-cell): Invalid lines per cell, '%d'" num))
 135   (kview:set-attr kview 'lines-to-show num)
 136   (let (start end count)
 137     (if (zerop num)
 138         ;; Show all lines in cells.
 139         (kview:map-tree
 140          (function
 141           (lambda (kview)
 142             ;; Use free variable label-sep-len bound in kview:map-tree for
 143             ;; speed.
 144             (setq start (goto-char (kcell-view:start nil label-sep-len))
 145                   end (kcell-view:end-contents))
 146             ;; Show all lines in cell.
 147             (subst-char-in-region start end ?\r ?\n t)))
 148          kview t t)
 149       ;; Show NUM lines in cells.
 150       (kview:map-tree
 151        (function
 152         (lambda (kview)
 153           ;; Use free variable label-sep-len bound in kview:map-tree for speed.
 154           (setq start (goto-char (kcell-view:start nil label-sep-len))
 155                 end (kcell-view:end-contents)
 156                 count (1- num))
 157           ;; Hide all lines in cell.
 158           (subst-char-in-region start end ?\n ?\r t)
 159           ;; Expand num - 1 newlines to show num lines.
 160           (while (and (> count 0) (search-forward "\r" end t))
 161             (replace-match "\n") (setq count (1- count)))))
 162        kview t t))))
 163
 164 (defun kvspec:toggle-blank-lines ()
 165   "Toggle blank lines between cells on or off."
 166   (interactive)
 167   (setq kvspec:current
 168         (if (string-match "b" kvspec:current)
 169             (hypb:replace-match-string "b" kvspec:current "" t)
 170           (concat "b" kvspec:current)))
 171   (kvspec:blank-lines)
 172   (kvspec:update-modeline))
 173
 174 (defun kvspec:update (view-spec)
 175   "Update current view spec according to VIEW-SPEC but don't change the view.
 176 VIEW-SPEC is a string or t, which means recompute the current view spec.  See
 177 <${hyperb:dir}/kotl/EXAMPLE.kotl, 2b17=048> for details on valid view specs."
 178   (cond ((stringp view-spec)
 179          ;; Use given view-spec after removing extraneous characters.
 180          (setq kvspec:current
 181                (hypb:replace-match-string
 182                 "[^.*~0-9abcdefgilnrsv]+" view-spec "" t)))
 183         ((or (eq view-spec t) (null kvspec:current))
 184          (setq kvspec:current (kvspec:compute))))
 185   ;; Update display using current specs.
 186   (kvspec:update-modeline))
 187
 188 ;;;
 189 ;;; Private functions
 190 ;;;
 191
 192 (defun kvspec:blank-lines ()
 193   "Turn blank lines on or off according to 'kvspec:current'."
 194   (let ((modified-p (buffer-modified-p))
 195         (buffer-read-only))
 196       (if (string-match "b" kvspec:current)
 197           ;; On
 198           (progn (kview:set-attr kview 'blank-lines t)
 199                  (kproperty:remove (point-min) (point-max) '(invisible t)))
 200         ;; Off
 201         (kview:set-attr kview 'blank-lines nil)
 202         (save-excursion
 203           (goto-char (point-max))
 204           (while (re-search-backward "[\n\r][\n\r]" nil t)
 205             ;; Make blank lines invisible.
 206             (kproperty:put (1+ (point)) (min (+ (point) 2) (point-max))
 207                            '(invisible t)))))
 208     (set-buffer-modified-p modified-p)))
 209
 210 (defun kvspec:compute ()
 211   "Compute and return current view spec string."
 212   (concat
 213
 214    ;; a - Show all cells and cell lines.
 215    ;; Never compute this setting (use it only within links) since it will
 216    ;; expose all carefully hidden outline items if the user forgets to turn
 217    ;; it off when he resets the view specs.
 218
 219    ;; b - blank separator lines
 220    (if (kview:get-attr kview 'blank-lines) "b")
 221
 222    ;; c - cutoff lines per cell
 223    (let ((lines (kview:get-attr kview 'lines-to-show)))
 224      (if (zerop lines)
 225          nil
 226        (concat "c" (int-to-string lines))))
 227
 228    ;; e - ellipses on
 229    (if selective-display-ellipses "e")
 230
 231    ;; l - hide some levels
 232    (let ((levels (kview:get-attr kview 'levels-to-show)))
 233      (if (zerop levels)
 234          nil
 235        (concat "l" (int-to-string levels))))
 236
 237    ;; n - numbering type
 238    (let ((type (kview:label-type kview)))
 239      (cond ((eq type 'no) nil)
 240            ((eq type kview:default-label-type) "n")
 241            (t (concat "n" (char-to-string
 242                            (car (rassq (kview:label-type kview)
 243                                        kvspec:label-type-alist)))))))))
 244
 245 (defun kvspec:elide ()
 246   "Turn ellipses display following clipped cells on or off according to 'kvspec:current'."
 247   (setq selective-display-ellipses
 248         (if (string-match "e" kvspec:current) t)))
 249
 250 (defun kvspec:hide-levels ()
 251   "Show a set number of cell levels according to 'kvspec:current'."
 252   ;; "l" means use value of kview:default-levels-to-show.
 253   ;; "l0" means show all levels.
 254   (let (levels)
 255     (if (not (string-match "l\\([0-9]+\\)?" kvspec:current))
 256         ;; Don't change the view if no view spec is given but note that
 257         ;; all levels should be shown in the future.
 258         (kview:set-attr kview 'levels-to-show 0)
 259       (if (match-beginning 1)
 260           (setq levels (string-to-number
 261                         (substring kvspec:current (match-beginning 1)
 262                                    (match-end 1))))
 263         (setq levels kview:default-levels-to-show))
 264       (kview:set-attr kview 'levels-to-show levels)
 265       (kvspec:levels-to-show levels))))
 266
 267 (defun kvspec:lines-to-show ()
 268   "Show a set number of lines per cell according to 'kvspec:current'."
 269   ;; "c" means use value of kview:default-lines-to-show.
 270   ;; "c0" means show all lines.
 271   (cond ((not (string-match "c\\([0-9]+\\)?" kvspec:current))
 272          ;; Don't change the view if no view spec is given but note that all
 273          ;; lines should be shown in the future.
 274          (kview:set-attr kview 'lines-to-show 0))
 275         ((match-beginning 1)
 276          (kvspec:show-lines-per-cell
 277           (string-to-number (substring kvspec:current (match-beginning 1)
 278                                     (match-end 1)))))
 279         (t (kvspec:show-lines-per-cell kview:default-lines-to-show))))
 280
 281 (defun kvspec:numbering ()
 282   "Set the type of numbering (label) display according to 'kvspec:current'."
 283   (if (not (string-match "n\\([.*~0-2]\\)?" kvspec:current))
 284       nil
 285     ;; "n"  means use value of kview:default-label-type.
 286     ;; "n0" means display idstamps.
 287     ;; "n1" means display alpha labels.
 288     ;; "n2" means display partial alpha labels.
 289     ;; "n." means display legal labels.
 290     ;; "n*" means star labels.
 291     ;; "n~" means no labels.
 292     (let (spec type)
 293       (if (match-beginning 1)
 294           (setq spec (string-to-char
 295                       (substring kvspec:current
 296                                  (match-beginning 1) (match-end 1)))
 297                 type (cdr (assq spec kvspec:label-type-alist)))
 298         (setq type kview:default-label-type))
 299       (kview:set-label-type kview type))))
 300
 301 (defun kvspec:update-modeline ()
 302   "Setup or update display of the current kview spec in the modeline."
 303   (if (stringp kvspec:current)
 304       (setq kvspec:string (format kvspec:string-format kvspec:current)))
 305   (if (memq 'kvspec:string mode-line-format)
 306       nil
 307     (setq mode-line-format (copy-sequence mode-line-format))
 308     (let ((elt (or (memq 'mode-line-buffer-identification mode-line-format)
 309                    (memq 'modeline-buffer-identification mode-line-format))))
 310       (if elt
 311           (setcdr elt (cons 'kvspec:string (cdr elt)))
 312         (if hyperb:xemacs-p
 313             (let ((mf modeline-format)
 314                   elt)
 315               (while mf
 316                 (setq elt (car mf))
 317                 (if (and (consp elt) (eq (cdr elt) 'modeline-buffer-identification))
 318                     (progn (setcdr mf (cons 'kvspec:string (cdr mf)))
 319                            (setq mf nil)))
 320                 (setq mf (cdr mf)))))))))
 321
 322 (defun kvspec:update-view ()
 323   "Update view according to current setting of local 'kvspec:current' variable."
 324   (let ((modified-p (buffer-modified-p))
 325         (buffer-read-only))
 326     (save-excursion
 327
 328       (if (string-match "a" kvspec:current)
 329           (kotl-mode:show-all))
 330
 331       (kvspec:blank-lines) ;; b
 332
 333       ;; This must come before kvspec:lines-to-show or else it could show
 334       ;; lines that should be hidden.
 335       (kvspec:hide-levels) ;; l
 336
 337       (kvspec:lines-to-show) ;; c
 338
 339       (if (string-match "d" kvspec:current)
 340           nil)
 341
 342       (kvspec:elide) ;; e
 343
 344       (if (string-match "f" kvspec:current)
 345           nil)
 346
 347       (if (string-match "g" kvspec:current)
 348           nil)
 349
 350       (if (string-match "i" kvspec:current)
 351           nil)
 352
 353       (if (string-match "r" kvspec:current)
 354           nil)
 355
 356       (if (string-match "s" kvspec:current)
 357           nil)
 358
 359       ;; Do this last since it can trigger an error if partial alpha is
 360       ;; selected.
 361       (kvspec:numbering) ;; n
 362
 363       )
 364     (set-buffer-modified-p modified-p)))
 365
 366 ;;;
 367 ;;; Private variables
 368 ;;;
 369
 370 (defvar kvspec:label-type-alist
 371   '((?0 . idstamp) (?1 . alpha) (?2 . partial-alpha)
 372     (?. . legal) (?* . star) (?~ . no))
 373   "Alist of (view-spec-character . label-type) pairs.")
 374
 375 (defvar kvspec:string ""
 376   "String displayed in koutline modelines to reflect the current view spec.
 377 It is local to each koutline.  Set this to nil to disable modeline display of
 378 the view spec settings.")
 379
 380 (defvar kvspec:string-format " <|%s>"
 381   "Format of the kview spec modeline display.
 382 It must contain a '%s' which is replaced with the current set of view spec
 383 characters at run-time.")
 384
 385 (provide 'kvspec)
 386
 387 ;;; kvspec.el ends here