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

Last change on this file 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.