source: trunk/source/cocoa-ide/hemlock/src/font.lisp @ 12859

Last change on this file since 12859 was 12859, checked in by gz, 10 years ago

Make sure that all hemlock functions defined outside of hemlock are in the hemlock-ext package, to make it easier to keep track of them

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 KB
Line 
1;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
2;;;
3;;; **********************************************************************
4;;; This code was written as part of the CMU Common Lisp project at
5;;; Carnegie Mellon University, and has been placed in the public domain.
6;;;
7#+CMU (ext:file-comment
8  "$Header$")
9;;;
10;;; **********************************************************************
11;;;
12;;; Written by Rob MacLachlan
13;;; Modified by Bill Chiles toward Hemlock running under X.
14;;;
15;;;    This file contains various functions that make up the user interface to
16;;; fonts.
17;;;
18
19(in-package :hemlock-internals)
20
21;;;; Creating, Deleting, and Moving.
22
23(defun new-font-region (buffer start-mark end-mark  font)
24  (let* ((start-line (mark-line start-mark))
25         (end-line (mark-line end-mark))
26         (font-start (internal-make-font-mark start-line
27                                              (mark-charpos start-mark)
28                                              :right-inserting
29                                              font))
30         (font-end (internal-make-font-mark end-line
31                                              (mark-charpos end-mark)
32                                              :right-inserting
33                                              font))
34         (region (internal-make-font-region font-start font-end)))
35    (setf (font-mark-region font-start) region
36          (font-mark-region font-end) region)
37    (push font-start (line-marks start-line))
38    (push font-end (line-marks end-line))
39    (add-buffer-font-region buffer region)
40    (hemlock-ext:buffer-note-font-change buffer region font)
41    region))
42
43
44
45
46
47(defun font-mark (line charpos font &optional (kind :right-inserting))
48  "Returns a font on line at charpos with font.  Font marks must be permanent
49   marks."
50  (unless (or (eq kind :right-inserting) (eq kind :left-inserting))
51    (error "A Font-Mark must be :left-inserting or :right-inserting."))
52  (unless (and (>= font 0) (< font font-map-size))
53    (error "Font number ~S out of range." font))
54  (let ((new (internal-make-font-mark line charpos kind font)))
55    (new-font-mark new line)
56    (push new (line-marks line))
57    new))
58
59(defun delete-font-mark (font-mark)
60  "Deletes a font mark."
61  (check-type font-mark font-mark)
62  (let ((line (mark-line font-mark)))
63    (when line
64      (setf (line-marks line) (delq font-mark (line-marks line)))
65      (nuke-font-mark font-mark line)
66      (setf (mark-line font-mark) nil))))
67
68(defun delete-line-font-marks (line)
69  "Deletes all font marks on line."
70  (dolist (m (line-marks line))
71    (when (fast-font-mark-p m)
72      (delete-font-mark m))))
73
74(defun move-font-mark (font-mark new-position)
75  "Moves font mark font-mark to location of mark new-position."
76  (check-type font-mark font-mark)
77  (let ((old-line (mark-line font-mark))
78        (new-line (mark-line new-position)))
79    (nuke-font-mark font-mark old-line)
80    (move-mark font-mark new-position)
81    (new-font-mark font-mark new-line)
82    font-mark))
83
84(defun nuke-font-mark (mark line)
85  (new-font-mark mark line))
86
87(defun new-font-mark (mark line)
88  (declare (ignore mark line))
89)
90
Note: See TracBrowser for help on using the repository browser.