From: Kim F. Storm Date: Tue, 28 Sep 2004 23:02:53 +0000 (+0000) Subject: (Vfringe_bitmaps): New variable. X-Git-Tag: ttn-vms-21-2-B4~4781 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7a2a85be99928d7becee6f35ebcdcccbf8b3f204;p=emacs.git (Vfringe_bitmaps): New variable. (syms_of_fringe): DEFVAR_LISP it. (valid_fringe_bitmap_p): Rename from valid_fringe_bitmap_id_p. Change arg to Lisp_Object and fail if not an integer. (get_fringe_bitmap_name, resolve_fringe_bitmap) (destroy_fringe_bitmap): New functions. (Fdestroy_fringe_bitmap): Change arg to bitmap symbol. Use destroy_fringe_bitmap. Remove symbol from Vfringe_bitmaps and clear its fringe property. (init_fringe_bitmap): Use destroy_fringe_bitmap instead of Fdestroy_fringe_bitmap. (Fdefine_fringe_bitmap): Add BITMAP arg specifying new or existing bitmap symbol; remove WHICH arg. Add symbol to Vfringe_bitmaps and set fringe property. Signal error if no free slots. (Fset_fringe_bitmap_face): Change arg to bitmap symbol. (Ffringe_bitmaps_at_pos): Return bitmap symbols instead of numbers. --- diff --git a/src/fringe.c b/src/fringe.c index 03cd5fe93af..a7d6dade538 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -31,6 +31,7 @@ Boston, MA 02111-1307, USA. */ #ifdef HAVE_WINDOW_SYSTEM +extern Lisp_Object Qfringe; extern Lisp_Object Qtop, Qbottom, Qcenter; extern Lisp_Object Qup, Qdown, Qleft, Qright; @@ -38,6 +39,14 @@ extern Lisp_Object Qup, Qdown, Qleft, Qright; Lisp_Object Voverflow_newline_into_fringe; +/* List of known fringe bitmap symbols. + + The fringe bitmap number is stored in the `fringe' property on + those symbols. Names for the built-in bitmaps are installed by + loading fringe.el. + */ + +Lisp_Object Vfringe_bitmaps; enum fringe_bitmap_type { @@ -444,15 +453,90 @@ static int max_used_fringe_bitmap = MAX_STANDARD_FRINGE_BITMAPS; /* Return 1 if FRINGE_ID is a valid fringe bitmap id. */ int -valid_fringe_bitmap_id_p (fringe_id) - int fringe_id; +valid_fringe_bitmap_p (bitmap) + Lisp_Object bitmap; +{ + int bn; + + if (!INTEGERP (bitmap)) + return 0; + + bn = XINT (bitmap); + return (bn >= NO_FRINGE_BITMAP + && bn < max_used_fringe_bitmap + && (bn < MAX_STANDARD_FRINGE_BITMAPS + || fringe_bitmaps[bn] != NULL)); +} + +/* Get fringe bitmap name for bitmap number BN. + + Found by traversing Vfringe_bitmaps comparing BN to the + fringe property for each symbol. + + Return BN if not found in Vfringe_bitmaps. */ + +static Lisp_Object +get_fringe_bitmap_name (bn) + int bn; +{ + Lisp_Object bitmaps; + Lisp_Object num; + + /* Zero means no bitmap -- return nil. */ + if (bn <= 0) + return Qnil; + + bitmaps = Vfringe_bitmaps; + num = make_number (bn); + + while (CONSP (bitmaps)) + { + Lisp_Object bitmap = XCAR (bitmaps); + if (EQ (num, Fget (bitmap, Qfringe))) + return bitmap; + bitmaps = XCDR (bitmaps); + } + + return num; +} + + +/* Resolve a BITMAP parameter. + + An INTEGER, corresponding to a bitmap number. + A STRING which is interned to a symbol. + A SYMBOL which has a fringe property which is a bitmap number. +*/ + +static int +resolve_fringe_bitmap (bitmap, namep) + Lisp_Object bitmap; + Lisp_Object *namep; { - return (fringe_id >= NO_FRINGE_BITMAP - && fringe_id < max_used_fringe_bitmap - && (fringe_id < MAX_STANDARD_FRINGE_BITMAPS - || fringe_bitmaps[fringe_id] != NULL)); + if (namep) + *namep = Qnil; + + if (STRINGP (bitmap)) + bitmap = intern (SDATA (bitmap)); + + if (SYMBOLP (bitmap)) + { + if (namep) + *namep = bitmap; + bitmap = Fget (bitmap, Qfringe); + } + + if (valid_fringe_bitmap_p (bitmap)) + { + if (namep && NILP (*namep)) + *namep = get_fringe_bitmap_name (XINT (bitmap)); + return XINT (bitmap); + } + + return -1; } + /* Draw the bitmap WHICH in one of the left or right fringes of window W. ROW is the glyph row for which to display the bitmap; it determines the vertical position at which the bitmap has to be @@ -983,20 +1067,13 @@ compute_fringe_widths (f, redraw) redraw_frame (f); } -DEFUN ("destroy-fringe-bitmap", Fdestroy_fringe_bitmap, Sdestroy_fringe_bitmap, - 1, 1, 0, - doc: /* Destroy fringe bitmap WHICH. -If WHICH overrides a standard fringe bitmap, the original bitmap is restored. */) - (which) - Lisp_Object which; + +void +destroy_fringe_bitmap (n) + int n; { - int n; struct fringe_bitmap **fbp; - CHECK_NUMBER (which); - if (n = XINT (which), n >= max_used_fringe_bitmap) - return Qnil; - fringe_faces[n] = FRINGE_FACE_ID; fbp = &fringe_bitmaps[n]; @@ -1011,7 +1088,31 @@ If WHICH overrides a standard fringe bitmap, the original bitmap is restored. * while (max_used_fringe_bitmap > MAX_STANDARD_FRINGE_BITMAPS && fringe_bitmaps[max_used_fringe_bitmap - 1] == NULL) max_used_fringe_bitmap--; +} + + +DEFUN ("destroy-fringe-bitmap", Fdestroy_fringe_bitmap, Sdestroy_fringe_bitmap, + 1, 1, 0, + doc: /* Destroy fringe bitmap BITMAP. +If BITMAP overrides a standard fringe bitmap, the original bitmap is restored. */) + (bitmap) + Lisp_Object bitmap; +{ + int n; + Lisp_Object sym; + + n = resolve_fringe_bitmap (bitmap, &sym); + if (n < 0) + return Qnil; + + destroy_fringe_bitmap (n); + if (SYMBOLP (sym)) + { + Vfringe_bitmaps = Fdelq (sym, Vfringe_bitmaps); + /* It would be better to remove the fringe property. */ + Fput (sym, Qfringe, Qnil); + } return Qnil; } @@ -1082,7 +1183,7 @@ init_fringe_bitmap (which, fb, once_p) if (!once_p) { - Fdestroy_fringe_bitmap (make_number (which)); + destroy_fringe_bitmap (which); if (rif->define_fringe_bitmap) rif->define_fringe_bitmap (which, fb->bits, fb->height, fb->width); @@ -1095,26 +1196,32 @@ init_fringe_bitmap (which, fb, once_p) DEFUN ("define-fringe-bitmap", Fdefine_fringe_bitmap, Sdefine_fringe_bitmap, - 1, 5, 0, - doc: /* Define a fringe bitmap from BITS of height HEIGHT and width WIDTH. + 2, 5, 0, + doc: /* Define fringe bitmap BITMAP from BITS of size HEIGHT x WIDTH. +BITMAP is a symbol or string naming the new fringe bitmap. BITS is either a string or a vector of integers. HEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS. WIDTH must be an integer between 1 and 16, or nil which defaults to 8. -Optional fourth arg ALIGN may be one of `top', `center', or `bottom', +Optional fifth arg ALIGN may be one of `top', `center', or `bottom', indicating the positioning of the bitmap relative to the rows where it is used; the default is to center the bitmap. Fourth arg may also be a list (ALIGN PERIODIC) where PERIODIC non-nil specifies that the bitmap should be repeated. -Optional fifth argument WHICH is bitmap number to redefine. -Return new bitmap number, or nil of no more free bitmap slots. */) - (bits, height, width, align, which) - Lisp_Object bits, height, width, align, which; +If BITMAP already exists, the existing definition is replaced. */) + (bitmap, bits, height, width, align) + Lisp_Object bitmap, bits, height, width, align; { Lisp_Object len; int n, h, i, j; unsigned short *b; struct fringe_bitmap fb, *xfb; int fill1 = 0, fill2 = 0; + Lisp_Object sym; + + n = resolve_fringe_bitmap (bitmap, &sym); + + if (NILP (sym) || INTEGERP (sym)) + sym = wrong_type_argument (Qsymbolp, bitmap); if (!STRINGP (bits) && !VECTORP (bits)) bits = wrong_type_argument (Qstringp, bits); @@ -1167,7 +1274,7 @@ Return new bitmap number, or nil of no more free bitmap slots. */) else if (!NILP (align) && !EQ (align, Qcenter)) error ("Bad align argument"); - if (NILP (which)) + if (n < 0) { if (max_used_fringe_bitmap < MAX_FRINGE_BITMAPS) n = max_used_fringe_bitmap++; @@ -1179,16 +1286,11 @@ Return new bitmap number, or nil of no more free bitmap slots. */) if (fringe_bitmaps[n] == NULL) break; if (n == MAX_FRINGE_BITMAPS) - return Qnil; + error ("Cannot define more fringe bitmaps"); } - which = make_number (n); - } - else - { - CHECK_NUMBER (which); - n = XINT (which); - if (n <= NO_FRINGE_BITMAP || n >= MAX_FRINGE_BITMAPS) - error ("Invalid fringe bitmap number"); + + Vfringe_bitmaps = Fcons (sym, Vfringe_bitmaps); + Fput (sym, Qfringe, make_number (n)); } fb.dynamic = 1; @@ -1216,21 +1318,22 @@ Return new bitmap number, or nil of no more free bitmap slots. */) init_fringe_bitmap (n, xfb, 0); - return which; + return sym; } DEFUN ("set-fringe-bitmap-face", Fset_fringe_bitmap_face, Sset_fringe_bitmap_face, 1, 2, 0, - doc: /* Set face for fringe bitmap FRINGE-ID to FACE. + doc: /* Set face for fringe bitmap BITMAP to FACE. If FACE is nil, reset face to default fringe face. */) - (fringe_id, face) - Lisp_Object fringe_id, face; + (bitmap, face) + Lisp_Object bitmap, face; { + int bn; int face_id; - CHECK_NUMBER (fringe_id); - if (!valid_fringe_bitmap_id_p (XINT (fringe_id))) - error ("Invalid fringe id"); + bn = resolve_fringe_bitmap (bitmap, 0); + if (bn < 0) + error ("Undefined fringe bitmap"); if (!NILP (face)) { @@ -1241,7 +1344,7 @@ If FACE is nil, reset face to default fringe face. */) else face_id = FRINGE_FACE_ID; - fringe_faces [XINT (fringe_id)] = face_id; + fringe_faces [bn] = face_id; return Qnil; } @@ -1280,10 +1383,8 @@ Return nil if POS is not visible in WINDOW. */) row = MATRIX_FIRST_TEXT_ROW (w->current_matrix); row = row_containing_pos (w, textpos, row, NULL, 0); if (row) - return Fcons ((row->left_fringe_bitmap == NO_FRINGE_BITMAP - ? Qnil : make_number (row->left_fringe_bitmap)), - (row->right_fringe_bitmap == NO_FRINGE_BITMAP - ? Qnil : make_number (row->right_fringe_bitmap))); + return Fcons (get_fringe_bitmap_name (row->left_fringe_bitmap), + get_fringe_bitmap_name (row->right_fringe_bitmap)); else return Qnil; } @@ -1296,7 +1397,6 @@ Return nil if POS is not visible in WINDOW. */) void syms_of_fringe () { - defsubr (&Sdestroy_fringe_bitmap); defsubr (&Sdefine_fringe_bitmap); defsubr (&Sfringe_bitmaps_at_pos); @@ -1311,6 +1411,10 @@ is at the final newline, the cursor is shown in the right fringe. If nil, also continue lines which are exactly as wide as the window. */); Voverflow_newline_into_fringe = Qt; + DEFVAR_LISP ("fringe-bitmaps", &Vfringe_bitmaps, + doc: /* List of fringe bitmap symbols. +You must (require 'fringe) to use fringe bitmap symbols in your programs." */); + Vfringe_bitmaps = Qnil; } /* Initialize this module when Emacs starts. */