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

Last change on this file since 8428 was 8428, checked in by gz, 12 years ago

Merge of the 'event-ide' branch. Hemlock's thread model has been changed
so that Hemlock commands now run in the Cocoa event thread -- see the
Hemlock file view.lisp for an overview.

IDE compilation has also been reorganized. Hemlock is now more fully
integrated into the IDE and cannot be compiled separately, sorry.

The hemlock-ext package has been repurposed to contain all interfaces
to window-system specific functionality.

There are also many many assorted other changes, cleanups and fixes.

The Hemlock documentation (Hemlock Command Implementor's Manual) in
http://trac.clozure.com/openmcl/wiki now correctly reflects the
implementation, although it doesn't (yet) describe the integration
with Cocoa or the threading model.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 KB
RevLine 
[6]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
[799]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)
[6599]40    (buffer-note-font-change buffer region font)
[799]41    region))
42
43
44
45
46
[6]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)
[799]88  (declare (ignore mark line))
89)
[6]90
Note: See TracBrowser for help on using the repository browser.