Changeset 7362 for branches

Timestamp:

Oct 5, 2007, 10:01:00 AM (17 years ago)

Author:

R. Matthew Emerson

Message:

Merge trunk changes r7339:7360

Location:

branches/ia32

Files:

• cocoa-ide/OpenMCL.app/Contents/Resources/English.lproj/preferences.nib/info.nib (modified) (1 diff)
• cocoa-ide/OpenMCL.app/Contents/Resources/English.lproj/preferences.nib/keyedobjects.nib (modified) ( previous)
• cocoa-ide/build-application.lisp (modified) (1 diff)
• cocoa-ide/builder-utilities.lisp (modified) (3 diffs)
• cocoa-ide/cocoa-grep.lisp (modified) (6 diffs)
• cocoa-ide/cocoa-listener.lisp (modified) (1 diff)
• cocoa-ide/hemlock/src/listener.lisp (modified) (1 diff)
• level-0/PPC/ppc-misc.lisp (modified) (1 diff)
• level-0/X86/x86-misc.lisp (modified) (1 diff)
• level-0/l0-numbers.lisp (modified) (1 diff)
• level-1/l1-lisp-threads.lisp (modified) (1 diff)
• level-1/l1-sysio.lisp (modified) (1 diff)
• lib/describe.lisp (modified) (2 diffs)

branches/ia32/cocoa-ide/OpenMCL.app/Contents/Resources/English.lproj/preferences.nib/info.nib

@@ -4 +4 @@
 <dict>
         <key>IBDocumentLocation</key>
-        <string>69 10 356 240 0 0 1280 1002 </string>
+        <string>69 44 356 240 0 0 1280 1002 </string>
         <key>IBFramework Version</key>
         <string>446.1</string>
         <key>IBOldestOS</key>
         <integer>5</integer>
+        <key>IBOpenObjects</key>
+        <array>
+                <integer>1</integer>
+        </array>
         <key>IBSystem Version</key>
-        <string>8P135</string>
+        <string>8R218</string>
         <key>IBUsesTextArchiving</key>
         <true/>

branches/ia32/cocoa-ide/build-application.lisp

@@ -67 +67 @@
                                               :main-nib-name main-nib-name))
          (image-path (namestring (path app-bundle "Contents" "MacOS" name))))
