Changeset 617


Ignore:
Timestamp:
Mar 6, 2004, 9:47:08 AM (17 years ago)
Author:
gb
Message:

Random changes; still barely functional.

Location:
trunk/ccl
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/examples/cocoa-defaults.lisp

    r610 r617  
    1 ;;;-*- Mode: LISP; Package: CCL -*-
    2 
    31;;;-*-Mode: LISP; Package: CCL -*-
    42;;;
     
    2018
    2119(eval-when (:compile-toplevel :execute)
    22   (use-interface-dir :cocoa))
     20  (use-interface-dir :cocoa)
     21  (use-interface-dir :carbon))
    2322
    2423(require "OBJC-SUPPORT")
     
    6059  (record-source-file name 'variable)
    6160  (setf (documentation name 'variable) doc)
    62   (set name (set-cocoa-default name (ns-constant-string (string-downcase name)) type value doc))
     61  (set name (set-cocoa-default name (ns-constant-string (string name)) type value doc))
    6362  name)
    6463 
     
    7675      (let* ((name (cocoa-default-symbol d))
    7776             (key (objc-constant-string-nsstringptr (cocoa-default-string d))))
    78         (case (cocoa-default-type d)
    79           (:int
    80            (set name (send domain :integer-for-key key)))
    81           (:float
    82            (set name (send domain :float-for-key key)))
    83           (:string
    84            (let* ((nsstring (send domain :string-for-key key)))
    85              (unless (%null-ptr-p nsstring)
    86                (set name (lisp-string-from-nsstring nsstring))))))))))
     77        (if (%null-ptr-p (send domain :object-for-key key))
     78          (send domain
     79                :set-object (%make-nsstring (format nil "~a" (cocoa-default-value d)))
     80                :for-key key)
     81          (case (cocoa-default-type d)
     82            (:int
     83             (set name (send domain :integer-for-key key)))
     84            (:float
     85             (set name (send domain :float-for-key key)))
     86            (:string
     87             (let* ((nsstring (send domain :string-for-key key)))
     88               (unless (%null-ptr-p nsstring)
     89                 (set name (lisp-string-from-nsstring nsstring)))))))))
     90    (send domain 'synchronize)
     91    (send domain 'dictionary-representation)))
    8792
    88 (defun register-cocoa-defaults ()
    89   (let* ((domain (send (@class "NSUserDefaults") 'standard-user-defaults))
    90          (defaults (cocoa-defaults))
    91          (dict (make-objc-instance 'ns:ns-mutable-dictionary
    92                                    :with-capacity (length defaults))))
    93     (dolist (d defaults)
    94       (let* ((key (objc-constant-string-nsstringptr (cocoa-default-string d)))
    95              (value (%make-nsstring (format nil "~a" (cocoa-default-value d)))))
    96         (send dict :set-value value :for-key key)))
    97     (break "dict = ~s" dict)
    98     (send domain :register-defaults dict)
    99     (send domain 'synchronize)))
     93
    10094 
    10195                                   
  • trunk/ccl/examples/cocoa-editor.lisp

    r611 r617  
    1010(eval-when (:compile-toplevel :execute)
    1111  (use-interface-dir :cocoa))
     12
     13(def-cocoa-default *editor-rows* :int 24)
     14(def-cocoa-default *editor-columns* :int 80)
     15
     16;;; At runtime, this'll be a vector of character attribute dictionaries.
     17(defloadvar *styles* ())
     18
     19(defun make-editor-style-map ()
     20  (let* ((font-name *default-font-name*)
     21         (font-size *default-font-size*)
     22         (fonts (vector (default-font :name font-name :size font-size
     23                                      :attributes ())
     24                        (default-font :name font-name :size font-size
     25                                      :attributes '(:bold))
     26                        (default-font  :name font-name :size font-size
     27                                      :attributes '(:italic))
     28                        (default-font :name font-name :size font-size
     29                                      :attributes '(:bold :italic))))
     30         (color-class (find-class 'ns:ns-color))
     31         (colors (vector (send color-class 'black-color)
     32                         (send color-class 'white-color)
     33                         (send color-class 'dark-gray-color)
     34                         (send color-class 'light-gray-color)
     35                         (send color-class 'red-color)
     36                         (send color-class 'blue-color)
     37                         (send color-class 'green-color)
     38                         (send color-class 'yellow-color)))
     39         (styles (make-array (the fixnum (* (length fonts) (length colors)))))
     40         (s 0))
     41    (declare (dynamic-extent fonts colors))
     42    (dotimes (c (length colors))
     43      (dotimes (f (length fonts))
     44        (setf (svref styles s) (create-text-attributes :font (svref fonts f)
     45                                                       :color (svref colors c)))
     46        (incf s)))
     47    (setq *styles* styles)))
    1248
    1349(defun make-hemlock-buffer (&rest args)
     
    88124  workline-offset                       ; cached offset of workline
    89125  workline-length                       ; length of cached workline
     126  workline-start-font-index             ; current font index at start of worklin
    90127  )
    91128
     
    103140          (buffer-cache-workline-offset d) 0
    104141          (buffer-cache-workline d) workline
    105           (buffer-cache-workline-length d) (hemlock::line-length workline))
     142          (buffer-cache-workline-length d) (hemlock::line-length workline)
     143          (buffer-cache-workline-start-font-index d) 0)
    106144    d))
    107145
     
    246284;;; Lisp-text-storage objects
    247285(defclass lisp-text-storage (ns:ns-text-storage)
    248     ((string :foreign-type :id)
    249      (defaultattrs :foreign-type :id))
     286    ((string :foreign-type :id))
    250287  (:metaclass ns:+ns-object))
    251288
     
    257294(define-objc-method ((:id :init-with-string s) lisp-text-storage)
    258295  (let* ((newself (send-super 'init)))
    259     (setf (slot-value newself 'string) s
    260           (slot-value newself 'defaultattrs) (create-text-attributes))
     296    (setf (slot-value newself 'string) s)
    261297    newself))
    262298
     
    285321      (setf (pref rangeptr :<NSR>ange.location) 0
    286322            (pref rangeptr :<NSR>ange.length) len))
    287     (slot-value self 'defaultattrs)))
     323    (svref *styles* 0)))
    288324
    289325;;; The range's origin should probably be the buffer's point; if
     
    581617
    582618
    583 (defun make-scrolling-text-view-for-textstorage (textstorage x y width height)
     619(defun make-scrolling-text-view-for-textstorage (textstorage x y width height tracks-width)
    584620  (slet ((contentrect (ns-make-rect x y width height)))
    585621    (let* ((scrollview (send (make-objc-instance
     
    623659              (send tv :set-vertically-resizable t)
    624660              (send tv :set-autoresizing-mask #$NSViewWidthSizable)
    625               (send container :set-width-tracks-text-view nil)
     661              (send container :set-width-tracks-text-view tracks-width)
    626662              (send container :set-height-tracks-text-view nil)
    627663              (send scrollview :set-document-view tv)         
    628664              (values tv scrollview))))))))
    629665
    630 (defun make-scrolling-textview-for-pane (pane textstorage)
     666(defun make-scrolling-textview-for-pane (pane textstorage track-widht)
    631667  (slet ((contentrect (send (send pane 'content-view) 'frame)))
    632668    (multiple-value-bind (tv scrollview)
     
    636672         (pref contentrect :<NSR>ect.origin.y)
    637673         (pref contentrect :<NSR>ect.size.width)
    638          (pref contentrect :<NSR>ect.size.height))
     674         (pref contentrect :<NSR>ect.size.height)
     675         track-widht)
    639676      (send pane :set-content-view scrollview)
    640677      (setf (slot-value pane 'scroll-view) scrollview
     
    747784                                       
    748785                                     
    749 (defun textpane-for-textstorage (ts)
     786(defun textpane-for-textstorage (ts ncols nrows container-tracks-text-view-width)
    750787  (let* ((pane (nth-value
    751788                1
    752789                (new-hemlock-document-window :activate nil)))
    753          (tv (make-scrolling-textview-for-pane pane ts)))
     790         (tv (make-scrolling-textview-for-pane pane ts container-tracks-text-view-width)))
    754791    (multiple-value-bind (height width)
    755792        (size-of-char-in-font (default-font))
    756       (size-textview-containers tv height width 24 80))
     793      (size-textview-containers tv height width nrows ncols))
    757794    pane))
    758795
     
    841878
    842879;;; This function must run in the main event thread.
    843 (defun %hemlock-frame-for-textstorage (ts title activate)
    844   (let* ((pane (textpane-for-textstorage ts))
    845          (w (send pane 'window)))
    846     (when title (send w :set-title (%make-nsstring title)))
    847     (when activate (activate-window w))
    848     w))
    849 
    850 (defun hemlock-frame-for-textstorage (ts title activate)
     880(defun %hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width)
     881  (let* ((pane (textpane-for-textstorage ts ncols nrows container-tracks-text-view-width)))
     882    (send pane 'window)))
     883
     884
     885(defun hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width)
    851886  (process-interrupt *cocoa-event-process*
    852887                     #'%hemlock-frame-for-textstorage
    853                      ts title activate))
     888                     ts  ncols nrows container-tracks-text-view-width))
    854889
    855890
     
    911946            (decf pos n))
    912947          #+debug
    913           (format t "~&pos = ~d, n = ~d" pos n)
     948          (format t "~&insert: pos = ~d, n = ~d" pos n)
    914949          (let* ((display (hemlock-buffer-string-cache (send textstorage 'string))))
    915950            (reset-buffer-cache display)
     
    930965          (force-output)
    931966          (send textstorage
    932                 :edited #$NSTextStorageEditedAttributes
     967                :edited #$NSTextStorageEditedCharacters
    933968                :range (ns-make-range pos n)
    934969                :change-in-length (- n))
     
    10901125  (let* ((controller (make-objc-instance
    10911126                      'lisp-editor-window-controller
    1092                       :with-window (%hemlock-frame-for-textstorage
    1093                                     (slot-value self 'textstorage) nil nil))))
     1127                      :with-window (%hemlock-frame-for-textstorage
     1128                                    (slot-value self 'textstorage)
     1129                                    *editor-columns*
     1130                                    *editor-rows*
     1131                                    nil))))
    10941132    (send self :add-window-controller controller)
    10951133    (send controller 'release)))         
  • trunk/ccl/examples/cocoa-listener.lisp

    r612 r617  
    66  (require "COCOA-EDITOR")
    77  (require "PTY"))
     8
     9(def-cocoa-default *listener-rows* :int 16)
     10(def-cocoa-default *listener-columns* :int 80)
    811
    912;;; Setup the server end of a pty pair.
     
    225228
    226229(define-objc-method ((:void make-window-controllers) lisp-listener-document)
    227   (let* ((controller (make-objc-instance
     230  (let* ((textstorage (slot-value self 'textstorage))
     231         (controller (make-objc-instance
    228232                      'lisp-listener-window-controller
    229233                      :with-window (%hemlock-frame-for-textstorage
    230                                     (slot-value self 'textstorage) nil nil)))
     234                                    textstorage
     235                                    *listener-columns*
     236                                    *listener-rows*
     237                                    t)))
    231238         (listener-name (hi::buffer-name (hemlock-document-buffer self))))
    232239    (send self :add-window-controller controller)
  • trunk/ccl/hemlock/src/font.lisp

    r6 r617  
    9393;;;; Referencing and setting font ids.
    9494
     95#+clx
     96(progn
    9597(defun window-font (window font)
    9698  "Returns a font id for window and font."
     
    119121      (setf (bitmap-hunk-trashed (window-hunk w)) :font-change)))
    120122  (setf (svref (font-family-map *default-font-family*) font) font-object))
     123)
  • trunk/ccl/hemlock/src/listener.lisp

    r597 r617  
    325325         (length (ring-length ring))
    326326         (p (or p 1)))
    327     (when (or (mark< point mark) (zerop length)) (editor-error))
     327    (when (or (mark< point mark) (zerop length)) (editor-error "Can't get command history"))
    328328    (cond
    329329     ((eq (last-command-type) :interactive-history)
  • trunk/ccl/hemlock/src/rompsite.lisp

    r60 r617  
    261261  "The number of possible fonts in a font-map.")
    262262#-clx
    263 (defconstant font-map-size 16)
     263(defconstant font-map-size 32)
    264264
    265265;;; SETUP-FONT-FAMILY sets *default-font-family*, opening the three font names
Note: See TracChangeset for help on using the changeset viewer.