Changeset 617
- Timestamp:
- Mar 6, 2004, 9:47:08 AM (17 years ago)
- Location:
- trunk/ccl
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/examples/cocoa-defaults.lisp
r610 r617 1 ;;;-*- Mode: LISP; Package: CCL -*-2 3 1 ;;;-*-Mode: LISP; Package: CCL -*- 4 2 ;;; … … 20 18 21 19 (eval-when (:compile-toplevel :execute) 22 (use-interface-dir :cocoa)) 20 (use-interface-dir :cocoa) 21 (use-interface-dir :carbon)) 23 22 24 23 (require "OBJC-SUPPORT") … … 60 59 (record-source-file name 'variable) 61 60 (setf (documentation name 'variable) doc) 62 (set name (set-cocoa-default name (ns-constant-string (string -downcasename)) type value doc))61 (set name (set-cocoa-default name (ns-constant-string (string name)) type value doc)) 63 62 name) 64 63 … … 76 75 (let* ((name (cocoa-default-symbol d)) 77 76 (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))) 87 92 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 100 94 101 95 -
trunk/ccl/examples/cocoa-editor.lisp
r611 r617 10 10 (eval-when (:compile-toplevel :execute) 11 11 (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))) 12 48 13 49 (defun make-hemlock-buffer (&rest args) … … 88 124 workline-offset ; cached offset of workline 89 125 workline-length ; length of cached workline 126 workline-start-font-index ; current font index at start of worklin 90 127 ) 91 128 … … 103 140 (buffer-cache-workline-offset d) 0 104 141 (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) 106 144 d)) 107 145 … … 246 284 ;;; Lisp-text-storage objects 247 285 (defclass lisp-text-storage (ns:ns-text-storage) 248 ((string :foreign-type :id) 249 (defaultattrs :foreign-type :id)) 286 ((string :foreign-type :id)) 250 287 (:metaclass ns:+ns-object)) 251 288 … … 257 294 (define-objc-method ((:id :init-with-string s) lisp-text-storage) 258 295 (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) 261 297 newself)) 262 298 … … 285 321 (setf (pref rangeptr :<NSR>ange.location) 0 286 322 (pref rangeptr :<NSR>ange.length) len)) 287 (s lot-value self 'defaultattrs)))323 (svref *styles* 0))) 288 324 289 325 ;;; The range's origin should probably be the buffer's point; if … … 581 617 582 618 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) 584 620 (slet ((contentrect (ns-make-rect x y width height))) 585 621 (let* ((scrollview (send (make-objc-instance … … 623 659 (send tv :set-vertically-resizable t) 624 660 (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) 626 662 (send container :set-height-tracks-text-view nil) 627 663 (send scrollview :set-document-view tv) 628 664 (values tv scrollview)))))))) 629 665 630 (defun make-scrolling-textview-for-pane (pane textstorage )666 (defun make-scrolling-textview-for-pane (pane textstorage track-widht) 631 667 (slet ((contentrect (send (send pane 'content-view) 'frame))) 632 668 (multiple-value-bind (tv scrollview) … … 636 672 (pref contentrect :<NSR>ect.origin.y) 637 673 (pref contentrect :<NSR>ect.size.width) 638 (pref contentrect :<NSR>ect.size.height)) 674 (pref contentrect :<NSR>ect.size.height) 675 track-widht) 639 676 (send pane :set-content-view scrollview) 640 677 (setf (slot-value pane 'scroll-view) scrollview … … 747 784 748 785 749 (defun textpane-for-textstorage (ts )786 (defun textpane-for-textstorage (ts ncols nrows container-tracks-text-view-width) 750 787 (let* ((pane (nth-value 751 788 1 752 789 (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))) 754 791 (multiple-value-bind (height width) 755 792 (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)) 757 794 pane)) 758 795 … … 841 878 842 879 ;;; 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) 851 886 (process-interrupt *cocoa-event-process* 852 887 #'%hemlock-frame-for-textstorage 853 ts title activate))888 ts ncols nrows container-tracks-text-view-width)) 854 889 855 890 … … 911 946 (decf pos n)) 912 947 #+debug 913 (format t "~& pos = ~d, n = ~d" pos n)948 (format t "~&insert: pos = ~d, n = ~d" pos n) 914 949 (let* ((display (hemlock-buffer-string-cache (send textstorage 'string)))) 915 950 (reset-buffer-cache display) … … 930 965 (force-output) 931 966 (send textstorage 932 :edited #$NSTextStorageEdited Attributes967 :edited #$NSTextStorageEditedCharacters 933 968 :range (ns-make-range pos n) 934 969 :change-in-length (- n)) … … 1090 1125 (let* ((controller (make-objc-instance 1091 1126 '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)))) 1094 1132 (send self :add-window-controller controller) 1095 1133 (send controller 'release))) -
trunk/ccl/examples/cocoa-listener.lisp
r612 r617 6 6 (require "COCOA-EDITOR") 7 7 (require "PTY")) 8 9 (def-cocoa-default *listener-rows* :int 16) 10 (def-cocoa-default *listener-columns* :int 80) 8 11 9 12 ;;; Setup the server end of a pty pair. … … 225 228 226 229 (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 228 232 'lisp-listener-window-controller 229 233 :with-window (%hemlock-frame-for-textstorage 230 (slot-value self 'textstorage) nil nil))) 234 textstorage 235 *listener-columns* 236 *listener-rows* 237 t))) 231 238 (listener-name (hi::buffer-name (hemlock-document-buffer self)))) 232 239 (send self :add-window-controller controller) -
trunk/ccl/hemlock/src/font.lisp
r6 r617 93 93 ;;;; Referencing and setting font ids. 94 94 95 #+clx 96 (progn 95 97 (defun window-font (window font) 96 98 "Returns a font id for window and font." … … 119 121 (setf (bitmap-hunk-trashed (window-hunk w)) :font-change))) 120 122 (setf (svref (font-family-map *default-font-family*) font) font-object)) 123 ) -
trunk/ccl/hemlock/src/listener.lisp
r597 r617 325 325 (length (ring-length ring)) 326 326 (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")) 328 328 (cond 329 329 ((eq (last-command-type) :interactive-history) -
trunk/ccl/hemlock/src/rompsite.lisp
r60 r617 261 261 "The number of possible fonts in a font-map.") 262 262 #-clx 263 (defconstant font-map-size 16)263 (defconstant font-map-size 32) 264 264 265 265 ;;; SETUP-FONT-FAMILY sets *default-font-family*, opening the three font names
Note: See TracChangeset
for help on using the changeset viewer.