Changeset 9682


Ignore:
Timestamp:
Jun 6, 2008, 8:38:18 PM (11 years ago)
Author:
mikel
Message:

added several svn and url utilities; added alert-window util to GUI package

Location:
trunk/source/cocoa-ide
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-utils.lisp

    r9247 r9682  
    298298(defmethod assume-not-editing ((whatever t)))
    299299
     300;;; -----------------------------------------------------------------
     301;;; utility to display a Cocoa alert window
     302;;; -----------------------------------------------------------------
     303
     304(defun alert-window (&key
     305                     (title "Alert")
     306                     (message "Something happened.")
     307                     (default-button "Okay")
     308                     alternate-button
     309                     other-button)
     310  (let ((nstitle (%make-nsstring title))
     311        (nsmessage (%make-nsstring message))
     312        (ns-default-button (%make-nsstring default-button))
     313        (ns-alternate-button (or (and alternate-button (%make-nsstring alternate-button))
     314                                 +null-ptr+))
     315        (ns-other-button (or (and other-button (%make-nsstring other-button))
     316                             +null-ptr+)))
     317    (#_NSRunAlertPanel nstitle nsmessage ns-default-button ns-alternate-button ns-other-button)
     318    (#/release nstitle)
     319    (#/release nsmessage)
     320    (#/release ns-default-button)
     321    (unless (eql ns-alternate-button +null-ptr+)
     322      (#/release ns-alternate-button))
     323    (unless (eql ns-other-button +null-ptr+)
     324      (#/release ns-other-button))))
  • trunk/source/cocoa-ide/ide-self-update.lisp

    r9668 r9682  
    1111
    1212(in-package :ccl)
    13 
    14 ;;; IDE: decide how and whether to handle cvs self-updates.
    15 ;;; see the cvs/svn code in update-ccl in compile-ccl.lisp
    16 
    17 ;;; use GUI::FIND-CCL-DIRECTORY to find the effective CCL directory
    18 ;;; (it gracefully handles the case where we are running from an
    19 ;;; app bundle, as well as the case where we are not)
    20 
    21 ;;; How to self-update the IDE from the svn or cvs repo
    22 ;;; 1. Find the ccl directory that corresponds to the running image
    23 ;;; 2. determine whether this is an svn or cvs checkout
    24 ;;; 3. SVN:
    25 ;;;   a. find the .svn directory
    26 ;;;   b. run svn info to get the svn URL
    27 ;;;   c. determine from the URL whether we need to authenticate
    28 ;;;   d. get auth tokens if we need them
    29 ;;;   d. record the svn revision before we start (so we can roll back
    30 ;;;      if things go horribly wrong)
    31 ;;;   e. run svn status to check for potential merge conflicts before starting
    32 ;;;      the update
    33 ;;;   f. construct the svn command:
    34 ;;;       i. cd to the proper CCL directory
    35 ;;;      ii. run svn update
    36 ;;;   g. run the svn command with external-process-status.
    37 ;;;   h.  check the status of the external command for success or failure:
    38 ;;;      i. if okay, queue a full-rebuild, and a rebuild of the IDE
    39 ;;;         (need to make some infrastructure for queuing these activities
    40 ;;;         and running them on next launch, or immediately in an external process)
    41 ;;;     ii. if not okay, warn the user, and offer to roll back to the
    42 ;;;         previously-recorded version (need to make some infrastructure for
    43 ;;;         running a rollback)
    44 ;;; TODO: make a cvs version if needed
     13(require :sequence-utils)
    4514
    4615;;; -----------------------------------------------------------------
     
    4918
    5019;;; VALIDATE-SVN-DATA-PATHNAME p
    51 ;;; ---------------------
     20;;; -----------------------------------------------------------------
    5221;;; returns TRUE if P is really an existing directory that appears to
    53 ;;; contain valid Subversion metadata; FALSE otherwise
    54 
    55 (defun validate-svn-data-pathname (p)
     22;;; contain valid Subversion metadata; NIL otherwise
     23
     24(defmethod validate-svn-data-pathname ((p pathname))
    5625  (and (probe-file p)
    5726       (directoryp p)
     
    6534                subversion-metafiles))))
    6635
    67 ;;; given a valid-looking .svn directory, we should be able to use
    68 ;;; the svn executable to get the repository URL. we call:
    69 ;;;  svn info
    70 ;;; and get a big block of info text. one line of the output
    71 ;;; is of the form:
    72 ;;;  URL: yatta-yatta
    73 ;;; where yatta-yatta is the repository URL of the checked out directory
    74 ;;; Another piece of information we want shows Up here, too: the
    75 ;;; current revision, on a line of the form:
    76 ;;; Revision: foobar
    77 
    78 (defun split-svn-info-line (line)
     36(defmethod validate-svn-data-pathname ((p string))
     37  (validate-svn-data-pathname (pathname p)))
     38
     39;;; -----------------------------------------------------------------
     40;;; url utils
     41;;; -----------------------------------------------------------------
     42
     43;;; URL-PROTOCOL url
     44;;; -----------------------------------------------------------------
     45;;; returns the protocol pprtion of the URL, or NIL if none
     46;;; can be identified
     47
     48(defmethod url-protocol ((url string))
     49  (let ((index (find-matching-subsequence "://" url)))
     50    (if index
     51        (subseq url 0 index)
     52        nil)))
     53
     54;;; URL-HOST url
     55;;; -----------------------------------------------------------------
     56;;; returns two values:
     57;;; 1. the hostname of the URL
     58;;; 2. the username portion of the host segment, if any, or NIL
     59
     60(defmethod url-host ((url string))
     61  (let* ((protocol-marker "://")
     62         (protocol-marker-index (find-matching-subsequence protocol-marker url)))
     63    (if protocol-marker-index
     64        (let* ((protocol-end-index (+ protocol-marker-index (length protocol-marker)))
     65               (host-end-index (find-matching-subsequence "/" url :start protocol-end-index))
     66               (host-segment (subseq url protocol-end-index host-end-index))
     67               (username-terminus-index (find-matching-subsequence "@" host-segment))
     68               (username (if username-terminus-index
     69                             (subseq host-segment 0 username-terminus-index)
     70                             nil))
     71               (host (if username-terminus-index
     72                         (subseq host-segment (1+ username-terminus-index))
     73                         host-segment)))
     74          (values host username))
     75        nil)))
     76
     77;;; URL-PATH url
     78;;; -----------------------------------------------------------------
     79;;; returns the pathname portion of a URL, or NIL if none can be identified
     80
     81(defmethod url-path ((url string))
     82  (let* ((protocol-marker "://")
     83         (protocol-marker-index (find-matching-subsequence protocol-marker url)))
     84    (if protocol-marker-index
     85        (let* ((protocol-end-index (+ protocol-marker-index (length protocol-marker)))
     86               (host-end-index (find-matching-subsequence "/" url :start protocol-end-index)))
     87          (if host-end-index
     88              (subseq url host-end-index)
     89              nil))
     90        nil)))
     91
     92;;; -----------------------------------------------------------------
     93;;; getting svn info
     94;;; -----------------------------------------------------------------
     95
     96(defmethod svn-info ((p string))
     97  (with-output-to-string (out)
     98     (run-program "svn" `("info" ,p) :output out)))
     99
     100(defmethod svn-info ((p pathname))
     101  (svn-info (namestring p)))
     102
     103(defmethod split-svn-info-line ((line string))
    79104  (let* ((split-sequence ": ")
    80105         (split-index (find-matching-subsequence split-sequence line :test #'char=))
     
    85110    (list prefix suffix)))
    86111
    87 (defun parse-svn-info (info-string)
     112(defmethod parse-svn-info ((info-string string))
    88113  (let ((info-lines (split-lines info-string)))
    89114    (mapcar #'split-svn-info-line info-lines)))
    90115
    91 (defun get-svn-info (p)
    92   (parse-svn-info
    93    (with-output-to-string (out)
    94      (run-program "svn" `("info" ,(namestring p)) :output out))))
     116(defmethod get-svn-info ((p string))
     117  (parse-svn-info (svn-info p)))
     118
     119(defmethod get-svn-info ((p pathname))
     120  (get-svn-info (namestring p)))
     121
     122(defmethod svn-revision ((p string))
     123  (let* ((info (get-svn-info p))
     124         (revision-entry (assoc "Revision" info :test #'string=)))
     125    (when revision-entry (second revision-entry))))
     126
     127(defmethod svn-revision ((p pathname))
     128  (svn-revision (namestring p)))
    95129
    96130;;; -----------------------------------------------------------------
    97131;;; authentication utils, for use with source control
    98132;;; -----------------------------------------------------------------
     133;;; NOTE: currently unused, because we do not update from the GUI
     134;;;       in the case that authentication is required. code left here
     135;;;       for future reference
    99136
    100137;;; we infer from the information in the URL field of the svn info
     
    156193;;; -----------------------------------------------------------------
    157194
    158 (defun alert (&key
    159               (title "Alert")
    160               (message "Something happened.")
    161               (default-button "Okay")
    162               alternate-button
    163               other-button)
    164   (let ((nstitle (%make-nsstring title))
    165         (nsmessage (%make-nsstring message))
    166         (ns-default-button (%make-nsstring default-button))
    167         (ns-alternate-button (or (and alternate-button (%make-nsstring alternate-button))
    168                                  +null-ptr+))
    169         (ns-other-button (or (and other-button (%make-nsstring other-button))
    170                              +null-ptr+)))
    171     (#_NSRunAlertPanel nstitle nsmessage ns-default-button ns-alternate-button ns-other-button)
    172     (#/release nstitle)
    173     (#/release nsmessage)
    174     (#/release ns-default-button)
    175     (unless (eql ns-alternate-button +null-ptr+)
    176       (#/release ns-alternate-button))
    177     (unless (eql ns-other-button +null-ptr+)
    178       (#/release ns-other-button))))
    179 
    180195(defun valid-revision-number-for-svn-update? (rev)
    181196  (and (stringp rev)
     
    196211  (cond
    197212    ((not (valid-directory-for-svn-update? directory))
    198      (alert :title "Update Failed"
    199             :message (format nil "Subversion update failed. CCL directory '~A' doesn't exist, or lacks valid Subversion metadata."
    200                              directory)))
     213     (gui::alert-window :title "Update Failed"
     214                   :message (format nil
     215                                    "Subversion update failed. CCL directory '~A' doesn't exist, or lacks valid Subversion metadata."
     216                                    directory)))
    201217    ((not (valid-repository-for-svn-update? repository))
    202      (alert :title "Update Failed"
    203             :message (format nil "Subversion update failed. The supplied repository URL is invalid: '~A'"
    204                              repository)))
     218     (gui::alert-window :title "Update Failed"
     219                   :message (format nil "Subversion update failed. The supplied repository URL is invalid: '~A'"
     220                                    repository)))
    205221    ((not (valid-revision-number-for-svn-update? last-revision))
    206      (alert :title "Update Failed"
    207             :message (format nil "Subversion update failed. CCL found an invalid revision number for the current working copy: '~A'"
    208                              last-revision)))
    209     (t (alert :title "Update Succeeded"
    210               :message "Subversion update succeeded. Soon we will actually run the update when it succeeds."))))
     222     (gui::alert-window :title "Update Failed"
     223                   :message (format nil "Subversion update failed. CCL found an invalid revision number for the current working copy: '~A'"
     224                                    last-revision)))
     225    (t (gui::alert-window :title "Update Succeeded"
     226                     :message "Subversion update succeeded. Soon we will actually run the update when it succeeds."))))
    211227
    212228(defun run-svn-update-for-directory (dir)
     
    252268          (make-instance 'update-ccl-window-controller))
    253269    (#/initWithWindowNibName: *update-ccl-window-controller* #@"updateCCL"))
    254   ;;(#/showWindow: *update-ccl-window-controller* self)
    255270  (unless (#/isWindowLoaded *update-ccl-window-controller*)
    256271    (#/loadWindow *update-ccl-window-controller*))
Note: See TracChangeset for help on using the changeset viewer.