Changeset 7563


Ignore:
Timestamp:
Oct 31, 2007, 2:53:31 AM (12 years ago)
Author:
rme
Message:

New user default editorFont, an actual NSFont instance.

New user default wrapLinesToWindow, not used yet.

Local variants of create-paragraph-style and create-text-attributes,
in preparation for further refactoring.

Remove defaults for modeline font.

Don't enable HyperSpec? menu item if HyperSpec? lookup is disabled.

Don't use old preference panel.

Use hemlock-document-controller instead of ns:ns-document-controller
in a couple of places.

File:
1 edited

Legend:

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

    r7552 r7563  
    1818  (defconstant large-number-for-text (float 1.0f7 +cgfloat-zero+)))
    1919
     20
     21(def-cocoa-default *editor-font* :font (#/fontWithName:size:
     22                                        ns:ns-font #@"Monaco" 10)
     23                   "Default font for editor windows")
     24
    2025(def-cocoa-default *editor-rows* :int 24 "Initial height of editor windows, in characters")
    2126(def-cocoa-default *editor-columns* :int 80 "Initial width of editor windows, in characters")
    2227
    2328(def-cocoa-default *editor-background-color* :color '(1.0 1.0 1.0 1.0) "Editor background color")
     29(def-cocoa-default *wrap-lines-to-window* :bool nil
     30                   "Soft wrap lines to window width")
    2431
    2532(defmacro nsstring-encoding-to-nsinteger (n)
     
    3340   (64 n)))
    3441
     42;;; Create a paragraph style, mostly so that we can set tabs reasonably.
     43(defun rme-create-paragraph-style (font line-break-mode)
     44  (let* ((p (make-instance 'ns:ns-mutable-paragraph-style))
     45         (charwidth (fround (nth-value 1 (size-of-char-in-font font)))))
     46    (#/setLineBreakMode: p
     47                         (ecase line-break-mode
     48                           (:char #$NSLineBreakByCharWrapping)
     49                           (:word #$NSLineBreakByWordWrapping)
     50                           ;; This doesn't seem to work too well.
     51                           ((nil) #$NSLineBreakByClipping)))
     52    ;; Clear existing tab stops.
     53    (#/setTabStops: p (#/array ns:ns-array))
     54    ;; And set the "default tab interval".
     55    (#/setDefaultTabInterval: p (* *tab-width* charwidth))
     56    p))
     57
     58(defun rme-create-text-attributes (&key (font *editor-font*)
     59                                   (line-break-mode :char)
     60                                   (color nil)
     61                                   (obliqueness nil)
     62                                   (stroke-width nil))
     63  (let* ((dict (make-instance 'ns:ns-mutable-dictionary :with-capacity 5)))
     64    (#/setObject:forKey: dict (rme-create-paragraph-style font line-break-mode)
     65                         #&NSParagraphStyleAttributeName)
     66    (#/setObject:forKey: dict font #&NSFontAttributeName)
     67    (when color
     68      (#/setObject:forKey: dict color #&NSForegroundColorAttributeName))
     69    (when stroke-width
     70      (#/setObject:forKey: dict (#/numberWithFloat: ns:ns-number stroke-width)
     71                           #&NSStrokeWidthAttributeName))
     72    (when obliqueness
     73      (#/setObject:forKey: dict (#/numberWithFloat: ns:ns-number obliqueness)
     74                           #&NSObliquenessAttributeName))
     75    dict))
     76
     77(defun rme-make-editor-style-map ()
     78  (let* ((font *editor-font*)
     79         (fm (#/sharedFontManager ns:ns-font-manager))
     80         (bold-font (#/convertFont:toHaveTrait: fm font #$NSBoldFontMask))
     81         (oblique-font (#/convertFont:toHaveTrait: fm font #$NSItalicFontMask))
     82         (bold-oblique-font (#/convertFont:toHaveTrait:
     83                             fm font (logior #$NSItalicFontMask
     84                                             #$NSBoldFontMask)))
     85         (colors (vector (#/blackColor ns:ns-color)))
     86         (fonts (vector font bold-font oblique-font bold-oblique-font))
     87         (styles (make-instance 'ns:ns-mutable-array)))
     88    (dotimes (c (length colors))
     89      (dotimes (i 4)
     90        (let* ((mask (logand i 3))
     91               (f (svref fonts mask)))
     92          (#/addObject: styles
     93                        (rme-create-text-attributes :font f
     94                                                    :color (svref colors c)
     95                                                    :obliqueness
     96                                                    (if (logbitp 1 i)
     97                                                      (when (eql f font)
     98                                                        0.15f0))
     99                                                    :stroke-width
     100                                                    (if (logbitp 0 i)
     101                                                      (when (eql f font)
     102                                                        -10.0f0)))))))
     103    styles))
     104
     105(defun make-editor-style-map ()
     106  (rme-make-editor-style-map))
     107
     108#+nil
    35109(defun make-editor-style-map ()
    36110  (let* ((font-name *default-font-name*)
     
    12971371    (setf (modeline-text-attributes self) (#/retain dict)))
    12981372  self)
    1299 
    1300 ;;; Attributes to use when drawing the modeline fields.  There's no
    1301 ;;; simple way to make the "placard" taller, so using fonts larger than
    1302 ;;; about 12pt probably wouldn't look too good.  10pt Courier's a little
    1303 ;;; small, but allows us to see more of the modeline fields (like the
    1304 ;;; full pathname) in more cases.
    1305 
    1306 
    1307 (def-cocoa-default *modeline-font-name* :string "Monaco"
    1308                    "Name of font to use in modelines")
    1309 (def-cocoa-default  *modeline-font-size* :float 9.0 "Size of font to use in modelines")
    1310 
    13111373
    13121374;;; Find the underlying buffer.
     
    21832245    (cond ((eql action (@selector #/hyperSpecLookUp:))
    21842246           ;; For now, demand a selection.
    2185            (and (hyperspec-root-url)
     2247           (and *hyperspec-lookup-enabled*
     2248                (hyperspec-root-url)
    21862249                (not (eql 0 (ns:ns-range-length (#/selectedRange self))))))
    21872250          ((eql action (@selector #/cut:))
     
    24202483                                               panel)
    24212484  (with-slots (encoding) self
    2422     (let* ((popup (build-encodings-popup (#/sharedDocumentController ns:ns-document-controller) encoding)))
     2485    (let* ((popup (build-encodings-popup (#/sharedDocumentController hemlock-document-controller) encoding)))
    24232486      (#/setAction: popup (@selector #/noteEncodingChange:))
    24242487      (#/setTarget: popup self)
     
    27172780(defun initialize-user-interface ()
    27182781  (#/sharedDocumentController hemlock-document-controller)
    2719   (#/sharedPanel lisp-preferences-panel)
     2782  ;(#/sharedPanel lisp-preferences-panel)
    27202783  (make-editor-style-map))
    27212784
     
    29453008;;; Enable CL:ED
    29463009(defun cocoa-edit (&optional arg)
    2947   (let* ((document-controller (#/sharedDocumentController ns:ns-document-controller)))
     3010  (let* ((document-controller (#/sharedDocumentController hemlock-document-controller)))
    29483011    (cond ((null arg)
    29493012           (#/performSelectorOnMainThread:withObject:waitUntilDone:
Note: See TracChangeset for help on using the changeset viewer.