Changeset 12572


Ignore:
Timestamp:
Aug 12, 2009, 8:52:05 PM (10 years ago)
Author:
rme
Message:

In charpropos-to-dict: #/convertFont:toHaveTrait: can only do one
trait at a time, so don't try save up a mask of traits to apply all at
once. Process :font-color and :background-color charprops.

ns-color-from-charprop: New function. Only knows about the "#aabbcc"
format for specifying colors.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock-text.lisp

    r12558 r12572  
    327327          (format nil "#~2,'0x~2,'0x~2,'0x" rr gg bb))))))
    328328
     329(defvar *charprop-colors* (make-hash-table :test #'equalp))
     330
     331(defun ns-color-from-charprop (color-string)
     332  (or (gethash color-string *charprop-colors*)
     333      (when (and (= (length color-string) 7)
     334                 (char= (char color-string 0) #\#))
     335        (let* ((rr (ignore-errors (parse-integer color-string :start 1 :end 3 :radix 16)))
     336               (gg (ignore-errors (parse-integer color-string :start 3 :end 5 :radix 16)))
     337               (bb (ignore-errors (parse-integer color-string :start 5 :end 7 :radix 16)))
     338               (aa (cgfloat 1)))
     339          (when (and rr gg bb)
     340            (setq rr (cgfloat (/ rr 255.0))
     341                  gg (cgfloat (/ gg 255.0))
     342                  bb (cgfloat (/ bb 255.0)))
     343            (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color
     344                                                        rr gg bb aa))))))
    329345(defun dict-to-charprops (dict)
    330346  (let ((enumerator (#/keyEnumerator dict))
     
    402418         (default-font *editor-font*)   ;what about listeners?
    403419         (fm (#/sharedFontManager ns:ns-font-manager))
    404          (traits 0)
    405420         (font +null-ptr+)
    406421         (font-name nil))
     
    420435    (loop for (k v) on plist by #'cddr
    421436      do (case k
    422            (:font-size (setq v (float v ns:+cgfloat-zero+))
    423                        (setq font (#/convertFont:toSize: fm font v)))
    424            (:font-weight (cond ((eq v :bold)
    425                                 (setq traits (logior traits #$NSBoldFontMask)))
    426                                ((eq v :plain)
    427                                 (setq traits (logior traits #$NSUnboldFontMask)))))
    428            (:font-width (cond ((eq v :condensed)
    429                                (setq traits (logior traits #$NSCondensedFontMask)))
    430                               ((eq v :expanded)
    431                                (setq traits (logior traits #$NSExpandedFontMask)))))
    432            (:font-slant (cond ((eq v :italic)
    433                                (setq traits (logior traits #$NSItalicFontMask)))
    434                               ((eq v :roman)
    435                                (setq traits (logior traits #$NSUnitalicFontMask)))))
    436            (:font-underline (let (n)
    437                               (case v
    438                                 (:single
    439                                  (setq n (#/numberWithInt: ns:ns-number #$NSUnderlineStyleSingle)))
    440                                 (:double
    441                                  (setq n (#/numberWithInt: ns:ns-number #$NSUnderlineStyleDouble)))
    442                                 (:thick
    443                                  (setq n (#/numberWithInt: ns:ns-number #$NSUnderlineStyleThick))))
    444                               (when n
    445                                 (#/setObject:forKey: dict n #&NSUnderlineStyleAttributeName))))
    446            (:font-color)
    447            (:background-color)))
    448     (setq font (#/convertFont:toHaveTrait: fm font traits))
     437           (:font-size
     438            (setq v (float v ns:+cgfloat-zero+))
     439            (setq font (#/convertFont:toSize: fm font v)))
     440           (:font-weight
     441            (cond
     442              ((eq v :bold)
     443               (setq font (#/convertFont:toHaveTrait: fm font #$NSBoldFontMask)))
     444              ((eq v :plain)
     445               (setq font (#/convertFont:toHaveTrait: fm font #$NSUnboldFontMask)))))
     446           (:font-width
     447            (cond
     448              ((eq v :condensed)
     449               (setq font (#/convertFont:toHaveTrait: fm font #$NSCondensedFontMask)))
     450              ((eq v :expanded)
     451               (setq font (#/convertFont:toHaveTrait: fm font #$NSExpandedFontMask)))))
     452           (:font-slant
     453            (cond ((eq v :italic)
     454                   (setq font (#/convertFont:toHaveTrait: fm font #$NSItalicFontMask)))
     455                  ((eq v :roman)
     456                   (setq font (#/convertFont:toHaveTrait: fm font #$NSUnitalicFontMask)))))
     457           (:font-underline
     458            (let (n)
     459              (case v
     460                (:single
     461                 (setq n (#/numberWithInt: ns:ns-number #$NSUnderlineStyleSingle)))
     462                (:double
     463                 (setq n (#/numberWithInt: ns:ns-number #$NSUnderlineStyleDouble)))
     464                (:thick
     465                 (setq n (#/numberWithInt: ns:ns-number #$NSUnderlineStyleThick))))
     466              (when n
     467                (#/setObject:forKey: dict n #&NSUnderlineStyleAttributeName))))
     468           (:font-color
     469            (let ((color (ns-color-from-charprop v)))
     470              (when color
     471                (#/setObject:forKey: dict color #&NSForegroundColorAttributeName))))
     472           (:background-color
     473            (let ((color (ns-color-from-charprop v)))
     474              (when color
     475                (#/setObject:forKey: dict color #&NSBackgroundColorAttributeName))))))
    449476    (unless (%null-ptr-p font)
    450477      (#/setObject:forKey: dict font #&NSFontAttributeName))
Note: See TracChangeset for help on using the changeset viewer.