Changeset 11928 for release


Ignore:
Timestamp:
Apr 9, 2009, 11:04:15 PM (10 years ago)
Author:
rme
Message:

Merge trunk changes r11900 through r11919.

Location:
release/1.3/source
Files:
17 edited

Legend:

Unmodified
Added
Removed
  • release/1.3/source/cocoa-ide/cocoa-editor.lisp

    r11747 r11928  
    2727(def-cocoa-default *use-screen-fonts* :bool t "Use bitmap screen fonts when available")
    2828
     29(def-cocoa-default *option-is-meta* :bool t "Use option key as meta?")
    2930
    3031(defgeneric hemlock-view (ns-object))
     
    785786         (view (front-view-for-buffer buffer)))
    786787    (when view
    787       (hi::handle-hemlock-event view #'(lambda ()
    788                                          (hi:paste-characters position length
    789                                                               lisp-string))))))
     788      (let* ((edit-count (slot-value self 'edit-count)))
     789        (dotimes (i edit-count) (#/endEditing self))
     790        (hi::handle-hemlock-event view #'(lambda ()
     791                                           (hi:paste-characters position length
     792                                                                lisp-string)))
     793        (dotimes (i edit-count)
     794          (#/beginEditing self))))))
    790795
    791796(objc:defmethod (#/setAttributes:range: :void) ((self hemlock-text-storage)
     
    904909  (let* ((view (hemlock-view self))
    905910         ;; quote-p means handle characters natively
    906          (quote-p (and view (hi::hemlock-view-quote-next-p view))))
     911         (quote-p (and view (hi::hemlock-view-quote-next-p view)))
     912         (flags (#/modifierFlags event)))
    907913    #+debug (log-debug "~&quote-p ~s event ~s" quote-p event)
    908     (if (or (null view)
    909             (#/hasMarkedText self)
    910             (and quote-p (zerop (#/length (#/characters event))))) ;; dead key, e.g. option-E
    911       (call-next-method event)
    912       (unless (eventqueue-abort-pending-p self)
    913         (let ((hemlock-key (nsevent-to-key-event event quote-p)))
    914           (when hemlock-key
    915             (hi::handle-hemlock-event view hemlock-key)))))))
     914    (cond ((and (not *option-is-meta*)
     915                (logtest #$NSAlternateKeyMask flags))
     916           (call-next-method event))
     917          ((or (null view)
     918               (#/hasMarkedText self)
     919               (and quote-p (zerop (#/length (#/characters event)))))
     920           (call-next-method event))
     921          ((not (eventqueue-abort-pending-p self))
     922           (let ((hemlock-key (nsevent-to-key-event event quote-p)))
     923             (when hemlock-key
     924               (hi::handle-hemlock-event view hemlock-key)))))))
    916925
    917926(defmethod hi::handle-hemlock-event :around ((view hi:hemlock-view) event)
     
    29602969          ;; asserts that editing isn't in progress.  Once that's
    29612970          ;; fixed, this should be fixed as well.
    2962           #+not-broken (#/beginEditing textstorage)
     2971          (#/beginEditing textstorage)
    29632972          (#/replaceCharactersInRange:withString: textstorage selectedrange string)
    2964           #+not-broken (#/endEditing self))))))
     2973          (#/endEditing textstorage))))))
    29652974
    29662975
  • release/1.3/source/cocoa-ide/file-dialogs.lisp

    r11927 r11928  
    1010    (#/setAllowsMultipleSelection: open-panel #$NO)
    1111    (when directory
    12       (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
     12      (setq directory (#/autorelease (%make-nsstring directory))))
    1313    (when file
    14       (setq file (#/autorelease (%make-nsstring (namestring file)))))
     14      (setq file (#/autorelease (%make-nsstring file))))
    1515    (when file-types
    1616      (setq types-array (make-instance 'ns:ns-mutable-array))
     
    3232       
    3333(defun cocoa-choose-file-dialog (&key directory file-types file button-string)
    34   (when (and directory (not (directoryp directory)))
    35     (error "~s doesn't designate a directory." directory))
     34  (when directory
     35    (setq directory (directory-namestring directory)))
    3636  (when file-types
    3737    (unless (and (listp file-types)
    3838                 (every #'stringp file-types))
    3939      (error "~s is not a list of strings." file-types)))
    40   (when (and file (not (probe-file file)))
    41     (error "~s doesn't designate a file." file))
     40  (when file
     41    (setq file (file-namestring file)))
     42  (check-type button-string (or null string))
    4243  (execute-in-gui #'(lambda () (%cocoa-choose-file-dialog directory file-types file button-string))))
    4344
     
    4849    (#/setCanSelectHiddenExtension: save-panel t)
    4950    (when directory
    50       (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
     51      (setq directory (#/autorelease (%make-nsstring directory))))
    5152    (when file
    52       (setq file (#/autorelease (%make-nsstring (namestring file)))))
     53      (setq file (#/autorelease (%make-nsstring file))))
    5354    (when file-types
    5455      (setq types-array (make-instance 'ns:ns-mutable-array))
     
    6869
    6970(defun cocoa-choose-new-file-dialog (&key directory file-types file)
    70   (when (and directory (not (directoryp directory)))
    71     (error "~s doesn't designate a directory." directory))
     71  (when directory
     72    (setq directory (directory-namestring directory)))
     73  (when file
     74    (setq file (file-namestring file)))
    7275  (when file-types
    7376    (unless (and (listp file-types)
    7477                 (every #'stringp file-types))
    7578      (error "~s is not a list of strings." file-types)))
    76   (when (and file (not (probe-file file)))
    77     (error "~s doesn't designate a file." file))
    7879  (execute-in-gui #'(lambda () (%cocoa-choose-new-file-dialog directory file-types file))))
    7980
     
    9596    (#/setPrompt: open-panel #@"Choose")
    9697    (when directory
    97       (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
     98      (setq directory (#/autorelease (%make-nsstring directory))))
    9899    (let  ((result (#/runModalForDirectory:file:types: open-panel directory
    99100                                                       nil nil)))
     
    107108
    108109(defun cocoa-choose-directory-dialog (&key directory)
    109   (when (and directory (not (directoryp directory)))
    110     (error "~s doesn't designate a directory." directory))
     110  (when directory
     111    (setq directory (directory-namestring directory)))
    111112  (execute-in-gui #'(lambda () (%cocoa-choose-directory-dialog directory))))
  • release/1.3/source/cocoa-ide/hemlock/src/views.lisp

    r10614 r11928  
    190190       #+debug (log-debug "~&  binding ~s ~s" main-binding transparent-bindings)
    191191       (ring-push key *key-event-history*)
     192       ;; If the key represents an "alphabetic" character (of which there
     193       ;; are about 94000), and the event has no modifiers or only a shift
     194       ;; modifier, treat it if it were bound to "Self Insert".
     195       (when (eq main-binding (get-default-command))
     196         (let ((modifiers (key-event-bits-modifiers (key-event-bits key))))
     197           (when (and (alpha-char-p (key-event-char key))
     198                      (or (null modifiers)
     199                          (equal '("Shift") modifiers)))
     200             (setq main-binding (get-self-insert-command)))))
    192201       (when main-binding
    193202         (let* ((*last-last-command-type* (shiftf (hemlock-last-command-type view) nil))
  • release/1.3/source/cocoa-ide/ide-contents/Resources/English.lproj/preferences.nib/info.nib

    r11466 r11928  
    88        <integer>4</integer>
    99        <key>IBOpenObjects</key>
    10         <array>
    11                 <integer>1500903</integer>
    12                 <integer>1500915</integer>
    13                 <integer>1500856</integer>
    14         </array>
     10        <array/>
    1511        <key>IBSystem Version</key>
    16         <string>9F33</string>
     12        <string>9G55</string>
    1713        <key>targetFramework</key>
    1814        <string>IBCocoaFramework</string>
  • release/1.3/source/compiler/nx-basic.lisp

    r11921 r11928  
    5555    (setf (gethash acode *nx-acode-note-map*) note)))
    5656
    57 
    58 (defun nx-source-note (form &aux (source-notes *nx-source-note-map*))
    59   (when source-notes
    60     (when (or (consp form) (vectorp form) (pathnamep form))
    61       (let ((note (gethash form source-notes)))
    62         (unless (listp note) note)))))
    6357
    6458(defstruct (code-note (:constructor %make-code-note))
     
    116110             (not (gethash new source-notes)))
    117111    (setf (gethash new source-notes) sn)))
    118 
    119112
    120113
  • release/1.3/source/compiler/nx0.lisp

    r11921 r11928  
    21632163
    21642164)
     2165
     2166(defun nx-source-note (form &aux (source-notes *nx-source-note-map*))
     2167  (when source-notes
     2168    (when (or (consp form) (vectorp form) (pathnamep form))
     2169      (let ((note (gethash form source-notes)))
     2170        (unless (listp note) note)))))
    21652171
    21662172(defun nx-transform (form &optional (environment *nx-lexical-environment*) (source-note-map *nx-source-note-map*))
  • release/1.3/source/doc/src/ffi.xml

    r10800 r11928  
    20392039      into it:</para>
    20402040    <programlisting>
    2041 #include &lt;stdio.&gt;
     2041#include &lt;stdio.h&gt;
    20422042
    20432043void
  • release/1.3/source/level-0/l0-cfm-support.lisp

    r11927 r11928  
    882882          (shlib.base lib) nil)
    883883    (let* ((soname (shlib.soname lib))
    884            (last-dot (if soname (1+ (last-dot-pos soname)))))
     884           (last-dot (if soname (last-dot-pos soname))))
    885885      (when soname
    886886        (with-cstrs ((soname soname))
     
    894894                                 (when (or (%cstrcmp soname libname)
    895895                                           (and last-dot
    896                                                 (%cnstrcmp soname libname last-dot)))
     896                                                (%cnstrcmp soname libname (1+ last-dot))))
    897897                                   (return-from found  m)))))))))
    898898            (when map
  • release/1.3/source/level-1/l1-files.lisp

    r11925 r11928  
    13221322(defun load-from-stream (stream print &aux (eof-val (list ())) val)
    13231323  (with-compilation-unit (:override nil) ; try this for included files
    1324     (let ((env (new-lexical-environment (new-definition-environment 'eval))))
     1324    (let ((env (new-lexical-environment (new-definition-environment 'eval)))
     1325          ;; source note map to use with any compilations.
     1326          (*nx-source-note-map*  (and *save-source-locations*
     1327                                      (make-hash-table :test #'eq :shared nil)))
     1328          (*loading-toplevel-location* nil))
    13251329      (%rplacd (defenv.type (lexenv.parent-env env)) *outstanding-deferred-warnings*)
    1326       (while (neq eof-val (setq val (read stream nil eof-val)))
     1330      (loop
     1331        (multiple-value-setq (val *loading-toplevel-location*)
     1332          (read-recording-source stream
     1333                                 :eofval eof-val
     1334                                 :file-name *loading-file-source-file*
     1335                                 :map *nx-source-note-map*
     1336                                 :save-source-text (neq *save-source-locations* :no-text)))
     1337        (when (eq eof-val val)
     1338          (return))
    13271339        (when (eq print :source) (format t "~&Source: ~S~%" val))
    13281340        (setq val (cheap-eval-in-environment val env))
  • release/1.3/source/level-1/l1-readloop.lisp

    r11790 r11928  
    554554        (setq decl-specs (nconc decl-specs (list decl-spec)))))))
    555555
     556(defun cheap-eval-macroexpand-1 (form env)
     557  (multiple-value-bind (new win) (macroexpand-1 form env)
     558    (when win
     559      (note-source-transformation form new))
     560    (values new win)))
     561
     562(defun cheap-eval-transform (original new)
     563  (note-source-transformation original new)
     564  new)
     565
     566(defun cheap-eval-function (name lambda env)
     567  (multiple-value-bind (lfun warnings)
     568                       (compile-named-function lambda
     569                                               :name name
     570                                               :env env
     571                                               :function-note *loading-toplevel-location*
     572                                               :keep-lambda *save-definitions*
     573                                               :keep-symbols *save-local-symbols*
     574                                               :source-notes *nx-source-note-map*)
     575    (signal-or-defer-warnings warnings env)
     576    lfun))
     577
     578(fset 'nx-source-note (nlambda bootstrapping-source-note (form) (declare (ignore form)) nil))
     579
    556580(defun cheap-eval-in-environment (form env &aux sym)
    557581  (declare (resident))
     582  ;; records source locations if *nx-source-note-map* is bound by caller
     583  (setq *loading-toplevel-location* (or (nx-source-note form) *loading-toplevel-location*))
    558584  (flet ((progn-in-env (body&decls parse-env base-env)
    559585           (multiple-value-bind (body decls) (parse-body body&decls parse-env)
    560586             (setq base-env (augment-environment base-env :declare (decl-specs-from-declarations decls)))
    561              (while (cdr body)
    562                (cheap-eval-in-environment (pop body) base-env))
     587             (loop with default-location = *loading-toplevel-location*
     588               while (cdr body) as form = (pop body)
     589               do (cheap-eval-in-environment form base-env)
     590               do (setq *loading-toplevel-location* default-location))
    563591             (cheap-eval-in-environment (car body) base-env))))
    564592    (if form
    565593      (cond ((symbolp form)
    566              (multiple-value-bind (expansion win) (macroexpand-1 form env)
     594             (multiple-value-bind (expansion win) (cheap-eval-macroexpand-1 form env)
    567595               (if win
    568                  (cheap-eval-in-environment expansion env) 
     596                 (cheap-eval-in-environment expansion env)
    569597                 (let* ((defenv (definition-environment env))
    570598                        (constant (if defenv (assq form (defenv.constants defenv))))
     
    595623                        (error "~s can't be used to reference lexically defined macro ~S" 'function sym)))
    596624                    (%function (setf-function-name (%cadr sym))))
    597                    (t (%make-function nil sym env))))
     625                   (t (cheap-eval-function nil sym env))))
    598626            ((eq sym 'nfunction)
    599627             (verify-arg-count form 2 2)
    600              (%make-function (%cadr form) (%caddr form) env))
     628             (cheap-eval-function (%cadr form) (%caddr form) env))
    601629            ((eq sym 'progn) (progn-in-env (%cdr form) env env))
    602630            ((eq sym 'setq)
     
    604632               (verify-arg-count form 0 0)) ;Invoke a "Too many args" error.
    605633             (let* ((sym nil)
    606                     (val nil))
     634                    (val nil)
     635                    (original form))
    607636               (while (setq form (%cdr form))
    608637                 (setq sym (require-type (pop form) 'symbol))
    609638                 (multiple-value-bind (expansion expanded)
    610                                       (macroexpand-1 sym env)
     639                                      (cheap-eval-macroexpand-1 sym env)
    611640                   (if expanded
    612                      (setq val (cheap-eval-in-environment `(setf ,expansion ,(%car form)) env))
     641                     (setq val (cheap-eval-in-environment
     642                                (cheap-eval-transform original `(setf ,expansion ,(%car form)))
     643                                env))
    613644                     (set sym (setq val (cheap-eval-in-environment (%car form) env))))))
    614645               val))
     
    618649            ((eq sym 'if)
    619650             (destructuring-bind (test true &optional false) (%cdr form)
    620                (cheap-eval-in-environment (if (cheap-eval-in-environment test env) true false) env)))
     651               (setq test (let ((*loading-toplevel-location* *loading-toplevel-location*))
     652                            (cheap-eval-in-environment test env)))
     653               (cheap-eval-in-environment (if test true false) env)))
    621654            ((eq sym 'locally) (progn-in-env (%cdr form) env env))
    622655            ((eq sym 'symbol-macrolet)
     
    638671               (destructuring-bind (protected-form . cleanup-forms) (cdr form)
    639672                 (unwind-protect
    640                    (cheap-eval-in-environment protected-form env)
     673                     (let ((*loading-toplevel-location* *loading-toplevel-location*))
     674                       (cheap-eval-in-environment protected-form env))
    641675                   (progn-in-env cleanup-forms env env)))
    642                (funcall (%make-function nil `(lambda () (progn ,form)) env))))
     676               (funcall (cheap-eval-function nil (cheap-eval-transform form `(lambda () (progn ,form))) env))))
    643677            ((and (symbolp sym) (macro-function sym env))
    644              (if (eq sym 'step)
    645                (let ((*compile-definitions* nil))
    646                      (cheap-eval-in-environment (macroexpand-1 form env) env))
    647                (cheap-eval-in-environment (macroexpand-1 form env) env)))
     678             (cheap-eval-in-environment (cheap-eval-macroexpand-1 form env) env))
    648679            ((or (symbolp sym)
    649680                 (and (consp sym) (eq (%car sym) 'lambda)))
    650              (let ((args nil))
    651                (dolist (elt (%cdr form)) (push (cheap-eval-in-environment elt env) args))
    652                (apply #'call-check-regs (if (symbolp sym) sym (%make-function nil sym env))
     681             (let ((args nil) (form-location *loading-toplevel-location*))
     682               (dolist (elt (%cdr form))
     683                 (push (cheap-eval-in-environment elt env) args)
     684                 (setq *loading-toplevel-location* form-location))
     685               (apply #'call-check-regs (if (symbolp sym) sym (cheap-eval-function nil sym env))
    653686                      (nreverse args))))
    654687            (t (signal-simple-condition 'simple-program-error "Car of ~S is not a function name or lambda-expression." form))))))
  • release/1.3/source/lisp-kernel/darwinx8632/Makefile

    r11028 r11928  
    2828CDEBUG = -g
    2929COPT = #-O2
     30CC=gcc-4.0
    3031
    3132.s.o:
  • release/1.3/source/lisp-kernel/darwinx8664/Makefile

    r10665 r11928  
    2222VPATH = ..
    2323RM = /bin/rm
    24 LD = ld64
    25 
     24LD = ld
     25CC=gcc-4.0
    2626
    2727### Current ld64 bugs include the claim that 0x1000 isn't a power of 2.
  • release/1.3/source/lisp-kernel/memprotect.h

    r10565 r11928  
    2626#include <signal.h>
    2727#ifndef WINDOWS
     28#ifdef DARWIN
     29#include <sys/ucontext.h>
     30#else
    2831#include <ucontext.h>
     32#endif
    2933#endif
    3034
  • release/1.3/source/lisp-kernel/x86-asmutils32.s

    r11782 r11928  
    181181   since we're trying to do what sigtramp() would do if we'd returned
    182182   to it ... */
    183         .globl C(sigreturn)
    184183        __(movl $0x1e,8(%esp))
    185         __(jmp *jsigreturn)
    186         .data
    187 jsigreturn:     .long C(sigreturn)
    188         .text
     184        __(movl $0xb8,%eax)     /* SYS_sigreturn */
     185        __(int $0x80)
     186        __(ret)                 /* shouldn't return */
    189187
    190188_endfn
  • release/1.3/source/lisp-kernel/x86-asmutils64.s

    r11714 r11928  
    167167        __(movl $417,%eax)      /* SYS_sigreturn */
    168168        __(syscall)                             
     169       
    169170_exportfn(C(get_vector_registers))
    170171_endfn
     
    178179   to it ... */
    179180        __(movl $0x1e,%esi)
    180         __(jmp C(sigreturn))
     181        __(movl $0x20000b8,%eax)
     182        __(syscall)
     183        __(ret)
    181184_endfn
    182185        __endif
  • release/1.3/source/lisp-kernel/x86-spentry64.s

    r11830 r11928  
    42694269            contains the linear tcr address.  Preserve %rax/%rdx here. */
    42704270         __(set_gs_base(%csave1))
    4271          __(movq (%csave3),%rax)
    4272          __(movq 8(%csave3),%rdx)
    4273          __(movsd 16(%csave3),%xmm0)
    4274          __(movsd 24(%csave3),%xmm1)
     4271         __(movq (%csave0),%rax)
     4272         __(movq 8(%csave0),%rdx)
     4273         __(movsd 16(%csave0),%xmm0)
     4274         __(movsd 24(%csave0),%xmm1)
    42754275        __endif
    42764276        __ifdef([WINDOWS])
     
    50885088        __ifdef([DARWIN])
    50895089        .if 1
     5090        .globl  C(lisp_objc_personality)
     5091C(lisp_objc_personality):
     5092        jmp *lisp_global(objc_2_personality)
     5093       
    50905094        .section __TEXT,__eh_frame,coalesced,no_toc+strip_static_syms+live_support
    50915095EH_frame1:
     
    50995103        .byte   0x78    /* sleb128 -8; CIE Data Alignment Factor */
    51005104        .byte   0x10    /* CIE RA Column */
    5101         .byte   0xb     /* uleb128 0xb; Augmentation size */
    5102         .byte   0x8c    /* Personality (indirect  sdata8) */
    5103         .quad   lisp_global(objc_2_personality)
     5105        .byte   0x7
     5106        .byte   0x9b
     5107        .long   _lisp_objc_personality+4@GOTPCREL
    51045108        .byte   0x10    /* LSDA Encoding (pcrel) */
    51055109        .byte   0x10    /* FDE Encoding (pcrel) */
Note: See TracChangeset for help on using the changeset viewer.