git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/gutter.el

   1 ;;; gutter.el --- Gutter manipulation for XEmacs.
   2
   3 ;; Copyright (C) 1999 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1999, 2000 Andy Piper.
   5
   6 ;; Maintainer: XEmacs Development Team
   7 ;; Keywords: frames, extensions, internal, dumped
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify it
  12 ;; under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; XEmacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with Xmacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;; Some of this is taken from the buffer-menu stuff in menubar-items.el
  27 ;; and the custom specs in toolbar.el.
  28
  29 (defgroup gutter nil
  30   "Input from the gutters."
  31   :group 'environment)
  32
  33 ;; Although these customizations appear bogus, they are neccessary in
  34 ;; order to be able to save options through the options menu.
  35 (defcustom default-gutter-position
  36   (default-gutter-position)
  37   "The location of the default gutter. It can be 'top, 'bottom, 'left or
  38 'right. This option should be customized through the options menu.
  39 To set the gutter position explicitly use `set-default-gutter-position'"
  40   :group 'gutter
  41   :type '(choice (const :tag "top" top)
  42                  (const :tag "bottom" bottom)
  43                  (const :tag "left" left)
  44                  (const :tag "right" right))
  45   :set #'(lambda (var val)
  46            (set-default-gutter-position val)
  47            (setq default-gutter-position val)))
  48
  49 ;;; Gutter helper functions
  50
  51 ;; called by Fset_default_gutter_position()
  52 (defvar default-gutter-position-changed-hook nil
  53   "Function or functions to be called when the gutter position is changed.
  54 The value of this variable may be buffer-local.")
  55
  56 ;; called by set-gutter-element-visible-p
  57 (defvar gutter-element-visibility-changed-hook nil
  58   "Function or functions to be called when the visibility of an
  59 element in the gutter changes.  The value of this variable may be
  60 buffer-local. The gutter element symbol is passed as an argument to
  61 the hook, as is the visibility flag.")
  62
  63 (defun set-gutter-element (gutter-specifier prop val &optional locale tag-set)
  64   "Set GUTTER-SPECIFIER gutter element PROP to VAL in optional LOCALE.
  65 This is a convenience function for setting gutter elements.
  66 VAL in general must be a string. If VAL is a glyph then a string will be
  67 created to put the glyph into."
  68   (let ((spec val))
  69     (when (glyphp val)
  70       (setq spec (copy-sequence "\n"))
  71       (set-extent-begin-glyph (make-extent 0 1 spec) val))
  72     (map-extents #'(lambda (extent arg)
  73                      (set-extent-property extent 'duplicable t)) spec)
  74     (modify-specifier-instances gutter-specifier #'plist-put (list prop spec)
  75                                 'force nil locale tag-set)))
  76
  77 (defun remove-gutter-element (gutter-specifier prop &optional locale tag-set)
  78   "Remove gutter element PROP from GUTTER-SPECIFIER in optional LOCALE.
  79 This is a convenience function for removing gutter elements."
  80   (modify-specifier-instances gutter-specifier #'plist-remprop (list prop)
  81                               'force nil locale tag-set))
  82
  83 (defun set-gutter-element-visible-p (gutter-visible-specifier-p
  84                                      prop &optional visible-p
  85                                      locale tag-set)
  86   "Change the visibility of gutter elements.
  87 Set the visibility of element PROP to VISIBLE-P for
  88 GUTTER-SPECIFIER-VISIBLE-P in optional LOCALE.
  89 This is a convenience function for hiding and showing gutter elements."
  90   (modify-specifier-instances
  91    gutter-visible-specifier-p #'(lambda (spec prop visible-p)
  92                                   (if (consp spec)
  93                                       (if visible-p
  94                                           (if (memq prop spec) spec
  95                                             (cons prop spec))
  96                                         (delq prop spec))
  97                                     (if visible-p (list prop))))
  98    (list prop visible-p)
  99    'force nil locale tag-set)
 100   (run-hook-with-args 'gutter-element-visibility-changed-hook prop visible-p))
 101
 102 (defun gutter-element-visible-p (gutter-visible-specifier-p
 103                                  prop &optional domain)
 104   "Determine whether a gutter element is visible.
 105 Given GUTTER-VISIBLE-SPECIFIER-P and gutter element PROP, return
 106 non-nil if it is visible in optional DOMAIN."
 107   (let ((spec (specifier-instance gutter-visible-specifier-p domain)))
 108     (or (and (listp spec) (memq 'buffers-tab spec))
 109         spec)))
 110
 111 (defun init-gutter ()
 112   "Initialize the gutter."
 113   ;; do nothing as yet.
 114   )
 115
 116 ;;; gutter.el ends here.
 117
 118