Changeset 15594


Ignore:
Timestamp:
Jan 14, 2013, 10:00:23 PM (6 years ago)
Author:
gfoy
Message:

New project manager and CCL-Utilities, The Motion Picture

Location:
trunk/cocoa-ide-contrib/foy
Files:
1 added
13 edited

Legend:

Unmodified
Added
Removed
  • trunk/cocoa-ide-contrib/foy/context-menu-cm/context-menu-dialogs.lisp

    r14985 r15594  
    1313;;;
    1414;;;      Mod History, most recent first:
     15;;;      1/10/11 Added user-input-dialog
    1516;;;      9/14/9  First cut
    1617;;;
     
    2021(in-package "CONTEXT-MENU")
    2122
    22 (export '(notify window-with-path active-hemlock-window window-path echo-msg))
     23(export '(notify window-with-path active-hemlock-window window-path echo-msg
     24                 get-input))
    2325
    2426(defParameter *clozure-jpg* (merge-pathnames ";Clozure.jpg" cl-user::*context-menu-directory*))
    25 (defParameter *graphic-p* t "To use, or not to use the Clozure graphic.")
     27;; (defParameter *graphic-p* t "To use, or not to use the Clozure graphic.")
    2628
    2729
     
    6769  "FYI"
    6870  (let ((message-string (apply #'format nil message args)))
    69     (if *graphic-p*
    70       (open-notification-dialog message-string)
    71       (gui::alert-window :title "Notification" :message message-string))))
     71    (open-notification-dialog message-string)))
     72
     73(defun get-input (prompt &rest args)
     74  "Prompt and get user input."
     75  (let ((prompt-string (apply #'format nil prompt args)))
     76    (open-user-input-dialog prompt-string)))
    7277
    7378(defParameter *notify-dialog* nil "The notification-dialog instance.")
     
    116121             (#/close dialog))))))
    117122
    118 #|
    119 (open-notification-dialog "foobear")
    120 |#
    121 
    122123(defMethod get-notify-items ((d notification-dialog))
    123124  (append
     
    139140      (list image-view))))
    140141
    141 (defun make-notify-prompt ()
    142   "Create the prompt text-field."
    143   (list
    144    (let* ((string (#/initWithString:attributes:
    145                    (#/alloc ns:ns-attributed-string)
    146                    #@"Notification"
    147                    cmenu::*tool-label-dictionary*))
    148           (title (#/alloc ns:ns-text-field)))
    149      (ns:with-ns-rect (frame 120 90 150 32)
    150        (#/initWithFrame: title frame))
    151      (#/setEditable: title nil)
    152      (#/setDrawsBackground: title nil)
    153      (#/setBordered: title nil)
    154      (#/setStringValue: title string)
    155      title)))
    156 
    157142(defun make-notify-message (dialog)
    158143  "Create the documentation text-view."
     
    179164     (setf (nd-okay-button dialog) button))))
    180165
    181 
    182 
    183 
    184 
     166(defParameter *user-input-dialog* nil "The user-input-dialog instance.")
     167
     168;;; ----------------------------------------------------------------------------
     169;;;
     170(defClass USER-INPUT-DIALOG (ns:ns-window)
     171  ((prompt-field :initform nil :accessor uid-prompt-field)
     172   (input-field :initform nil :accessor uid-input-field)
     173   (cancel-button :initform nil :accessor uid-cancel-button)
     174   (okay-button :initform nil :accessor uid-okay-button)
     175   (return-value :initform nil :accessor uid-return-value))
     176  (:documentation "A dialog for obtaining user input.")
     177  (:metaclass ns:+ns-object))
     178
     179(objc:defmethod (#/okayAction: :void) ((d user-input-dialog) (sender :id))
     180  (declare (ignore sender))
     181  (#/stopModalWithCode: ccl::*nsapp* 0)
     182  (setf (uid-return-value d)
     183        (objc::lisp-string-from-nsstring (#/stringValue (uid-input-field d)))))
     184
     185(objc:defmethod (#/cancelAction: :void) ((d user-input-dialog) (sender :id))
     186  (declare (ignore sender))
     187  (#/stopModalWithCode: ccl::*nsapp* 0)
     188  (setf (uid-return-value d) ""))
     189
     190(defun open-user-input-dialog (prompt)
     191  "Open the user-input-dialog and display PROMPT."
     192  (let ((prompt-string (#/initWithString:attributes: (#/alloc ns:ns-attributed-string)
     193                                                      (ccl::%make-nsstring prompt)
     194                                                      cmenu::*tool-doc-dictionary*)))
     195    (cond (*user-input-dialog*
     196           (#/setStringValue: (uid-prompt-field *user-input-dialog*) prompt-string)
     197           (#/setStringValue: (uid-input-field *user-input-dialog*) #@"")
     198           (#/makeKeyAndOrderFront: *user-input-dialog* nil)
     199           (#/runModalForWindow: ccl::*nsapp* *user-input-dialog*)
     200           (let ((input-value (uid-return-value *user-input-dialog*)))
     201             (#/close *user-input-dialog*)
     202             input-value))
     203          (t
     204           (let ((dialog (#/alloc user-input-dialog)))
     205             (setq *user-input-dialog* dialog)
     206             (ns:with-ns-rect (r 10 300 400 127)
     207               (#/initWithContentRect:styleMask:backing:defer:
     208                dialog
     209                r
     210                #$NSTitledWindowMask
     211                #$NSBackingStoreBuffered
     212                #$NO))
     213             (dolist (item (get-user-input-items dialog))
     214               (#/addSubview: (#/contentView dialog) item))
     215             (#/setTitle: dialog #@"User Input")
     216             (#/setReleasedWhenClosed: dialog nil)
     217             (#/setDefaultButtonCell: dialog (uid-okay-button dialog))
     218             (#/setStringValue: (uid-prompt-field dialog) prompt-string)
     219             (#/setStringValue: (uid-input-field *user-input-dialog*) #@"")
     220             (#/center dialog)
     221             (#/makeKeyAndOrderFront: dialog nil)
     222             (#/runModalForWindow: ccl::*nsapp* dialog)
     223             (let ((input-value (uid-return-value dialog)))
     224               (#/close dialog)
     225               input-value))))))
     226
     227(defMethod get-user-input-items ((d user-input-dialog))
     228  (append
     229   (make-notify-graphic)
     230   (make-uid-prompt d)
     231   (make-uid-input d)
     232   (make-user-input-buttons d)))
     233
     234(defun make-uid-prompt (dialog)
     235  "Create the user-input prompt text-field."
     236  (list
     237   (let ((field (#/alloc ns:ns-text-field)))
     238     (ns:with-ns-rect (frame 120 85 270 20)
     239       (#/initWithFrame: field frame))
     240     (#/setEditable: field nil)
     241     (#/setDrawsBackground: field nil)
     242     (#/setBordered: field nil)
     243     (setf (uid-prompt-field dialog) field))))
     244
     245(defun make-uid-input (dialog)
     246  "Create the uid input text-field."
     247  (list
     248   (let ((field (#/alloc ns:ns-text-field)))
     249     (ns:with-ns-rect (frame 120 55 265 20)
     250       (#/initWithFrame: field frame))
     251     (#/setEditable: field t)
     252     (#/setDrawsBackground: field nil)
     253     (#/setBordered: field t)
     254     (setf (uid-input-field dialog) field))))
     255
     256(defun make-user-input-buttons (dialog)
     257  "Construct the uid buttons."
     258  (list
     259   (let ((button (#/alloc ns:ns-button)))
     260     (ns:with-ns-rect (frame 310 10 80 32)
     261       (#/initWithFrame: button frame))
     262     (#/setButtonType: button #$NSMomentaryPushInButton)
     263     (#/setBezelStyle: button #$NSRoundedBezelStyle)
     264     (#/setTitle: button #@"Okay")
     265     (#/setTarget: button dialog)
     266     (#/setAction: button (ccl::@selector "okayAction:"))
     267     (setf (uid-okay-button dialog) button))
     268   (let ((button (#/alloc ns:ns-button)))
     269     (ns:with-ns-rect (frame 225 10 80 32)
     270       (#/initWithFrame: button frame))
     271     (#/setButtonType: button #$NSMomentaryPushInButton)
     272     (#/setBezelStyle: button #$NSRoundedBezelStyle)
     273     (#/setTitle: button #@"Cancel")
     274     (#/setTarget: button dialog)
     275     (#/setAction: button (ccl::@selector "cancelAction:"))
     276     (setf (uid-cancel-button dialog) button))))
     277
     278
     279
     280
     281
     282
     283
     284
  • trunk/cocoa-ide-contrib/foy/list-definitions-cm/history-lists.lisp

    r14985 r15594  
    2020;;;
    2121;;;      Mod History, most recent first:
     22;;;      1/21/13 Added Project Menu.
    2223;;;      9/9/11  update for ccl 1.7
    2324;;;      1/6/9   Editor Evaluate Defun and Editor Compile Defun bit the dust.
     
    3233(defParameter *position-history-list-length* 25)
    3334(defParameter *file-history-list-length* 25)
     35(defParameter *current-project* "")
     36(defParameter *current-project-path*
     37  ";Library;Preferences;org.clairvaux;list-definitions;current-project")
     38(defParameter *list-definitions-dir*
     39  ";Library;Preferences;org.clairvaux;list-definitions;")
     40
    3441
    3542(defun maybe-open-file (path)
     
    4148        (when hemlock-view (#/window (hi::hemlock-view-pane hemlock-view)))))))
    4249
    43 (defun construct-history-path (filename)
     50(defun read-current-project-file ()
     51  "Read current project file. This file is used to reestablish context when a new session starts."
     52  (let ((path (merge-pathnames *current-project-path*
     53                               (hemlock::user-homedir-pathname))))
     54    (when (probe-file path)
     55      (with-open-file (stream path :direction :input)
     56        (flet ((oops ()
     57                 (cmenu:notify (format nil "There is a problem with ~S." path))
     58                 (delete-file path)
     59                 (return-from read-current-project-file)))
     60          (let (input)
     61            (setf input (read stream nil :eof))
     62            (unless (stringp input) (oops))
     63            (setq *current-project* input)))))))
     64
     65(defun delete-current-project-file ()
     66  "Deletes the current project file. This file is used to reestablish context when a new session starts."
     67  (let ((path (merge-pathnames *current-project-path*
     68                               (hemlock::user-homedir-pathname))))
     69    (when (probe-file path) (delete-file path))))
     70
     71
     72;;; The name of the last project edited from previous session:
     73(read-current-project-file)
     74
     75(defun construct-history-path (&optional filename)
    4476  "Construct the path to the history file."
     77  (if filename
    4578    (merge-pathnames (concatenate 'string
    46                                   ";Library;Preferences;org.clairvaux;list-definitions;"
     79                                  *list-definitions-dir*
     80                                  ";histories;"
     81                                  *current-project*
     82                                  ";"
    4783                                  filename)
    48                      (hemlock::user-homedir-pathname)))
    49 
     84                     (hemlock::user-homedir-pathname))
     85    (merge-pathnames (concatenate 'string
     86                                  *list-definitions-dir*
     87                                  ";histories;*")
     88                     (hemlock::user-homedir-pathname))))
     89
     90
     91;;; ----------------------------------------------------------------------------
     92;;; Project Management:
     93;;;
     94(defun list-projects ()
     95  (let* ((dir-paths (directory (construct-history-path) :files nil :directories t))
     96         (projects (mapcar #'(lambda (path)
     97                               (first (last (pathname-directory path))))
     98                           dir-paths)))
     99    projects))
     100
     101(defun close-open-windows ()
     102  (gui::map-windows #'(lambda (w) (unless (typep w 'gui::hemlock-listener-frame)
     103                                    (#/close w)))))
     104
     105(defun open-first-file-history-list-entry ()
     106  (let ((entry (first (hl-list *file-history-list*))))
     107    (when entry (show-entry entry))))
     108
     109(defParameter *project-menu* nil)
     110
     111(defun unset-project ()
     112  (let ((selected (#/itemWithTitle: *project-menu* (ccl::%make-nsstring *current-project*))))
     113    (#/setState: selected #$NSOffState))
     114  (setq *current-project* "")
     115  (close-open-windows)
     116  (delete-current-project-file)
     117  (clear-history-lists)
     118  (clear-history-paths))
     119
     120;;; projectAction can call this to set a new project or simply de-select the current project.
     121;;; createProjectAction calls this to set the newly created project.
     122(defun set-project (menu-item)
     123  (let ((project-name (objc::lisp-string-from-nsstring (#/title menu-item)))
     124        (project-list (list-projects)))
     125    (unless (string= project-name "") ; do nothing on CANCEL
     126      (cond ((member project-name project-list :test #'string=)
     127             (cond ((string= *current-project* project-name)
     128                    ;; deselect current project:
     129                    (write-history-files)
     130                    (unset-project))
     131                   (t ; switching projects
     132                    (write-history-files)
     133                    (unset-project)
     134                    (setq *current-project* project-name)
     135                    (setf (hl-path *position-history-list*)
     136                          (construct-history-path "position-history"))
     137                    (setf (hl-path *file-history-list*)
     138                          (construct-history-path "file-history"))
     139                    (read-history-files)
     140                    (open-first-file-history-list-entry)
     141                    (#/setState: menu-item #$NSOnState))))
     142            (t
     143             (format t "~%There is no ~S project." project-name))))))
     144
     145;;; ----------------------------------------------------------------------------
     146;;; Project Menu:
     147;;;
     148(objc:defmethod (#/projectAction: :void) ((m ns:ns-menu) (sender :id))
     149  (set-project sender))
     150
     151(objc:defmethod (#/saveHistoriesAction: :void) ((m ns:ns-menu) (sender :id))
     152  (declare (ignore sender))
     153  (write-history-files)
     154  (write-current-project))
     155
     156(objc:defmethod (#/clearFileHistoryAction: :void) ((m ns:ns-menu) (sender :id))
     157  (declare (ignore sender))
     158  (clear-file-history-list))
     159
     160(objc:defmethod (#/clearPositionHistoryAction: :void) ((m ns:ns-menu) (sender :id))
     161  (declare (ignore sender))
     162  (clear-position-history-list))
     163
     164(objc:defmethod (#/createProjectAction: :void) ((m ns:ns-menu) (sender :id))
     165  (declare (ignore sender))
     166  (let ((new-project-name (cmenu:get-input "Enter name of new project:"))
     167        project-directory-path)
     168    (cond ((string= new-project-name "")
     169           nil)
     170          ((member new-project-name (list-projects) :test 'string=)
     171           (cmenu:notify "You already have a project named ~S." new-project-name))
     172          ((or (not (alpha-char-p (elt new-project-name 0)))
     173               (not (every 'alphanumericp new-project-name)))
     174           (cmenu:notify "Not a valid project name."))
     175          (t
     176           (let* ((*current-project* new-project-name))
     177             (setq project-directory-path (construct-history-path "")))
     178           (cond ((ccl::create-directory project-directory-path)
     179                  (populate-menu m (list-projects))
     180                  (let* ((idx (#/indexOfItemWithTitle: m (ccl::%make-nsstring new-project-name)))
     181                         (menu-item (when (not (= idx -1)) (#/itemAtIndex: m idx))))
     182                    (when menu-item
     183                      (set-project menu-item))))
     184                 (t
     185                  (cmenu:notify "Failed to create new project directory.")
     186                  (populate-menu m (list-projects))
     187                  (unset-project)))))))
     188
     189(objc:defmethod (#/deleteProjectAction: :void) ((m ns:ns-menu) (sender :id))
     190  (declare (ignore sender))
     191  (let ((project-name (cmenu:get-input "Enter name of project to delete:")))
     192    (cond ((member project-name (list-projects) :test 'string=)
     193           (let* ((*current-project* project-name)
     194                  (file-history-path (construct-history-path "file-history"))
     195                  (position-history-path (construct-history-path "position-history"))
     196                  (project-directory-path (construct-history-path "")))
     197             (when (probe-file file-history-path)
     198               (delete-file file-history-path))
     199             (when (probe-file position-history-path)
     200               (delete-file position-history-path))
     201             (when (ccl::ensure-directory-pathname project-directory-path)
     202               (ccl::delete-empty-directory project-directory-path)))
     203           ;; Reconstruct the project menu:
     204           (populate-menu m (list-projects))
     205           ;; Was the current project deleted?
     206           (when (string= *current-project* project-name)
     207             (unset-project)))
     208          ((not (string= project-name ""))
     209           (cmenu:notify "The name you entered, ~S, is not a project name." project-name)))))
     210
     211(defun populate-menu (menu project-list)
     212  (#/removeAllItems menu)
     213  (dolist (project project-list)
     214    (let ((item (make-instance ns:ns-menu-item))
     215          (title (ccl::%make-nsstring project)))
     216      (#/setTitle: item title)
     217      (#/setAction: item (ccl::@selector "projectAction:"))
     218      (#/setTarget: item *project-menu*)
     219      (when (string= project *current-project*)
     220        (#/setState: item #$NSOnState))
     221      (#/addItem: menu item)))
     222  (#/addItem: menu (#/separatorItem ns:ns-menu-item))
     223  (let ((item (make-instance ns:ns-menu-item))
     224        (title (ccl::%make-nsstring "Save Histories")))
     225    (#/setTitle: item title)
     226    (#/setAction: item (ccl::@selector "saveHistoriesAction:"))
     227    (#/setTarget: item *project-menu*)
     228    (#/addItem: menu item))
     229  (let ((item (make-instance ns:ns-menu-item))
     230        (title (ccl::%make-nsstring "Clear File History")))
     231    (#/setTitle: item title)
     232    (#/setAction: item (ccl::@selector "clearFileHistoryAction:"))
     233    (#/setTarget: item *project-menu*)
     234    (#/addItem: menu item))
     235  (let ((item (make-instance ns:ns-menu-item))
     236        (title (ccl::%make-nsstring "Clear Position History")))
     237    (#/setTitle: item title)
     238    (#/setAction: item (ccl::@selector "clearPositionHistoryAction:"))
     239    (#/setTarget: item *project-menu*)
     240    (#/addItem: menu item))
     241  (#/addItem: menu (#/separatorItem ns:ns-menu-item))
     242  (let ((item (make-instance ns:ns-menu-item))
     243        (title (ccl::%make-nsstring "Create Project")))
     244    (#/setTitle: item title)
     245    (#/setAction: item (ccl::@selector "createProjectAction:"))
     246    (#/setTarget: item *project-menu*)
     247    (#/addItem: menu item))
     248  (let ((item (make-instance ns:ns-menu-item))
     249        (title (ccl::%make-nsstring "Delete Project")))
     250    (#/setTitle: item title)
     251    (#/setAction: item (ccl::@selector "deleteProjectAction:"))
     252    (#/setTarget: item *project-menu*)
     253    (#/addItem: menu item)))
     254     
     255(defun make-project-menu ()
     256  (let* ((name (ccl::%make-nsstring "Projects"))
     257         (menu-bar (#/mainMenu #&NSApp))
     258         (menu (#/initWithTitle: (#/allocWithZone:
     259                                  ns:ns-menu (#/menuZone ns:ns-menu))
     260                                 name))
     261         (menu-item (#/initWithTitle:action:keyEquivalent:
     262                     (#/allocWithZone: ns:ns-menu-item
     263                                       (#/menuZone ns:ns-menu))
     264                     name
     265                     (%null-ptr)
     266                     #@""))
     267         (project-list (list-projects)))
     268    (#/setSubmenu: menu-item menu)
     269    ;; (#/addItem: menu-bar menu-item)
     270    (#/insertItem:atIndex: menu-bar menu-item 1)
     271    ;; (#/release name)
     272    ;; (#/release menu-item)))
     273    (setq *project-menu* menu)
     274    (populate-menu menu project-list)))
     275
     276(make-project-menu)
    50277
    51278;;; ----------------------------------------------------------------------------
     
    126353(defClass HISTORY-LIST ()
    127354  ((capacity :initarg :capacity :reader hl-capacity)
    128    (path :initarg :path :reader hl-path)
     355   (path :initarg :path :accessor hl-path)
    129356   (list :initform nil :accessor hl-list))
    130357  (:documentation "Super class of position-history-list and file-history-list."))
     
    238465  "Remove all the entries from the file history list."
    239466  (setf (hl-list *file-history-list*) nil))
     467
     468(defun clear-history-lists ()
     469  "Remove all the entries from the file history list and position history list."
     470  (clear-file-history-list)
     471  (clear-position-history-list))
     472
     473(defun clear-history-paths ()
     474  (setf (hl-path *file-history-list*) nil)
     475  (setf (hl-path *position-history-list*) nil))
    240476
    241477;;; ----------------------------------------------------------------------------
     
    395631(defun read-history-files ()
    396632  "Read the position and file history lists."
    397   (let ((path (hl-path *file-history-list*)))
    398     (when (probe-file path)
    399       (with-open-file (stream path :direction :input)
    400         (read-history-list *file-history-list* stream))))
    401   (let ((path (hl-path *position-history-list*)))
    402     (when (probe-file path)
    403       (with-open-file (stream path :direction :input)
    404         (read-history-list *position-history-list* stream t)))))
     633  (when (hl-path *file-history-list*)
     634    (let ((path (hl-path *file-history-list*)))
     635      (when (probe-file path)
     636        (with-open-file (stream path :direction :input)
     637          (read-history-list *file-history-list* stream)))))
     638  (when (hl-path *position-history-list*)
     639    (let ((path (hl-path *position-history-list*)))
     640      (when (probe-file path)
     641        (with-open-file (stream path :direction :input)
     642          (read-history-list *position-history-list* stream t))))))
    405643
    406644(defMethod read-history-list ((hl history-list) stream &optional position-p)
     
    447685(defun write-history-files ()
    448686  "Write the history list entries to the path."
    449   (let ((path (hl-path *position-history-list*)))
    450     (with-open-file (stream path :direction :output :if-exists :supersede)
    451       (write-history-list *position-history-list* stream)))
    452   (let ((path (hl-path *file-history-list*)))
    453     (with-open-file (stream path :direction :output :if-exists :supersede)
    454       (write-history-list *file-history-list* stream))))
    455 
     687  (when (hl-path *position-history-list*)
     688    (let ((path (hl-path *position-history-list*)))
     689      (with-open-file (stream path :direction :output :if-exists :supersede)
     690        (write-history-list *position-history-list* stream))))
     691  (when (hl-path *file-history-list*)
     692    (let ((path (hl-path *file-history-list*)))
     693      (with-open-file (stream path :direction :output :if-exists :supersede)
     694        (write-history-list *file-history-list* stream)))))
     695
     696(defun write-current-project ()
     697  (unless (string= *current-project* "")
     698    (let ((path (merge-pathnames *current-project-path*
     699                                 (hemlock::user-homedir-pathname))))
     700      (with-open-file (stream path :direction :output :if-exists :supersede)
     701        (format stream "~s~%" *current-project*)))))
     702 
    456703(defun write-history-files-on-shutdown (&rest args)
    457704  "Writing function pushed into *lisp-cleanup-functions*."
    458705  (declare (ignore args))
     706  (write-current-project)
    459707  (write-history-files))
    460708
     
    594842
    595843(read-history-files)
    596 
    597 
     844;; (ldefs::open-first-file-history-list-entry)
     845
  • trunk/cocoa-ide-contrib/foy/list-definitions-cm/list-definitions.lisp

    r14985 r15594  
    1616;;;
    1717;;;      Mod History, most recent first:
     18;;;      1/10/13 Added Project Menu.
    1819;;;      9/9/11  update for ccl 1.7
    1920;;;      7/17/11 Added support for Scheme and Clojure files.
     
    4243(defParameter *def-search-pattern* (hi::new-search-pattern :string-insensitive :forward "(def"))
    4344(defParameter *left-paren-search-pattern* (hi::new-search-pattern :character :forward #\())
     45(defParameter *right-curly-brace-search-pattern* (hi::new-search-pattern :character :forward #\}))
    4446(defParameter *colon-search-pattern* (hi::new-search-pattern :character :forward #\:))
    4547(defParameter *slash-search-pattern* (hi::new-search-pattern :character :forward #\/))
     
    286288            (setq name (subseq name 0 (or (position #\space name) (length name)))))
    287289
     290          ;; Handle Clojure metadata
     291          (cond ((and (char= (hi::next-character start) #\^)
     292                      (char= (hi::next-character (hi::mark-after (clone start))) #\{))
     293                 ;;(format t "~%~%start: ~S" start)
     294                 ;;(format t "~%curly-left: ~S" (hi::mark-after (clone start)))
     295                 ;;(format t "~%find-pattern: ~S" (hi::find-pattern (hi::mark-after (clone start))
     296                 ;;                                   *right-curly-brace-search-pattern*))
     297                 (let* ((curly-left (hi::mark-after (clone start)))
     298                        (curly-right-p (hi::find-pattern curly-left *right-curly-brace-search-pattern*))
     299                        (end (when curly-right-p
     300                               (when (hemlock::form-offset (hi::mark-after curly-left) 1)
     301                                 curly-left)))
     302                        (start (when end (clone end))))
     303                    (when (and start end)
     304                      (hemlock::form-offset start -1)
     305                      ;; (format t "~%start: ~S" start)
     306                      ;; (format t "~%end: ~S" end)
     307                      (setq name (hi::region-to-string (hi::region start end))))))
     308                      ;; (format t "~%~%name: ~S" name))))
     309                   
     310                ((char= (hi::next-character start) #\^)
     311                 (let* ((end (let ((temp-mark (clone mark)))
     312                               (when (hemlock::form-offset (hi::mark-after temp-mark) 3)
     313                                 temp-mark)))
     314                        (start (when end
     315                                 (let ((temp-mark (clone end)))
     316                                   (when (hemlock::form-offset temp-mark -1)
     317                                     temp-mark)))))
     318                   (when (and start end)
     319                     (setq name (hi::region-to-string (hi::region start end)))))))
     320                     ;; (format t "~%~%name: ~S" name)))))
     321
    288322          (when (and (stringp name) (string-not-equal name ""))
    289323            (case def-type
     
    389423  "Display the file and scroll to the definition position."
    390424  (let ((window (cmenu:window-with-path path))
    391          mark def-list text-view hemlock-view)
    392     (unless (probe-file path)
    393       (cmenu:notify (format nil "~a does not exist."
    394                       path))
    395       (return-from find-and-display-definition nil))
    396     (cond (window
    397            (setq hemlock-view (gui::hemlock-view window))
    398            (setq text-view (gui::text-pane-text-view (hi::hemlock-view-pane hemlock-view))))
     425        (newline-pos (position #\newline path))
     426        mark def-list text-view hemlock-view)
     427    ;; (format t "~%~%path: ~S" path)
     428    ;; (format t "~%~%name: ~S" name)
     429    (cond (newline-pos
     430           ;; clojure.core/name gets precedence:
     431           (find-and-display-definition name (subseq path 0 newline-pos))
     432           (find-and-display-definition name (subseq path (+ 1 newline-pos))))
    399433          (t
    400            (setq hemlock-view (gui::cocoa-edit path))
    401            (when hemlock-view
    402              (setq window (#/window (hi::hemlock-view-pane hemlock-view)))
    403              (setq text-view (gui::text-pane-text-view (hi::hemlock-view-pane hemlock-view))))))
    404     (when window
    405       (#/makeKeyAndOrderFront: window nil)
    406       (setq def-list (list-definitions window))
    407       (setq mark (cdr (assoc name def-list
    408                              :test #'string-equal
    409                              :key #'(lambda (def-info)
    410                                       (let ((def-type (first def-info)))
    411                                         (if (or (eq def-type :defmethod)
    412                                                 (eq def-type :objc))
    413                                           (third def-info)
    414                                           (second def-info)))))))
    415       (when mark (display-position text-view mark)))))
     434           (unless (probe-file path)
     435             (cmenu:notify (format nil "~a does not exist."
     436                                   path))
     437             (return-from find-and-display-definition nil))
     438           (cond (window
     439                  (setq hemlock-view (gui::hemlock-view window))
     440                  (setq text-view (gui::text-pane-text-view (hi::hemlock-view-pane hemlock-view))))
     441                 (t
     442                  (setq hemlock-view (gui::cocoa-edit path))
     443                  (when hemlock-view
     444                    (setq window (#/window (hi::hemlock-view-pane hemlock-view)))
     445                    (setq text-view (gui::text-pane-text-view (hi::hemlock-view-pane hemlock-view))))))
     446           (when window
     447             (#/makeKeyAndOrderFront: window nil)
     448             (setq def-list (list-definitions window))
     449             ;; (format t "~%~%def-list: ~S" def-list)
     450             (setq mark (cdr (assoc name def-list
     451                                    :test #'string-equal
     452                                    :key #'(lambda (def-info)
     453                                             (let ((def-type (first def-info)))
     454                                               (if (or (eq def-type :defmethod)
     455                                                       (eq def-type :objc))
     456                                                 (third def-info)
     457                                                 (second def-info)))))))
     458             (cond (mark
     459                    (display-position text-view mark)
     460                    t)
     461                   (t
     462                    (#/close window)
     463                    nil)))))))
    416464
    417465
  • trunk/cocoa-ide-contrib/foy/source-comparison/source-compare-dialog.lisp

    r12737 r15594  
    3434(defun open-source-compare-dialog ()
    3535  (#/makeKeyAndOrderFront: *source-compare-dialog* nil))
    36 
    37 #|
    38 (setq *source-compare-dialog* nil)
    39 
    40 (gui::execute-in-gui 'open-source-compare-dialog)
    41 |#
    4236
    4337;;; This includes a work-around for what appears to be a bug in the hemlock-frame
     
    9791;;; ----------------------------------------------------------------------------
    9892;;;
    99 (defclass sc-text-view (ns:ns-text-view)
     93(defClass SC-TEXT-VIEW (ns:ns-text-view)
    10094  ()
    10195  (:metaclass ns:+ns-object))
     
    141135           (error "~%Action function not found for ~S" sender)))))
    142136
    143 (defmethod clear-difference-pane ((w source-compare-window))
     137(defMethod clear-difference-pane ((w source-compare-window))
    144138  (#/setString: (difference-pane w) #@""))
    145139
    146 (defmethod process-diff-string ((w source-compare-window) string)
     140(defMethod process-diff-string ((w source-compare-window) string)
    147141  (when (and string
    148142             (every #'(lambda (char)
  • trunk/cocoa-ide-contrib/foy/syntax-styling/syntax-styling-prefs.lisp

    r14988 r15594  
    1212;;;      Mod history, most recent first:
    1313;;;
     14;;;      1/14/13   removed close button.
    1415;;;      9/17/11   set common-lisp as target in open-prefs.
    1516;;;      9/7/11    update for ccl 1.7
     
    521522       r
    522523       (logior  #$NSTitledWindowMask
    523                 #$NSClosableWindowMask 
    524                 #$NSMiniaturizableWindowMask)
     524       ;;         #$NSClosableWindowMask 
     525       ;;         #$NSMiniaturizableWindowMask)
    525526       ;;                #$NSResizableWindowMask)
     527                )
    526528       #$NSBackingStoreBuffered
    527529       #$NO))
Note: See TracChangeset for help on using the changeset viewer.