Changeset 7362


Ignore:
Timestamp:
Oct 5, 2007, 5:01:00 PM (12 years ago)
Author:
rme
Message:

Merge trunk changes r7339:7360

Location:
branches/ia32
Files:
13 edited

Legend:

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

    r6845 r7362  
    44<dict>
    55        <key>IBDocumentLocation</key>
    6         <string>69 10 356 240 0 0 1280 1002 </string>
     6        <string>69 44 356 240 0 0 1280 1002 </string>
    77        <key>IBFramework Version</key>
    88        <string>446.1</string>
    99        <key>IBOldestOS</key>
    1010        <integer>5</integer>
     11        <key>IBOpenObjects</key>
     12        <array>
     13                <integer>1</integer>
     14        </array>
    1115        <key>IBSystem Version</key>
    12         <string>8P135</string>
     16        <string>8R218</string>
    1317        <key>IBUsesTextArchiving</key>
    1418        <true/>
  • branches/ia32/cocoa-ide/build-application.lisp

    r7244 r7362  
    6767                                              :main-nib-name main-nib-name))
    6868         (image-path (namestring (path app-bundle "Contents" "MacOS" name))))
     69
    6970    ;; copy IDE resources into the application bundle
    7071    (recursive-copy-directory (path ide-bundle-path "Contents" "Resources/")
  • branches/ia32/cocoa-ide/builder-utilities.lisp

    r7244 r7362  
    1717;;; application-building tools for building and copying bundles,
    1818;;; resource directories, and magic files used by OSX applications.
     19
     20(defun load-nibfile (nib-path)
     21  (let* ((appclass (#_NSClassFromString (%make-nsstring "NSApplication")))
     22         (app (#/sharedApplication appclass))
     23         (main-nib-name (%make-nsstring (namestring nib-path))))
     24         ;; ----------------------------------------
     25         ;; load the application nib
     26         (#/loadNibNamed:owner: (@class ns-bundle)
     27                   main-nib-name
     28                   app)
     29         app))
    1930
    2031;;; PATHNAME-SEPARATOR
     
    8394(defun recursive-copy-directory (source-path dest-path)
    8495  (ensure-directories-exist (ensure-directory-pathname dest-path))
    85   (let ((files (directory (path source-path "*") :directories nil :files t))
    86         (subdirs (directory (path source-path "*") :directories t :files nil)))
     96  (let ((files (directory (path source-path "*.*") :directories nil :files t))
     97        (subdirs (directory (path source-path "*.*") :directories t :files nil)))
     98;    (format t "~%files = ~S" files)
     99;    (format t "~%subdirs = ~S~%" subdirs)
    87100    (dolist (f files)
    88101      (let* ((src-name (file-namestring f))
     
    95108             (dest-dir (ensure-directory-pathname (path dest-path subdir-name))))
    96109        (recursive-copy-directory d dest-dir)))
    97     dest-path))
     110    dest-path
     111    ))
    98112
    99113;;; WRITE-PKGINFO path package-type bundle-signature
  • branches/ia32/cocoa-ide/cocoa-grep.lisp

    r7244 r7362  
    4646      (hi::buffer-end point))))
    4747
    48 (defun request-edit-grep-line (line)
     48(defun parse-grep-line (line)
    4949  (let* ((pos1 (position #\: line))
    5050         (pos2 (and pos1 (position #\: line :start (1+ pos1))))
     
    5454         (file (and num (subseq line 0 pos1))))
    5555    (when file
     56      (values file (1- num)))))
     57 
     58(defun request-edit-grep-line (line)
     59  (multiple-value-bind (file line-num) (parse-grep-line line)
     60    (when file
    5661      (let* ((request (make-instance 'cocoa-edit-grep-line-request
    5762                                     :with-file (assign-id-map-id *edit-definition-id-map* file)
    58                                      :line num)))
     63                                     :line line-num)))
    5964        (#/performSelectorOnMainThread:withObject:waitUntilDone:
    6065         (#/sharedDocumentController ns:ns-document-controller)
     
    6267         request
    6368         t)))))
     69
     70(defun grep-comment-line-p (line)
     71  (multiple-value-bind (file line-num) (parse-grep-line line)
     72    (with-open-file (stream file)
     73      (loop while (> line-num 0)
     74        for ch = (read-char stream nil nil)
     75        when (null ch) do (return nil)
     76        do (when (member ch '(#\Return #\Linefeed))
     77             (decf line-num)
     78             (when (and (eql ch #\Return)
     79                        (eql (peek-char nil stream nil nil) #\Linefeed))
     80               (read-char stream))))
     81      (when (eql line-num 0)
     82        (loop as ch = (read-char stream nil nil)
     83          while (and ch (whitespacep ch) (not (member ch '(#\Return #\Linefeed))))
     84          finally (return (eql ch #\;)))))))
     85
     86(defun grep-remove-comment-lines (lines)
     87  (remove-if #'grep-comment-line-p lines))
    6488
    6589(defun split-grep-lines (output)
     
    6993    when (< start pos) collect (subseq output start pos)
    7094    while (< pos end)))
     95
    7196
    7297(defun grep (pattern directory &key ignore-case (include "*.lisp") (exclude "*~.lisp"))
     
    87112        (let ((output (get-output-stream-string stream)))
    88113          (if (and (eq :exited status) (or (= exit-code 0) (= exit-code 2)))
    89               (make-instance 'sequence-window-controller
    90                              :sequence (split-grep-lines output)
    91                              :result-callback #'request-edit-grep-line
    92                              :display #'princ
    93                              :title (format nil "~a in ~a" pattern directory))
     114              (let ((lines (split-grep-lines output)))
     115                (unless (hi:value hemlock::grep-search-comments)
     116                  (setq lines (grep-remove-comment-lines lines)))
     117                (make-instance 'sequence-window-controller
     118                               :sequence lines
     119                               :result-callback #'request-edit-grep-line
     120                               :display #'princ
     121                               :title (format nil "~a in ~a" pattern directory)))
    94122              (hi:editor-error "Error in grep status ~s code ~s: ~a" status exit-code output)))))))
    95123
     
    98126  "The directory searched by \"Grep\".  NIL means to use the directory of the buffer."
    99127  :value nil)
     128
     129(hi:defhvar "Grep Search Comments"
     130  "If true (the default) grep will find results anywhere.  NIL means to ignore results
     131   within comments.  For now only recognizes as comments lines which start with semi-colon."
     132  :value t)
    100133
    101134(hi:defcommand "Grep" (p)
  • branches/ia32/cocoa-ide/cocoa-listener.lisp

    r7244 r7362  
    1515
    1616(def-cocoa-default *listener-background-color* :color '(1.0 1.0 1.0 1.0) "Listener default background color")
     17
     18(def-cocoa-default *read-only-listener* :bool t "Do not allow editing old listener output")
    1719
    1820;;; Setup the server end of a pty pair.
  • branches/ia32/cocoa-ide/hemlock/src/listener.lisp

    r7244 r7362  
    103103      )
    104104    (let* ((input-mark (variable-value 'buffer-input-mark :buffer buffer)))
    105       (setf (hi::buffer-protected-region buffer)
    106             (region (buffer-start-mark buffer) input-mark))
     105      (when ccl::*read-only-listener*
     106        (setf (hi::buffer-protected-region buffer)
     107              (region (buffer-start-mark buffer) input-mark)))
    107108      (move-mark input-mark point)
    108109      (append-font-regions buffer))))
  • branches/ia32/level-0/PPC/ppc-misc.lisp

    r6179 r7362  
    10111011  (blr))
    10121012
    1013 ;;; Work around buggy #_nanosleep implementations.
    1014 (defppclapfunction %valid-remaining-timespec-time-p ((seconds arg_y) (ptr arg_z))
    1015   (unbox-fixnum imm4 seconds)
    1016   (lis imm1 (ash 1000000000 -16))
    1017   (macptr-ptr imm0 ptr)
    1018   (ori imm1 imm1 (logand #xffff 1000000000))
    1019   (li arg_z nil)
    1020   (ldr imm3 0 imm0)
    1021   (cmplr cr2 imm0 imm4)
    1022   (cmpr cr1 imm3 rzero)
    1023   (ldr imm2 target::node-size imm0)
    1024   (cmplr imm2 imm1)
    1025   (bgt cr4 @done)
    1026   (blt cr1 @done)
    1027   (bge @done)
    1028   (or. imm3 imm3 imm2)
    1029   (beq @done)
    1030   (li arg_z t)
    1031   @done
    1032   (blr))
     1013
    10331014
    10341015;;; r13 contains thread context on Linux/Darwin PPC64.
  • branches/ia32/level-0/X86/x86-misc.lisp

    r7340 r7362  
    749749;;; Leopard test releases.  It's probably not necessary any more; is
    750750;;; it still called ?
    751 (defx86lapfunction %valid-remaining-timespec-time-p ((seconds arg_y) (ptr arg_z))
    752   (macptr-ptr arg_z imm0)
    753   (unbox-fixnum seconds imm1)
    754   (movl ($ x8664::nil-value) (% arg_z.l))
    755   (cmpq ($ 0) (@ (% imm0)))
    756   (jl @done)
    757   (cmpq (% imm1) (% imm0))
    758   (ja @done)
    759   (cmpq ($ 1000000000) (@ 8 (% imm0)))
    760   (jae @done)
    761   (movq (@ (% imm0)) (% imm1))
    762   (orq (@ 8 (% imm0)) (% imm1))
    763   (jz @done)
    764   (movl ($ x8664::t-value) (% arg_z.l))
    765   @done
    766   (single-value-return))
     751
    767752
    768753;;; end of x86-misc.lisp
  • branches/ia32/level-0/l0-numbers.lisp

    r7287 r7362  
    17151715
    17161716(defun init-random-state-seeds ()
    1717   (let* ((ticks (ldb (byte 32 0) (get-internal-real-time)))
    1718          (high (ldb (byte 16 16) ticks))
     1717  (let* ((ticks (ldb (byte 32 0) (+ (mixup-hash-code (%current-tcr))
     1718                                    (primary-ip-interface-address)
     1719                                    (mixup-hash-code
     1720                                     (logand (get-internal-real-time)
     1721                                             (1- most-positive-fixnum))))))
     1722         (high (ldb (byte 16 16) (if (zerop ticks) #x10000 ticks)))
    17191723         (low (ldb (byte 16 0) ticks)))
    17201724    (declare (fixnum high low))
  • branches/ia32/level-1/l1-lisp-threads.lisp

    r6491 r7362  
    5151          (declare (type (signed-byte 32) result))
    5252          (if (and (< result 0)
    53                    (eql (%get-errno) (- #$EINTR))
    54                    (%valid-remaining-timespec-time-p seconds bptr))
     53                   (eql (%get-errno) (- #$EINTR)))
    5554            (psetq aptr bptr bptr aptr)
    5655            (return)))))))
  • branches/ia32/level-1/l1-sysio.lisp

    r6019 r7362  
    769769                     (let ((truename (native-to-pathname native-truename)))
    770770                       (setq temp-name (gen-file-name truename))
    771                        (unix-rename native-truename (namestring temp-name))
     771                       (unix-rename native-truename (native-untranslated-namestring temp-name))
    772772                       (%create-file native-truename))))))
    773773              (return-from open nil)))
  • branches/ia32/lib/describe.lisp

    r6926 r7362  
    11851185             (values nclosed "Closed over values" :comment #'prin1-comment))
    11861186            ((< (decf n) nclosed)
    1187              (let* ((value (ccl::%svref o (1+ (- nclosed n))))
     1187             (let* ((value (ccl::nth-immediate o (1+ (- nclosed n))))
    11881188                    (map (car (ccl::function-symbol-map (ccl::closure-function o))))
    11891189                    (label (or (and map (svref map (+ n (- (length map) nclosed))))
     
    12181218             (setf-line-n-out-of-range f en))
    12191219            ((< (decf n) nclosed)       ; closed-over variable
    1220              (let* ((value (ccl::%svref o (1+ (- nclosed n))))
     1220             (let* ((value (ccl::nth-immediate o (1+ (- nclosed n))))
    12211221                    (cellp (ccl::closed-over-value-p value)))
    12221222               (unless cellp (setf-line-n-out-of-range f en))
Note: See TracChangeset for help on using the changeset viewer.