(info-other-window, info): Rename function argument
[bpt/emacs.git] / lisp / fringe.el
index ab77093..a32d6b5 100644 (file)
@@ -1,6 +1,6 @@
 ;;; fringe.el --- change fringes appearance in various ways
 
-;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 ;; Maintainer: FSF
@@ -20,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 
 ;;; Code:
 
+(defgroup fringe nil
+  "Window fringes."
+  :version "22.1"
+  :group 'frames)
+
 ;; Standard fringe bitmaps
 
-(defconst no-fringe-bitmap 0)
-(defconst undef-fringe-bitmap 1)
-(defconst left-truncation-fringe-bitmap 2)
-(defconst right-truncation-fringe-bitmap 3)
-(defconst up-arrow-fringe-bitmap 4)
-(defconst down-arrow-fringe-bitmap 5)
-(defconst continued-line-fringe-bitmap 6)
-(defconst continuation-line-fringe-bitmap 7)
-(defconst overlay-arrow-fringe-bitmap 8)
-(defconst top-left-angle-fringe-bitmap 9)
-(defconst top-right-angle-fringe-bitmap 10)
-(defconst bottom-left-angle-fringe-bitmap 11)
-(defconst bottom-right-angle-fringe-bitmap 12)
-(defconst left-bracket-fringe-bitmap 13)
-(defconst right-bracket-fringe-bitmap 14)
-(defconst filled-box-cursor-fringe-bitmap 15)
-(defconst hollow-box-cursor-fringe-bitmap 16)
-(defconst hollow-square-fringe-bitmap 17)
-(defconst bar-cursor-fringe-bitmap 18)
-(defconst hbar-cursor-fringe-bitmap 19)
-(defconst empty-line-fringe-bitmap 20)
+(defmacro fringe-bitmap-p (symbol)
+  "Return non-nil if SYMBOL is a fringe bitmap."
+  `(get ,symbol 'fringe))
+
+(defvar fringe-bitmaps)
+
+(unless (or (not (boundp 'fringe-bitmaps))
+           (get 'left-truncation 'fringe))
+  (let ((bitmaps '(left-truncation right-truncation
+                  up-arrow down-arrow
+                  continued-line continuation-line
+                  overlay-arrow
+                  top-left-angle top-right-angle
+                  bottom-left-angle bottom-right-angle
+                  left-bracket right-bracket
+                  filled-box-cursor hollow-box-cursor hollow-square
+                  bar-cursor hbar-cursor
+                  empty-line))
+       (bn 2))
+    (while bitmaps
+      (push (car bitmaps) fringe-bitmaps)
+      (put (car bitmaps) 'fringe bn)
+      (setq bitmaps (cdr bitmaps)
+           bn (1+ bn)))))
 
 
 ;; Control presence of fringes
@@ -110,6 +118,25 @@ See `fringe-mode' for possible values and their effect."
                                   fringe-mode))))
       (setq frames (cdr frames)))))
 
+;; For initialization of fringe-mode, take account of changes
+;; made explicitly to default-frame-alist.
+(defun fringe-mode-initialize (symbol value)
+  (let* ((left-pair (assq 'left-fringe default-frame-alist))
+        (right-pair (assq 'right-fringe default-frame-alist))
+        (left (cdr left-pair))
+        (right (cdr right-pair)))
+    (if (or left-pair right-pair)
+       ;; If there's something in default-frame-alist for fringes,
+       ;; don't change it, but reflect that into the value of fringe-mode.
+       (progn
+         (setq fringe-mode (cons left right))
+         (if (equal fringe-mode '(nil . nil))
+             (setq fringe-mode nil))
+         (if (equal fringe-mode '(0 . 0))
+             (setq fringe-mode 0)))
+      ;; Otherwise impose the user-specified value of fringe-mode.
+      (custom-initialize-reset symbol value))))
+
 ;;;###autoload
 (defcustom fringe-mode nil
   "*Specify appearance of fringes on all frames.
@@ -123,7 +150,7 @@ To set this variable in a Lisp program, use `set-fringe-mode' to make
 it take real effect.
 Setting the variable with a customization buffer also takes effect.
 If you only want to modify the appearance of the fringe in one frame,
-you can use the interactive function `toggle-fringe'"
+you can use the interactive function `set-fringe-style'."
   :type '(choice (const :tag "Default width" nil)
                 (const :tag "No fringes" 0)
                 (const :tag "Only right" (0 . nil))
@@ -134,8 +161,9 @@ you can use the interactive function `toggle-fringe'"
                 (cons :tag "Different left/right sizes"
                       (integer :tag "Left width")
                       (integer :tag "Right width")))
-  :group 'frames
+  :group 'fringe
   :require 'fringe
+  :initialize 'fringe-mode-initialize
   :set 'set-fringe-mode-1)
 
 (defun fringe-query-style (&optional all-frames)
@@ -146,7 +174,10 @@ If ALL-FRAMES, the negation of the fringe values in
 Otherwise the negation of the fringe value in the currently selected
 frame parameter is used."
   (let ((mode (intern (completing-read
-                      "Select fringe mode for all frames (type ? for list): "
+                      (concat
+                       "Select fringe mode for "
+                       (if all-frames "all frames" "selected frame")
+                       " (type ? for list): ")
                       '(("none") ("default") ("left-only")
                         ("right-only") ("half") ("minimal"))
                       nil t))))
@@ -218,6 +249,17 @@ default appearance of fringes on all frames, see the command
    (list (cons 'left-fringe (if (consp mode) (car mode) mode))
         (cons 'right-fringe (if (consp mode) (cdr mode) mode)))))
 
+(defsubst fringe-columns (side &optional real)
+  "Return the width, measured in columns, of the fringe area on SIDE.
+If optional argument REAL is non-nil, return a real floating point
+number instead of a rounded integer value.
+SIDE must be the symbol `left' or `right'."
+  (funcall (if real '/ 'ceiling)
+          (or (funcall (if (eq side 'left) 'car 'cadr)
+                       (window-fringes))
+              0)
+           (float (frame-char-width))))
+
 (provide 'fringe)
 
 ;;; arch-tag: 6611ef60-0869-47ed-8b93-587ee7d3ff5d