/[cmucl]/src/clx/fonts.lisp
ViewVC logotype

Diff of /src/clx/fonts.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by ram, Thu Nov 7 16:57:53 1991 UTC revision 1.3 by ram, Tue Aug 11 15:16:26 1992 UTC
# Line 31  Line 31 
31  ;  ;; signalling might be better.  ;  ;; signalling might be better.
32  ;  (declare (type font font)  ;  (declare (type font font)
33  ;          (type integer index)  ;          (type integer index)
34  ;          (values (or null integer))))  ;          (clx-values (or null integer))))
35    
36  ;(defun max-char-<metric> (font)  ;(defun max-char-<metric> (font)
37  ;  ;; Note: I have tentatively chosen separate accessors over allowing :min and  ;  ;; Note: I have tentatively chosen separate accessors over allowing :min and
38  ;  ;; :max as an index above.  ;  ;; :max as an index above.
39  ;  (declare (type font font)  ;  (declare (type font font)
40  ;          (values integer)))  ;          (clx-values integer)))
41    
42  ;(defun min-char-<metric> (font)  ;(defun min-char-<metric> (font)
43  ;  (declare (type font font)  ;  (declare (type font font)
44  ;          (values integer)))  ;          (clx-values integer)))
45    
46  ;; Note: char16-<metric> accessors could be defined to accept two-byte indexes.  ;; Note: char16-<metric> accessors could be defined to accept two-byte indexes.
47    
# Line 64  Line 64 
64                         `(defun ,name (font index)                         `(defun ,name (font index)
65                            (declare (type font font)                            (declare (type font font)
66                                     (type array-index index))                                     (type array-index index))
67                            (declare (values (or null ,type)))                            (declare (clx-values (or null ,type)))
68                            (when (and (font-name font)                            (when (and (font-name font)
69                                       (index>= (font-max-char font) index (font-min-char font)))                                       (index>= (font-max-char font) index (font-min-char font)))
70                              (the ,type                              (the ,type
# Line 91  Line 91 
91                       (push                       (push
92                         `(defun ,name (font)                         `(defun ,name (font)
93                            (declare (type font font))                            (declare (type font font))
94                            (declare (values (or null ,type)))                            (declare (clx-values (or null ,type)))
95                            (when (font-name font)                            (when (font-name font)
96                              (the ,type                              (the ,type
97                                   ,(from                                   ,(from
# Line 103  Line 103 
103                       (push                       (push
104                         `(defun ,name (font)                         `(defun ,name (font)
105                            (declare (type font font))                            (declare (type font font))
106                            (declare (values (or null ,type)))                            (declare (clx-values (or null ,type)))
107                            (when (font-name font)                            (when (font-name font)
108                              (the ,type                              (the ,type
109                                   ,(from                                   ,(from
# Line 119  Line 119 
119                                  fields))                                  fields))
120                   (declare ,@(mapcar #'(lambda (field) `(type ,@(reverse field))) fields))                   (declare ,@(mapcar #'(lambda (field) `(type ,@(reverse field))) fields))
121                   (let ((result (make-array ,(length fields) :element-type 'int16)))                   (let ((result (make-array ,(length fields) :element-type 'int16)))
122                     (declare (type char-info-vec result)                     (declare (type char-info-vec result))
                             (array-register result))  
123                     ,@(do* ((field fields (cdr field))                     ,@(do* ((field fields (cdr field))
124                             (var (caar field) (caar field))                             (var (caar field) (caar field))
125                             (type (cadar field) (cadar field))                             (type (cadar field) (cadar field))
# Line 147  Line 146 
146    ;; The protocol QueryFont request happens on-demand under the covers.    ;; The protocol QueryFont request happens on-demand under the covers.
147    (declare (type display display)    (declare (type display display)
148             (type stringable name))             (type stringable name))
149    (declare (values font))    (declare (clx-values font))
150    (let* ((name-string (string-downcase (string name)))    (let* ((name-string (string-downcase (string name)))
151           (font (car (member name-string (display-font-cache display)           (font (car (member name-string (display-font-cache display)
152                              :key 'font-name                              :key 'font-name
# Line 169  Line 168 
168  (defun open-font-internal (font)  (defun open-font-internal (font)
169    ;; Called "under the covers" to open a font object    ;; Called "under the covers" to open a font object
170    (declare (type font font))    (declare (type font font))
171    (declare (values resource-id))    (declare (clx-values resource-id))
172    (let* ((name-string (font-name font))    (let* ((name-string (font-name font))
173           (display (font-display font))           (display (font-display font))
174           (id (allocate-resource-id display font 'font)))           (id (allocate-resource-id display font 'font)))
# Line 193  Line 192 
192  (defun query-font (font)  (defun query-font (font)
193    ;; Internal function called by font and char info accessors    ;; Internal function called by font and char info accessors
194    (declare (type font font))    (declare (type font font))
195    (declare (values font-info))    (declare (clx-values font-info))
196    (let ((display (font-display font))    (let ((display (font-display font))
197          font-id          font-id
198          font-info          font-info
# Line 258  Line 257 
257             (type string pattern)             (type string pattern)
258             (type card16 max-fonts)             (type card16 max-fonts)
259             (type t result-type)) ;; CL type             (type t result-type)) ;; CL type
260    (declare (values (sequence string)))    (declare (clx-values (clx-sequence string)))
261    (let ((string (string pattern)))    (let ((string (string pattern)))
262      (with-buffer-request-and-reply (display *x-listfonts* size :sizes (8 16))      (with-buffer-request-and-reply (display *x-listfonts* size :sizes (8 16))
263           ((card16 max-fonts (length string))           ((card16 max-fonts (length string))
# Line 278  Line 277 
277             (type string pattern)             (type string pattern)
278             (type card16 max-fonts)             (type card16 max-fonts)
279             (type t result-type)) ;; CL type             (type t result-type)) ;; CL type
280    (declare (values (sequence font)))    (declare (clx-values (clx-sequence font)))
281    (let ((string (string pattern))    (let ((string (string pattern))
282          (result nil))          (result nil))
283      (with-buffer-request-and-reply (display *x-listfontswithinfo* 60      (with-buffer-request-and-reply (display *x-listfontswithinfo* 60
# Line 331  Line 330 
330  (defun font-path (display &key (result-type 'list))  (defun font-path (display &key (result-type 'list))
331    (declare (type display display)    (declare (type display display)
332             (type t result-type)) ;; CL type             (type t result-type)) ;; CL type
333    (declare (values (sequence (or string pathname))))    (declare (clx-values (clx-sequence (or string pathname))))
334    (with-buffer-request-and-reply (display *x-getfontpath* size :sizes (8 16))    (with-buffer-request-and-reply (display *x-getfontpath* size :sizes (8 16))
335         ()         ()
336      (values      (values
# Line 340  Line 339 
339    
340  (defun set-font-path (display paths)  (defun set-font-path (display paths)
341    (declare (type display display)    (declare (type display display)
342             (type sequence paths)) ;; (sequence (or string pathname))             (type (clx-sequence (or string pathname)) paths))
343    (let ((path-length (length paths))    (let ((path-length (length paths))
344          (request-length 8))          (request-length 8))
345      ;; Find the request length      ;; Find the request length

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.5