+
     ;; copy IDE resources into the application bundle
     (recursive-copy-directory (path ide-bundle-path "Contents" "Resources/")

branches/ia32/cocoa-ide/builder-utilities.lisp

@@ -17 +17 @@
 ;;; application-building tools for building and copying bundles,
 ;;; resource directories, and magic files used by OSX applications.
+
+(defun load-nibfile (nib-path)
+  (let* ((appclass (#_NSClassFromString (%make-nsstring "NSApplication")))
+         (app (#/sharedApplication appclass))
+         (main-nib-name (%make-nsstring (namestring nib-path))))
+         ;; ----------------------------------------
+         ;; load the application nib
+         (#/loadNibNamed:owner: (@class ns-bundle)
+                   main-nib-name
+                   app)
+         app))
 
 ;;; PATHNAME-SEPARATOR
@@ -83 +94 @@
 (defun recursive-copy-directory (source-path dest-path)
   (ensure-directories-exist (ensure-directory-pathname dest-path))
-  (let ((files (directory (path source-path "*") :directories nil :files t))
-        (subdirs (directory (path source-path "*") :directories t :files nil)))
+  (let ((files (directory (path source-path "*.*") :directories nil :files t))
+        (subdirs (directory (path source-path "*.*") :directories t :files nil)))
+;    (format t "~%files = ~S" files)
+;    (format t "~%subdirs = ~S~%" subdirs)
     (dolist (f files)
       (let* ((src-name (file-namestring f))
@@ -95 +108 @@
              (dest-dir (ensure-directory-pathname (path dest-path subdir-name))))
         (recursive-copy-directory d dest-dir)))
-    dest-path))
+    dest-path
+    ))
 
 ;;; WRITE-PKGINFO path package-type bundle-signature

branches/ia32/cocoa-ide/cocoa-grep.lisp

@@ -46 +46 @@
       (hi::buffer-end point))))
 
-(defun request-edit-grep-line (line)
+(defun parse-grep-line (line)
   (let* ((pos1 (position #\: line))
          (pos2 (and pos1 (position #\: line :start (1+ pos1))))
@@ -54 +54 @@
          (file (and num (subseq line 0 pos1))))
     (when file
+      (values file (1- num)))))
+  
+(defun request-edit-grep-line (line)
+  (multiple-value-bind (file line-num) (parse-grep-line line)
+    (when file
       (let* ((request (make-instance 'cocoa-edit-grep-line-request
                                      :with-file (assign-id-map-id *edit-definition-id-map* file)
-                                     :line num)))
+                                     :line line-num)))
         (#/performSelectorOnMainThread:withObject:waitUntilDone:
          (#/sharedDocumentController ns:ns-document-controller)
@@ -62 +67 @@
          request
          t)))))
+
+(defun grep-comment-line-p (line)
+  (multiple-value-bind (file line-num) (parse-grep-line line)
+    (with-open-file (stream file)
+      (loop while (> line-num 0)
+        for ch = (read-char stream nil nil)
+        when (null ch) do (return nil)
+        do (when (member ch '(#\Return #\Linefeed))
+             (decf line-num)
+             (when (and (eql ch #\Return)
+                        (eql (peek-char nil stream nil nil) #\Linefeed))
+               (read-char stream))))
+      (when (eql line-num 0)
+        (loop as ch = (read-char stream nil nil)
+          while (and ch (whitespacep ch) (not (member ch '(#\Return #\Linefeed))))
+          finally (return (eql ch #\;)))))))
+
+(defun grep-remove-comment-lines (lines)
+  (remove-if #'grep-comment-line-p lines))
 
 (defun split-grep-lines (output)
@@ -69 +93 @@
     when (< start pos) collect (subseq output start pos)
     while (< pos end)))
+
 
 (defun grep (pattern directory &key ignore-case (include "*.lisp") (exclude "*~.lisp"))
@@ -87 +112 @@
         (let ((output (get-output-stream-string stream)))
           (if (and (eq :exited status) (or (= exit-code 0) (= exit-code 2)))
-              (make-instance 'sequence-window-controller
-                             :sequence (split-grep-lines output)
-                             :result-callback #'request-edit-grep-line
-                             :display #'princ
-                             :title (format nil "~a in ~a" pattern directory))
+              (let ((lines (split-grep-lines output)))
+                (unless (hi:value hemlock::grep-search-comments)
+                  (setq lines (grep-remove-comment-lines lines)))
+                (make-instance 'sequence-window-controller
+                               :sequence lines
+                               :result-callback #'request-edit-grep-line
+                               :display #'princ
+                               :title (format nil "~a in ~a" pattern directory)))
               (hi:editor-error "Error in grep status ~s code ~s: ~a" status exit-code output)))))))
 
@@ -98 +126 @@
   "The directory searched by \"Grep\".  NIL means to use the directory of the buffer."
   :value nil)
+
+(hi:defhvar "Grep Search Comments"
+  "If true (the default) grep will find results anywhere.  NIL means to ignore results
+   within comments.  For now only recognizes as comments lines which start with semi-colon."
+  :value t)
 
 (hi:defcommand "Grep" (p)

branches/ia32/cocoa-ide/cocoa-listener.lisp

@@ -15 +15 @@
 
 (def-cocoa-default *listener-background-color* :color '(1.0 1.0 1.0 1.0) "Listener default background color")
+
+(def-cocoa-default *read-only-listener* :bool t "Do not allow editing old listener output")
 
 ;;; Setup the server end of a pty pair.

branches/ia32/cocoa-ide/hemlock/src/listener.lisp

@@ -103 +103 @@
       )
     (let* ((input-mark (variable-value 'buffer-input-mark :buffer buffer)))
-      (setf (hi::buffer-protected-region buffer)
-            (region (buffer-start-mark buffer) input-mark))
+      (when ccl::*read-only-listener*
+        (setf (hi::buffer-protected-region buffer)
+              (region (buffer-start-mark buffer) input-mark)))
       (move-mark input-mark point)
       (append-font-regions buffer))))

branches/ia32/level-0/PPC/ppc-misc.lisp

@@ -1011 +1011 @@
   (blr))
 
-;;; Work around buggy #_nanosleep implementations.
-(defppclapfunction %valid-remaining-timespec-time-p ((seconds arg_y) (ptr arg_z))
-  (unbox-fixnum imm4 seconds)
-  (lis imm1 (ash 1000000000 -16))
-  (macptr-ptr imm0 ptr)
-  (ori imm1 imm1 (logand #xffff 1000000000))
-  (li arg_z nil)
-  (ldr imm3 0 imm0)
-  (cmplr cr2 imm0 imm4)
-  (cmpr cr1 imm3 rzero)
-  (ldr imm2 target::node-size imm0)
-  (cmplr imm2 imm1)
-  (bgt cr4 @done)
-  (blt cr1 @done)
-  (bge @done)
-  (or. imm3 imm3 imm2)
-  (beq @done)
-  (li arg_z t)
-  @done
-  (blr))
+
 
 ;;; r13 contains thread context on Linux/Darwin PPC64.

branches/ia32/level-0/X86/x86-misc.lisp

@@ -749 +749 @@
 ;;; Leopard test releases.  It's probably not necessary any more; is
 ;;; it still called ?
-(defx86lapfunction %valid-remaining-timespec-time-p ((seconds arg_y) (ptr arg_z))
-  (macptr-ptr arg_z imm0)
-  (unbox-fixnum seconds imm1)
-  (movl ($ x8664::nil-value) (% arg_z.l))
-  (cmpq ($ 0) (@ (% imm0)))
-  (jl @done)
-  (cmpq (% imm1) (% imm0))
-  (ja @done)
-  (cmpq ($ 1000000000) (@ 8 (% imm0)))
-  (jae @done)
-  (movq (@ (% imm0)) (% imm1))
-  (orq (@ 8 (% imm0)) (% imm1))
-  (jz @done)
-  (movl ($ x8664::t-value) (% arg_z.l))
-  @done
-  (single-value-return))
+
 
 ;;; end of x86-misc.lisp

branches/ia32/level-0/l0-numbers.lisp

@@ -1715 +1715 @@
 
 (defun init-random-state-seeds ()
-  (let* ((ticks (ldb (byte 32 0) (get-internal-real-time)))
-         (high (ldb (byte 16 16) ticks)) 
+  (let* ((ticks (ldb (byte 32 0) (+ (mixup-hash-code (%current-tcr))
+                                    (primary-ip-interface-address)
+                                    (mixup-hash-code
+                                     (logand (get-internal-real-time)
+                                             (1- most-positive-fixnum))))))
+         (high (ldb (byte 16 16) (if (zerop ticks) #x10000 ticks)))
          (low (ldb (byte 16 0) ticks)))
     (declare (fixnum high low))

branches/ia32/level-1/l1-lisp-threads.lisp

@@ -51 +51 @@
           (declare (type (signed-byte 32) result))
           (if (and (< result 0)
-                   (eql (%get-errno) (- #$EINTR))
-                   (%valid-remaining-timespec-time-p seconds bptr))
+                   (eql (%get-errno) (- #$EINTR)))
             (psetq aptr bptr bptr aptr)
             (return)))))))

branches/ia32/level-1/l1-sysio.lisp

@@ -769 +769 @@
                      (let ((truename (native-to-pathname native-truename)))
                        (setq temp-name (gen-file-name truename))
-                       (unix-rename native-truename (namestring temp-name))
+                       (unix-rename native-truename (native-untranslated-namestring temp-name))
                        (%create-file native-truename))))))
               (return-from open nil)))

branches/ia32/lib/describe.lisp

@@ -1185 +1185 @@
              (values nclosed "Closed over values" :comment #'prin1-comment))
             ((< (decf n) nclosed)
-             (let* ((value (ccl::%svref o (1+ (- nclosed n))))
+             (let* ((value (ccl::nth-immediate o (1+ (- nclosed n))))
                     (map (car (ccl::function-symbol-map (ccl::closure-function o))))
                     (label (or (and map (svref map (+ n (- (length map) nclosed))))
@@ -1218 +1218 @@
              (setf-line-n-out-of-range f en))
             ((< (decf n) nclosed)       ; closed-over variable
-             (let* ((value (ccl::%svref o (1+ (- nclosed n))))
+             (let* ((value (ccl::nth-immediate o (1+ (- nclosed n))))
                     (cellp (ccl::closed-over-value-p value)))
                (unless cellp (setf-line-n-out-of-range f en))