cgit.sxemacs.org Git - sxemacs/blob - lisp/gutter.el

   1 ;;; gutter.el --- Gutter manipulation for SXEmacs.
   2
   3 ;; Copyright (C) 1999 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1999, 2000 Andy Piper.
   5
   6 ;; Maintainer: SXEmacs Development Team
   7 ;; Keywords: frames, gui, internal, dumped
   8
   9 ;; This file is part of SXEmacs.
  10
  11 ;; SXEmacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; SXEmacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;; Some of this is taken from the buffer-menu stuff in menubar-items.el
  25 ;; and the custom specs in toolbar.el.
  26
  27 (defgroup gutter nil
  28   "Input from the gutters."
  29   :group 'environment)
  30
  31 ;; Although these customizations appear bogus, they are necessary in
  32 ;; order to be able to save options through the options menu.
  33 (defcustom default-gutter-position
  34   (default-gutter-position)
  35   "The location of the default gutter. It can be 'top, 'bottom, 'left or
  36 'right. This option should be customized through the options menu.
  37 To set the gutter position explicitly use `set-default-gutter-position'"
  38   :group 'gutter
  39   :type '(choice (const :tag "top" top)
  40                  (const :tag "bottom" bottom)
  41                  (const :tag "left" left)
  42                  (const :tag "right" right))
  43   :set #'(lambda (var val)
  44            (set-default-gutter-position val)
  45            (setq default-gutter-position val)))
  46
  47 ;;; Gutter helper functions
  48
  49 ;; called by Fset_default_gutter_position()
  50 (defvar default-gutter-position-changed-hook nil
  51   "Function or functions to be called when the gutter position is changed.
  52 The value of this variable may be buffer-local.")
  53
  54 ;; called by set-gutter-element-visible-p
  55 (defvar gutter-element-visibility-changed-hook nil
  56   "Function or functions to be called when the visibility of an
  57 element in the gutter changes.  The value of this variable may be
  58 buffer-local. The gutter element symbol is passed as an argument to
  59 the hook, as is the visibility flag.")
  60
  61 (defun set-gutter-element (gutter-specifier prop value &optional locale tag-set)
  62   "Set GUTTER-SPECIFIER gutter element PROP to VALUE in optional LOCALE.
  63 This is a convenience function for setting gutter elements.
  64 VALUE in general must be a string. If VALUE is a glyph then a string
  65 will be created to put the glyph into."
  66   (let ((spec value))
  67     (when (glyphp value)
  68       (setq spec (copy-sequence "\n"))
  69       (set-extent-begin-glyph (make-extent 0 1 spec) value))
  70     (map-extents #'(lambda (extent arg)
  71                      (set-extent-property extent 'duplicable t)) spec)
  72     (modify-specifier-instances gutter-specifier #'plist-put (list prop spec)
  73                                 'force nil locale tag-set)))
  74
  75 (defun remove-gutter-element (gutter-specifier prop &optional locale tag-set)
  76   "Remove gutter element PROP from GUTTER-SPECIFIER in optional LOCALE.
  77 This is a convenience function for removing gutter elements."
  78   (modify-specifier-instances gutter-specifier #'plist-remprop (list prop)
  79                               'force nil locale tag-set))
  80
  81 (defun set-gutter-element-visible-p (gutter-visible-specifier-p
  82                                      prop &optional visible-p
  83                                      locale tag-set)
  84   "Change the visibility of gutter elements.
  85 Set the visibility of element PROP to VISIBLE-P for
  86 GUTTER-SPECIFIER-VISIBLE-P in optional LOCALE.
  87 This is a convenience function for hiding and showing gutter elements."
  88   (modify-specifier-instances
  89    gutter-visible-specifier-p #'(lambda (spec prop visible-p)
  90                                   (if (consp spec)
  91                                       (if visible-p
  92                                           (if (memq prop spec) spec
  93                                             (cons prop spec))
  94                                         (delq prop spec))
  95                                     (if visible-p (list prop))))
  96    (list prop visible-p)
  97    'force nil locale tag-set)
  98   (run-hook-with-args 'gutter-element-visibility-changed-hook prop visible-p))
  99
 100 (defun gutter-element-visible-p (gutter-visible-specifier-p
 101                                  prop &optional domain)
 102   "Determine whether a gutter element is visible.
 103 Given GUTTER-VISIBLE-SPECIFIER-P and gutter element PROP, return
 104 non-nil if it is visible in optional DOMAIN."
 105   (let ((spec (specifier-instance gutter-visible-specifier-p domain)))
 106     (or (and (listp spec) (memq 'buffers-tab spec))
 107         spec)))
 108
 109 (defun set-gutter-dirty-p (gutter-or-location)
 110   "Make GUTTER-OR-LOCATION dirty to force redisplay updates."
 111   ;; set-glyph-image will not make the gutter dirty
 112   (when (or (gutter-specifier-p gutter-or-location)
 113             (eq gutter-or-location 'top)
 114             (eq gutter-or-location 'bottom)
 115             (eq gutter-or-location 'left)
 116             (eq gutter-or-location 'right))
 117     (or (gutter-specifier-p gutter-or-location)
 118         (setq gutter-or-location
 119               (eval (intern (concat
 120                              (symbol-name gutter-or-location)
 121                              "-gutter")))))
 122     (set-specifier-dirty-flag gutter-or-location)))
 123
 124 (defun make-gutter-specifier (spec-list)
 125   "Return a new `gutter' specifier object with the given specification list.
 126 SPEC-LIST can be a list of specifications (each of which is a cons of a
 127 locale and a list of instantiators), a single instantiator, or a list
 128 of instantiators.  See `make-specifier' for more information about
 129 specifiers.
 130
 131 Gutter specifiers are used to specify the format of a gutter.
 132 The values of the variables `default-gutter', `top-gutter',
 133 `left-gutter', `right-gutter', and `bottom-gutter' are always
 134 gutter specifiers.
 135
 136 Valid gutter instantiators are called \"gutter descriptors\" and are
 137 either strings or property-lists of strings.  See `default-gutter' for
 138 a description of the exact format."
 139   (make-specifier-and-init 'gutter spec-list))
 140
 141 (defun make-gutter-size-specifier (spec-list)
 142   "Return a new `gutter-size' specifier object with the given spec list.
 143 SPEC-LIST can be a list of specifications (each of which is a cons of a
 144 locale and a list of instantiators), a single instantiator, or a list
 145 of instantiators.  See `make-specifier' for more information about
 146 specifiers.
 147
 148 Gutter-size specifiers are used to specify the size of a gutter.  The
 149 values of the variables `default-gutter-size', `top-gutter-size',
 150 `left-gutter-size', `right-gutter-size', and `bottom-gutter-size' are
 151 always gutter-size specifiers.
 152
 153 Valid gutter-size instantiators are either integers or the special
 154 symbol 'autodetect. If a gutter-size is set to 'autodetect them the
 155 size of the gutter will be adjusted to just accommodate the gutters
 156 contents. 'autodetect only works for top and bottom gutters."
 157   (make-specifier-and-init 'gutter-size spec-list))
 158
 159 (defun make-gutter-visible-specifier (spec-list)
 160   "Return a new `gutter-visible' specifier object with the given spec list.
 161 SPEC-LIST can be a list of specifications (each of which is a cons of a
 162 locale and a list of instantiators), a single instantiator, or a list
 163 of instantiators.  See `make-specifier' for more information about
 164 specifiers.
 165
 166 Gutter-visible specifiers are used to specify the visibility of a
 167 gutter.  The values of the variables `default-gutter-visible-p',
 168 `top-gutter-visible-p', `left-gutter-visible-p',
 169 `right-gutter-visible-p', and `bottom-gutter-visible-p' are always
 170 gutter-visible specifiers.
 171
 172 Valid gutter-visible instantiators are t, nil or a list of symbols.
 173 If a gutter-visible instantiator is set to a list of symbols, and the
 174 corresponding gutter specification is a property-list strings, then
 175 elements of the gutter specification will only be visible if the
 176 corresponding symbol occurs in the gutter-visible instantiator."
 177   (make-specifier-and-init 'gutter-visible spec-list))
 178
 179 (defun init-gutter ()
 180   "Initialize the gutter."
 181   ;; do nothing as yet.
 182   )
 183
 184 ;;; gutter.el ends here.
 185
 186