Changeset 14988


Ignore:
Timestamp:
Sep 17, 2011, 3:27:26 PM (8 years ago)
Author:
gfoy
Message:

miscellaneous

Location:
trunk/cocoa-ide-contrib/foy
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/cocoa-ide-contrib/foy/hemlock-commands-cm/hemlock-documentation-dialog.lisp

    r14985 r14988  
    1313;;;
    1414;;;      Mod History, most recent first:
     15;;;
     16;;;      9/17/11 ignore case added to grep call
    1517;;;      8/31/9  version 0.1b1
    1618;;;              First cut.
     
    2022(in-package "HEMLOCK-COMMANDS")
    2123
    22 (defParameter *doc-dialog* nil)
    23 (defParameter *hemlock-jpg* (merge-pathnames ";Hemlock.jpg" cl-user::*hemlock-commands-directory*))
     24(defParameter *DOC-DIALOG* nil)
     25(defParameter *HEMLOCK-JPG* (merge-pathnames ";Hemlock.jpg" cl-user::*hemlock-commands-directory*))
    2426;;; I don't know the name of the artist who drew this graphic, but it is quite nice.
    2527;;; I also don't know what the copyright issues are, so this will have to be replaced when I get a chance:
    26 (defParameter *graphic-p* t "To use, or not to use the eye candy.")
     28(defParameter *GRAPHIC-P* t "To use, or not to use the eye candy.")
    2729
    2830
     
    7072                                                    (string-not-equal (pathname-type path) "lisp"))
    7173                                                (directory (merge-pathnames hemlock-src-dir "*.lisp") :files t :directories nil)))))
    72                 (args (cons "-l" (cons search-string files)))
     74                ;; ignore case
     75                (args (cons "-li" (cons search-string files)))
    7376                (source-path (string-trim '(#\newline #\space) (gui::call-grep args))))
    7477           (if (and (stringp source-path) (string-not-equal source-path ""))
     
    8891
    8992
    90 (defun open-documentation-dialog (name key-or-type doc &key symbol hemlock-p text-view)
     93(defun OPEN-DOCUMENTATION-DIALOG (name key-or-type doc &key symbol hemlock-p text-view)
    9194  "Open the dialog displaying the documentation for NAME."
    9295  (when (null text-view) (setq text-view (get-listener-text-view)))
     
    179182
    180183;;; This is a redefintion of the function in cl-documentation-1.lisp
    181 (defun cldoc::display-cl-doc (sym text-view)
     184(defun CLDOC::DISPLAY-CL-DOC (sym text-view)
    182185  "If there is CCL or MCL doc, use the doc-dialog to display documentation.  Otherwise use the HyperSpec."
    183186  (when (eq (symbol-package sym) (find-package :common-lisp))
     
    186189        (gui::lookup-hyperspec-symbol sym text-view))))
    187190
    188 (defun get-listener-text-view ()
     191(defun GET-LISTENER-TEXT-VIEW ()
    189192  "If the menu is installed under the Help Menu, there is no text-view.  Borrow the Listener text-view."
    190193  (let* ((listeners (gui::active-listener-windows))
     
    193196      (slot-value (slot-value listener 'gui::pane) 'gui::text-view))))
    194197
    195 (defMethod get-items ((d doc-dialog))
     198(defMethod GET-ITEMS ((d doc-dialog))
    196199  (append
    197200   (when *graphic-p*
     
    202205   (make-buttons d)))
    203206
    204 (defun make-hemlock-image ()
     207(defun MAKE-HEMLOCK-IMAGE ()
    205208  "Create the Hemlock graphic.  You can make this go away by set *graphic-p* to nil above."
    206209  (let ((image (#/alloc ns:ns-image))
     
    212215    (list image-view)))
    213216
    214 (defun make-name-field (dialog)
     217(defun MAKE-NAME-FIELD (dialog)
    215218  "Create the name text-field."
    216219  (list
     
    224227     (setf (name-field dialog) title))))
    225228
    226 (defun make-key-field (dialog)
     229(defun MAKE-KEY-FIELD (dialog)
    227230  "Create the key text-field."
    228231  (list
     
    236239     (setf (key-field dialog) title))))
    237240
    238 (defun make-doc-text-view (dialog)
     241(defun MAKE-DOC-TEXT-VIEW (dialog)
    239242  "Create the documentation text-view."
    240243  (list
     
    258261
    259262
    260 (defun make-buttons (dialog)
     263(defun MAKE-BUTTONS (dialog)
    261264  "Construct the buttons."
    262   (flet ((make-button (title x-coord y-coord x-dim y-dim action)
     265  (flet ((MAKE-BUTTON (title x-coord y-coord x-dim y-dim action)
    263266           (let ((button (#/alloc ns:ns-button)))
    264267             (ns:with-ns-rect (frame x-coord y-coord x-dim y-dim)
  • trunk/cocoa-ide-contrib/foy/syntax-styling/syntax-styling-comments.lisp

    r14985 r14988  
    1212;;;
    1313;;;      Mod history, most recent first:
     14;;;
     15;;;      9/17/11   sharpe-underscore in get-combined-segment-list.
    1416;;;      9/7/11    update for ccl 1.7
    1517;;;      7/17/11   style-semi-colon-comments beginning of buffer bug.
     
    424426         (cocoa-constant3-list (create-cocoa-syntax-list start end %colon-lessthan-forward-pattern%))
    425427         (cocoa-constant4-list (create-cocoa-syntax-list start end %sharp-backslash-forward-pattern%))
    426          (cocoa-constant5-list (create-cocoa-syntax-list start end %sharp-greaterthan-forward-pattern%)))
     428         (cocoa-constant5-list (create-cocoa-syntax-list start end %sharp-greaterthan-forward-pattern%))
     429         (cocoa-constant6-list (create-cocoa-syntax-list start end %sharp-underscore-forward-pattern%)))
    427430    (unify-segment-lists
    428431     string-list
     
    438441          cocoa-constant5-list
    439442          (unify-segment-lists
    440            cocoa-function-list
     443           cocoa-constant6-list
    441444           (unify-segment-lists
    442             semi-colon-comment-list
    443             sharp-stroke-comment-list))))))))))
    444 
    445 
    446 
    447 
     445            cocoa-function-list
     446            (unify-segment-lists
     447             semi-colon-comment-list
     448             sharp-stroke-comment-list)))))))))))
     449
     450
     451
     452
  • trunk/cocoa-ide-contrib/foy/syntax-styling/syntax-styling-engine.lisp

    r14985 r14988  
    1111;;;
    1212;;;      Mod history, most recent first:
     13;;;
     14;;;      9/17/11   dummy set-file-type for ns:ns-window, set background-color
     15;;;                in vanilla-syle-buffer and style-window.
    1316;;;      9/7/11    update for ccl 1.7
    1417;;;      7/17/11   Miscellaneous.
     
    104107  (defun clojure-file-p () clojure-file-p)
    105108  (defun writable-p () writable-p))
     109
     110(defMethod set-file-type ((w ns:ns-window))
     111  ())
    106112
    107113(defMethod set-file-type ((w gui::hemlock-frame))
     
    673679        (unless (and start end)
    674680          (setf start (buf-start-mark) end (buf-end-mark)))   
     681        (#/setBackgroundColor: text-view (background-color))
    675682        (hemlock::parse-over-block (mark-line start) (mark-line end))
    676683        (set-generic-text-style text-view start end)
     
    713720    file-count))
    714721
    715 (defun vanilla-style-buffer (buffer start end)
     722(defun vanilla-style-buffer (buffer start end text-view)
    716723  ;; Set the font spec of the text to the default; but leave the capitalization
    717724  ;; of strings, comments and various constants alone.
     
    720727          (buf-end (buf-end-mark buffer))
    721728          skip-list case)
     729      (#/setBackgroundColor: text-view (#/whiteColor ns:ns-color))
    722730      (hemlock::parse-over-block (mark-line start) (mark-line end))
    723731      (set-style-attributes (attribute-dictionary *vanilla-style*) start end)
     
    755763             (unless (and start end)
    756764               (setf start (buf-start-mark) end (buf-end-mark)))
    757              (vanilla-style-buffer *buf* start end)))
     765             (vanilla-style-buffer *buf* start end text-view)))
    758766          (t
    759767           (listener-msg "~%;;; File is read-only: ~S" (window-path window))))))
  • trunk/cocoa-ide-contrib/foy/syntax-styling/syntax-styling-prefs.lisp

    r14985 r14988  
    1111;;;
    1212;;;      Mod history, most recent first:
     13;;;
     14;;;      9/17/11   set common-lisp as target in open-prefs.
    1315;;;      9/7/11    update for ccl 1.7
    1416;;;      7/22/11   first cut.
     
    529531      (#/addSubview: (#/contentView (styling-dialog pm)) item)))
    530532  (save-file-type pm)
     533  (#/selectCellAtRow:column: (target-matrix pm) 0 0)
    531534  (update-target pm (target-matrix pm))
    532535  (#/deselectRow: (style-table pm) (#/selectedRow (style-table pm)))
     
    13221325                            (style-sample-code (style-item-variable pm)))
    13231326    (cond ((eq (style-item-variable pm) '*vanilla-styling*)
    1324            (vanilla-style-buffer *buf* (buf-start-mark) (buf-end-mark)))
     1327           (vanilla-style-buffer *buf* (buf-start-mark) (buf-end-mark) text-view))
    13251328          (t
    1326            (vanilla-style-buffer *buf* (buf-start-mark) (buf-end-mark))
     1329           (vanilla-style-buffer *buf* (buf-start-mark) (buf-end-mark) text-view)
    13271330           (style-sample text-view)))))
    13281331
     
    18701873
    18711874(defMethod populate-style-sets-popup-menu ((pm prefs-manager) subdir)
    1872   (let ((pathnames (merge-pathnames (namestring (construct-style-sets-path
     1875  (let* ((pathnames (merge-pathnames (namestring (construct-style-sets-path
    18731876                                                 (concatenate 'string subdir ";style-sets"))) "*"))
    1874         (prefs-filename (concatenate 'string subdir "-prefs")))
     1877         (prefs-filename (concatenate 'string subdir "-prefs"))
     1878         (prefs-path (construct-prefs-path (concatenate 'string subdir ";" prefs-filename))))
    18751879    (let ((files (directory pathnames :files t :directories nil)))
    18761880      (#/removeAllItems (style-set-popup-menu pm))
    18771881      ; (debug-out "~%files: ~S" files)
    18781882      (when files (setq files (mapcar #'pathname-name files)))
    1879       (#/addItemWithTitle: (style-set-popup-menu pm) (ccl::%make-nsstring prefs-filename))
     1883      (when (probe-file prefs-path)
     1884        (#/addItemWithTitle: (style-set-popup-menu pm) (ccl::%make-nsstring prefs-filename)))
    18801885      (dolist (file files)
    18811886        (#/addItemWithTitle: (style-set-popup-menu pm) (ccl::%make-nsstring file))))))
  • trunk/cocoa-ide-contrib/foy/syntax-styling/syntax-styling-specials.lisp

    r14985 r14988  
    1313;;;
    1414;;;      Mod History, most recent first:
     15;;;
     16;;;      9/17/11   %sharp-underscore-forward-pattern%
    1517;;;      9/7/11    update for ccl 1.7
    1618;;;      10/18/9   First cut.
     
    2628(export '(common-lisp-user::pizza-to-go) :common-lisp-user)
    2729
    28 (defConstant %syntax-styling-version% "Version 0.2.1")
     30(defConstant %syntax-styling-version% "Version 0.2.2")
    2931
    3032(defVar *styling-p* t "To style or not to style.")
     
    173175(defConstant %sharp-dollar-forward-pattern% (new-search-pattern :string-insensitive :forward "#$"))
    174176(defConstant %sharp-ampersand-forward-pattern% (new-search-pattern :string-insensitive :forward "#&"))
     177(defConstant %sharp-underscore-forward-pattern% (new-search-pattern :string-insensitive :forward "#_"))
    175178(defConstant %colon-lessthan-forward-pattern% (new-search-pattern :string-insensitive :forward ":<"))
    176179
Note: See TracChangeset for help on using the changeset viewer.