Changeset 7533


Ignore:
Timestamp:
Oct 28, 2007, 2:03:38 AM (14 years ago)
Author:
rme
Message:

Beautify modeline.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/cocoa-ide/cocoa-editor.lisp

    r7532 r7533  
    12471247;;; the current values of the buffer's modeline fields.
    12481248
     1249(defparameter *modeline-grays* #(255 255 253 247 242 236 231
     1250                                 224 229 234 239 245 252 255))
     1251
     1252(defloadvar *modeline-pattern-image* nil)
     1253
     1254(defun create-modeline-pattern-image ()
     1255  (let* ((n (length *modeline-grays*)))
     1256    (multiple-value-bind (samples-array samples-macptr)
     1257        (make-heap-ivector n '(unsigned-byte 8))
     1258      (dotimes (i n)
     1259        (setf (aref samples-array i) (aref *modeline-grays* i)))
     1260      (rlet ((p :address samples-macptr))
     1261        (let* ((rep (make-instance 'ns:ns-bitmap-image-rep
     1262                                   :with-bitmap-data-planes p
     1263                                   :pixels-wide 1
     1264                                   :pixels-high n
     1265                                   :bits-per-sample 8
     1266                                   :samples-per-pixel 1
     1267                                   :has-alpha #$NO
     1268                                   :is-planar #$NO
     1269                                   :color-space-name #&NSDeviceWhiteColorSpace
     1270                                   :bytes-per-row 1
     1271                                   :bits-per-pixel 8))
     1272               (image (make-instance 'ns:ns-image
     1273                                     :with-size (ns:make-ns-size 1 n))))
     1274          (#/addRepresentation: image rep)
     1275          (#/release rep)
     1276          (setf *modeline-pattern-image* image))))))
     1277
    12491278(defclass modeline-view (ns:ns-view)
    12501279    ((pane :foreign-type :id :accessor modeline-view-pane)
     
    12521281  (:metaclass ns:+ns-object))
    12531282
     1283(objc:defmethod #/initWithFrame: ((self modeline-view) (frame :<NSR>ect))
     1284  (call-next-method frame)
     1285  (unless *modeline-pattern-image*
     1286    (create-modeline-pattern-image))
     1287  (let* ((size (#/smallSystemFontSize ns:ns-font))
     1288         (font (#/systemFontOfSize: ns:ns-font size))
     1289         (dict (#/dictionaryWithObject:forKey: ns:ns-dictionary font #&NSFontAttributeName)))
     1290    (setf (modeline-text-attributes self) (#/retain dict)))
     1291  self)
    12541292
    12551293;;; Attributes to use when drawing the modeline fields.  There's no
     
    12811319    (let* ((buffer (buffer-for-modeline-view the-modeline-view)))
    12821320      (when buffer
    1283         ;; You donn't want to know why this is done this way.
    1284         ;; Sure I do.  Let's see what happens.
    1285         #+nil
    1286         (when (%null-ptr-p text-attributes)
    1287           (setq text-attributes
    1288                 (create-text-attributes :color (#/whiteColor ns:ns-color)
    1289                                         :font (default-font
    1290                                                 :name *modeline-font-name*
    1291                                                 :size *modeline-font-size*))))
    1292         (unless (%null-ptr-p text-attributes)
    1293           (#/release text-attributes))
    1294         (setq text-attributes
    1295               (create-text-attributes :color (#/whiteColor ns:ns-color)
    1296                                       :font (default-font
    1297                                               :name *modeline-font-name*
    1298                                               :size *modeline-font-size*)))
    1299         (let* ((string
     1321        (let* ((string
    13001322                (apply #'concatenate 'string
    13011323                       (mapcar
     
    13031325                            (funcall (hi::modeline-field-function field)
    13041326                                     buffer pane))
    1305                         (hi::buffer-modeline-fields buffer))))
    1306                (s (%make-nsstring string))
    1307                (view-height (ns:ns-rect-height (#/frame the-modeline-view)))
    1308                (size (#/sizeWithAttributes: s text-attributes))
    1309                (string-height (ns:ns-size-height size))
    1310                (y (- view-height string-height)))
    1311           (if (minusp y)
    1312             (setq y 0.0)
    1313             (setq y (/ y 2.0)))
    1314           (#/drawAtPoint:withAttributes: (%make-nsstring string)
    1315                                          (ns:make-ns-point 2 y)
     1327                        (hi::buffer-modeline-fields buffer)))))
     1328          (#/drawAtPoint:withAttributes: (%make-nsstring string)
     1329                                         (ns:make-ns-point 5 1)
    13161330                                         text-attributes))))))
    13171331
     
    13201334(objc:defmethod (#/drawRect: :void) ((self modeline-view) (rect :<NSR>ect))
    13211335  (declare (ignorable rect))
    1322   (let* ((frame (#/bounds self))
    1323          (path (#/bezierPath ns:ns-bezier-path)))
     1336  (let* ((bounds (#/bounds self))
     1337         (context (#/currentContext ns:ns-graphics-context)))
     1338    (#/saveGraphicsState context)
     1339    (ns:with-ns-point (p0 0 (ns:ns-rect-height bounds))
     1340      (let ((p1 (#/convertPoint:toView: self p0 +null-ptr+)))
     1341        (#/setPatternPhase: context p1)))
     1342    (#/set (#/colorWithPatternImage: ns:ns-color *modeline-pattern-image*))
     1343    (#_NSRectFill bounds)
     1344    (#/set (#/colorWithCalibratedWhite:alpha: ns:ns-color 0.3333 1.0))
     1345    (ns:with-ns-rect (r 0 0.5 (ns:ns-rect-width bounds) 0.5)
     1346      (#_NSRectFill r))
     1347    (ns:with-ns-rect (r 0 (- (ns:ns-rect-height bounds) 0.5)
     1348                        (ns:ns-rect-width bounds) (- (ns:ns-rect-height bounds) 0.5))
     1349      (#_NSRectFill r))
    13241350    (#/set (#/blackColor ns:ns-color))
    1325     (#_NSRectFill frame)
    1326     (draw-modeline-string self)))
     1351    (draw-modeline-string self)
     1352    (#/restoreGraphicsState context)))
    13271353
    13281354;;; Hook things up so that the modeline is updated whenever certain buffer
Note: See TracChangeset for help on using the changeset viewer.