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

Diff of /src/clx/text.lisp

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

revision 1.2 by ram, Thu Nov 7 16:58:45 1991 UTC revision 1.3 by ram, Tue Aug 11 15:17:34 1992 UTC
# Line 68  Line 68 
68             (type (or null font) font)             (type (or null font) font)
69             (type vector dst)             (type vector dst)
70             (inline graphic-char-p))             (inline graphic-char-p))
71    (declare (values integer (or null integer font) (or null integer)))    (declare (clx-values integer (or null integer font) (or null integer)))
72    font ;;not used    font ;;not used
73    (if (stringp src)    (if (stringp src)
74        (do ((i src-start (index+ i 1))        (do ((i src-start (index+ i 1))
# Line 114  Line 114 
114             (dynamic-extent translate)             (dynamic-extent translate)
115             #+(and lispm (not clx-ansi-common-lisp))             #+(and lispm (not clx-ansi-common-lisp))
116             (sys:downward-funarg #+Genera * #-Genera translate))             (sys:downward-funarg #+Genera * #-Genera translate))
117    (declare (values width ascent descent left right    (declare (clx-values width ascent descent left right
118                    font-ascent font-descent direction                    font-ascent font-descent direction
119                    (or null array-index)))                    (or null array-index)))
120    (when (type? font 'gcontext)    (when (type? font 'gcontext)
# Line 221  Line 221 
221             (dynamic-extent translate)             (dynamic-extent translate)
222             #+(and lispm (not clx-ansi-common-lisp))             #+(and lispm (not clx-ansi-common-lisp))
223             (sys:downward-funarg #+Genera * #-Genera translate))             (sys:downward-funarg #+Genera * #-Genera translate))
224    (declare (values integer (or null integer)))    (declare (clx-values integer (or null integer)))
225    (when (type? font 'gcontext)    (when (type? font 'gcontext)
226      (force-gcontext-changes font)      (force-gcontext-changes font)
227      (setq font (gcontext-font font t)))      (setq font (gcontext-font font t)))
# Line 267  Line 267 
267    (declare (type font font)    (declare (type font font)
268             (type string string)             (type string string)
269             (type array-index start end))             (type array-index start end))
270    (declare (values width ascent descent left right font-ascent font-descent direction))    (declare (clx-values width ascent descent left right font-ascent font-descent direction))
271    (let ((display (font-display font))    (let ((display (font-display font))
272          (length (index- end start))          (length (index- end start))
273          (font-id (font-id font)))          (font-id (font-id font)))
# Line 294  Line 294 
294    (declare (type (or font gcontext) font)    (declare (type (or font gcontext) font)
295             (type string string)             (type string string)
296             (type array-index start end))             (type array-index start end))
297    (declare (values integer))    (declare (clx-values integer))
298    (let ((display (font-display font))    (let ((display (font-display font))
299          (length (index- end start))          (length (index- end start))
300          (font-id (font-id font)))          (font-id (font-id font)))
# Line 314  Line 314 
314             (type sequence sequence)             (type sequence sequence)
315             (type integer start end)             (type integer start end)
316             (type boolean width-only-p))             (type boolean width-only-p))
317    (declare (values width ascent descent overall-left overall-right))    (declare (clx-values width ascent descent overall-left overall-right))
318    (let* ((char-infos (font-char-infos font))    (let* ((char-infos (font-char-infos font))
319           (font-info (font-font-info font)))           (font-info (font-font-info font)))
320      (declare (type font-info font-info))      (declare (type font-info font-info))
321      (declare (type (simple-array int16 (*)) char-infos)      (declare (type (simple-array int16 (*)) char-infos))
              (array-register char-infos))  
322      (if (zerop (length char-infos))      (if (zerop (length char-infos))
323          ;; Fixed width font          ;; Fixed width font
324          (let* ((font-width (max-char-width font))          (let* ((font-width (max-char-width font))
# Line 466  Line 465 
465             (dynamic-extent translate)             (dynamic-extent translate)
466             #+(and lispm (not clx-ansi-common-lisp))             #+(and lispm (not clx-ansi-common-lisp))
467             (sys:downward-funarg #+Genera * #-Genera translate))             (sys:downward-funarg #+Genera * #-Genera translate))
468    (declare (values boolean (or null int32)))    (declare (clx-values boolean (or null int32)))
469    (let* ((display (gcontext-display gcontext))    (let* ((display (gcontext-display gcontext))
470           (result t)           (result t)
471           (opcode *x-polytext8*))           (opcode *x-polytext8*))
# Line 517  Line 516 
516             (dynamic-extent translate)             (dynamic-extent translate)
517             #+(and lispm (not clx-ansi-common-lisp))             #+(and lispm (not clx-ansi-common-lisp))
518             (sys:downward-funarg #+Genera * #-Genera translate))             (sys:downward-funarg #+Genera * #-Genera translate))
519    (declare (values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
520    (unless end (setq end (length sequence)))    (unless end (setq end (length sequence)))
521    (ecase size    (ecase size
522      ((:default 8) (draw-glyphs8 drawable gcontext x y sequence start end      ((:default 8) (draw-glyphs8 drawable gcontext x y sequence start end
# Line 535  Line 534 
534             (type sequence sequence)             (type sequence sequence)
535             (type (or null array-index) end)             (type (or null array-index) end)
536             (type (or null int32) width))             (type (or null int32) width))
537    (declare (values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
538    (declare (type translation-function translate)    (declare (type translation-function translate)
539             #+clx-ansi-common-lisp             #+clx-ansi-common-lisp
540             (dynamic-extent translate)             (dynamic-extent translate)
# Line 638  Line 637 
637             (type sequence sequence)             (type sequence sequence)
638             (type (or null array-index) end)             (type (or null array-index) end)
639             (type (or null int32) width))             (type (or null int32) width))
640    (declare (values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
641    (declare (type translation-function translate)    (declare (type translation-function translate)
642             #+clx-ansi-common-lisp             #+clx-ansi-common-lisp
643             (dynamic-extent translate)             (dynamic-extent translate)
# Line 747  Line 746 
746             (dynamic-extent translate)             (dynamic-extent translate)
747             #+(and lispm (not clx-ansi-common-lisp))             #+(and lispm (not clx-ansi-common-lisp))
748             (sys:downward-funarg #+Genera * #-Genera translate))             (sys:downward-funarg #+Genera * #-Genera translate))
749    (declare (values boolean (or null int32)))    (declare (clx-values boolean (or null int32)))
750    (let* ((display (gcontext-display gcontext))    (let* ((display (gcontext-display gcontext))
751           (result t)           (result t)
752           (opcode *x-imagetext8*))           (opcode *x-imagetext8*))
# Line 803  Line 802 
802             (dynamic-extent translate)             (dynamic-extent translate)
803             #+(and lispm (not clx-ansi-common-lisp))             #+(and lispm (not clx-ansi-common-lisp))
804             (sys:downward-funarg #+Genera * #-Genera translate))             (sys:downward-funarg #+Genera * #-Genera translate))
805    (declare (values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
806    (setf end (index-min (index+ start 255) (or end (length sequence))))    (setf end (index-min (index+ start 255) (or end (length sequence))))
807    (ecase size    (ecase size
808      ((:default 8)      ((:default 8)
# Line 831  Line 830 
830             (dynamic-extent translate)             (dynamic-extent translate)
831             #+(and lispm (not clx-ansi-common-lisp))             #+(and lispm (not clx-ansi-common-lisp))
832             (sys:downward-funarg translate))             (sys:downward-funarg translate))
833    (declare (values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
834    (do* ((display (gcontext-display gcontext))    (do* ((display (gcontext-display gcontext))
835          (length (index- end start))          (length (index- end start))
836          ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...          ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...
# Line 897  Line 896 
896             (dynamic-extent translate)             (dynamic-extent translate)
897             #+(and lispm (not clx-ansi-common-lisp))             #+(and lispm (not clx-ansi-common-lisp))
898             (sys:downward-funarg translate))             (sys:downward-funarg translate))
899    (declare (values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
900    (do* ((display (gcontext-display gcontext))    (do* ((display (gcontext-display gcontext))
901          (length (index- end start))          (length (index- end start))
902          ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...          ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...
# Line 952  Line 951 
951    
952  (defun display-keycode-range (display)  (defun display-keycode-range (display)
953    (declare (type display display))    (declare (type display display))
954    (declare (values min max))    (declare (clx-values min max))
955    (values (display-min-keycode display)    (values (display-min-keycode display)
956            (display-max-keycode display)))            (display-max-keycode display)))
957    
# Line 965  Line 964 
964    ;; Setf ought to allow multiple values.    ;; Setf ought to allow multiple values.
965    (declare (type display display)    (declare (type display display)
966             (type sequence shift lock control mod1 mod2 mod3 mod4 mod5))             (type sequence shift lock control mod1 mod2 mod3 mod4 mod5))
967    (declare (values (member :success :busy :failed)))    (declare (clx-values (member :success :busy :failed)))
968    (let* ((keycodes-per-modifier (index-max (length shift)    (let* ((keycodes-per-modifier (index-max (length shift)
969                                             (length lock)                                             (length lock)
970                                             (length control)                                             (length control)
# Line 993  Line 992 
992  (defun modifier-mapping (display)  (defun modifier-mapping (display)
993    ;; each value is a list of integers    ;; each value is a list of integers
994    (declare (type display display))    (declare (type display display))
995    (declare (values shift lock control mod1 mod2 mod3 mod4 mod5))    (declare (clx-values shift lock control mod1 mod2 mod3 mod4 mod5))
996    (let ((lists nil))    (let ((lists nil))
997      (with-buffer-request-and-reply (display *x-getmodifiermapping* nil :sizes 8)      (with-buffer-request-and-reply (display *x-getmodifiermapping* nil :sizes 8)
998           ()           ()
# Line 1059  Line 1058 
1058             (type (or null card8) first-keycode)             (type (or null card8) first-keycode)
1059             (type (or null array-index) start end)             (type (or null array-index) start end)
1060             (type (or null (array * (* *))) data))             (type (or null (array * (* *))) data))
1061    (declare (values (array * (* *))))    (declare (clx-values (array * (* *))))
1062    (unless first-keycode (setq first-keycode (display-min-keycode display)))    (unless first-keycode (setq first-keycode (display-min-keycode display)))
1063    (unless start (setq start first-keycode))    (unless start (setq start first-keycode))
1064    (unless end (setq end (1+ (display-max-keycode display))))    (unless end (setq end (1+ (display-max-keycode display))))

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

  ViewVC Help
Powered by ViewVC 1.1.5