Changeset 2615

Timestamp:

02/24/08 16:54:09 (9 months ago)

Author:

ksprotte

Message:

arnesi up upstream

Files:

• branches/bos/thirdparty/arnesi/_darcs/inventory (modified) (1 diff)
• branches/bos/thirdparty/arnesi/_darcs/patches/20080109193201-783f4-65fd5cb639548a57d86a5e0008f1587794439032.gz (added)
• branches/bos/thirdparty/arnesi/_darcs/patches/20080204210653-783f4-a2d349d6df6b26c9fbcde50800eaef17b25245ec.gz (added)
• branches/bos/thirdparty/arnesi/_darcs/patches/20080210170822-942af-2faa185a2e22621089ffe9034f05271f6371a6c1.gz (added)
• branches/bos/thirdparty/arnesi/_darcs/patches/20080210171007-942af-3435901f015be046cd0bf30b5bd0e025856c956e.gz (added)
• branches/bos/thirdparty/arnesi/_darcs/patches/20080217133715-dd2a1-30bc2f2d43091d9a918175610b368e6570e6c7e3.gz (added)
• branches/bos/thirdparty/arnesi/_darcs/patches/20080217134147-dd2a1-321faee163683d503bd9fe621e6a26dfb440aa34.gz (added)
• branches/bos/thirdparty/arnesi/_darcs/patches/pending (added)
• branches/bos/thirdparty/arnesi/_darcs/pristine/arnesi.asd (modified) (2 diffs)
• branches/bos/thirdparty/arnesi/_darcs/pristine/src/call-cc/apply.lisp (modified) (1 diff)
• branches/bos/thirdparty/arnesi/_darcs/pristine/src/log.lisp (modified) (4 diffs)
• branches/bos/thirdparty/arnesi/_darcs/pristine/src/packages.lisp (modified) (1 diff)
• branches/bos/thirdparty/arnesi/_darcs/pristine/src/slime-extras.lisp (added)
• branches/bos/thirdparty/arnesi/arnesi.asd (modified) (2 diffs)
• branches/bos/thirdparty/arnesi/src/call-cc/apply.lisp (modified) (1 diff)
• branches/bos/thirdparty/arnesi/src/log.lisp (modified) (4 diffs)
• branches/bos/thirdparty/arnesi/src/packages.lisp (modified) (1 diff)
• branches/bos/thirdparty/arnesi/src/slime-extras.lisp (added)

branches/bos/thirdparty/arnesi/_darcs/inventory

@@ -175 +175 @@
-] 
-[rollback the strcat dynamic-extent allocation, it causes too many notes on sbcl (and it's not enabled anyway)
-
+
+
+
+
+
+
+
+
+
+
+
+

branches/bos/thirdparty/arnesi/_darcs/pristine/arnesi.asd

@@ -56 +56 @@
-                             (:file "walk" :depends-on ("packages" "list" "mopp" "lexenv" "one-liners")))))
-  :properties ((:features "v1.4.0" "v1.4.1" "v1.4.2" "cc-interpreter"
-
-
+
-
-(defsystem :arnesi.test
@@ -83 +82 @@
-                :components ((:file "cl-ppcre-extras"))))
-  :depends-on (:cl-ppcre :arnesi))
+
+(defsystem :arnesi.slime-extras
+  :components ((:module :src :components ((:file "slime-extras"))))
+  :depends-on (:arnesi :swank))
-
-(defmethod perform ((op asdf:test-op) (system (eql (find-system :arnesi))))

branches/bos/thirdparty/arnesi/_darcs/pristine/src/call-cc/apply.lisp

@@ -185 +185 @@
-    ;; first the required arguments
-    (loop
+       for parameter = (first remaining-parameters)
-       while remaining-parameters
-       for parameter = (first remaining-parameters)
-       do (typecase parameter
-            (required-function-argument-form

branches/bos/thirdparty/arnesi/_darcs/pristine/src/log.lisp

@@ -77 +77 @@
-    (pushnew l (children anc) :test (lambda (a b)
-                                     (eql (name a) (name b))))))
-
-(defun log-level-setter-inspector-action-for (prompt current-level setter)
-  (lambda ()
-    (with-simple-restart
-        (abort "Abort setting log level")
-      (let ((value-string (swank::eval-in-emacs
-                           `(condition-case c
-                             (let ((arnesi-log-levels '(,@(mapcar #'string-downcase (coerce *log-level-names* 'list)))))
-                               (slime-read-object ,prompt :history (cons 'arnesi-log-levels ,(1+ current-level))
-                                                  :initial-value ,(string-downcase (log-level-name-of current-level))))
-                             (quit nil)))))
-        (when (and value-string
-                   (not (string= value-string "")))
-          (funcall setter (eval (let ((*package* #.(find-package :arnesi)))
-                                  (read-from-string value-string)))))))))
-
-(defmethod swank:inspect-for-emacs ((category log-category) inspector)
-  (let ((class (class-of category)))
-    (values "A log-category."
-            `("Class: " (:value ,class) (:newline)
-              "Runtime level: " (:value ,(log.level category)
-                                 ,(string (log-level-name-of (log.level category))))
-              " "
-              (:action "[set level]" ,(log-level-setter-inspector-action-for
-                                       "Set runtime log level to (evaluated): "
-                                       (log.level category)
-                                       (lambda (value)
-                                         (setf (log.level category) value))))
-              (:newline)
-              "Compile-time level: " (:value ,(log.compile-time-level category)
-                                      ,(string (log-level-name-of (log.compile-time-level category))))
-               " "
-              (:action "[set level]" ,(log-level-setter-inspector-action-for
-                                       "Set compile-time log level to (evaluated): "
-                                       (log.compile-time-level category)
-                                       (lambda (value)
-                                         (setf (log.compile-time-level category) value))))
-              (:newline)
-              ,@(swank::all-slots-for-inspector category inspector)))))
-
-;;; Runtime levels
@@ -204 +165 @@
-         (*print-readably* nil)
-         (*print-length* 64)
-
+
+
-    ,@body))
-
@@ -331 +293 @@
-         args))
-
-(defclass slime-repl-log-appender (appender)
-  ()
-  (:documentation "Logs to the slime repl when there's a valid swank::*emacs-connection* bound. Arguments are presented ready for inspection.
-
-You may want to add this to your init.el to speed up cursor movement in the repl buffer with many presentations:
-
-\(add-hook 'slime-repl-mode-hook
-          (lambda ()
-            (setf parse-sexp-lookup-properties nil)))
-"))
-
-(defmethod append-message ((category log-category) (appender slime-repl-log-appender)
-                           message level)
-  (when (swank::default-connection)
-    (swank::with-connection ((swank::default-connection))
-      (multiple-value-bind (second minute hour day month year)
-          (decode-universal-time (get-universal-time))
-        (declare (ignore second day month year))
-        (swank::present-in-emacs (format nil
-                                         "~2,'0D:~2,'0D ~A/~A: "
-                                         hour minute
-                                         (symbol-name (name category))
-                                         (symbol-name level))))
-      (if (consp message)
-          (let ((format-control (when (stringp (first message))
-                                  (first message)))
-                (args (if (stringp (first message))
-                          (rest message)
-                          message)))
-            (when format-control
-              (setf message (apply #'format nil format-control args)))
-            (swank::present-in-emacs message)
-            (awhen (and format-control
-                        (> (verbosity-of appender) 1)
-                        (remove-if (lambda (el)
-                                     (or (stringp el)
-                                         (null el)))
-                                   args))
-              (swank::present-in-emacs " (")
-              (swank::present-in-emacs it)
-              (swank::present-in-emacs ")")))
-          (swank::present-in-emacs message))
-      (swank::present-in-emacs #.(string #\Newline)))))
-
-(defun arnesi-logger-inspector-lookup-hook (form)
-  (when (symbolp form)
@@ -382 +300 @@
-        (when-bind logger (get-logger logger-name)
-          (values logger t))))))
-
-(awhen (find-symbol (symbol-name '#:*inspector-dwim-lookup-hooks*) :swank)
-  (pushnew 'arnesi-logger-inspector-lookup-hook (symbol-value it)))
-
-(defun make-slime-repl-log-appender (&rest args &key (verbosity 2))
-  (remf-keywords args :verbosity)
-  (apply #'make-instance 'slime-repl-log-appender :verbosity verbosity args))
-
-(defclass file-log-appender (stream-log-appender)

branches/bos/thirdparty/arnesi/_darcs/pristine/src/packages.lisp

@@ -225 +225 @@
-   #:verbose-stream-log-appender
-   #:make-stream-log-appender
-   #:make-slime-repl-log-appender
-   #:file-log-appender
-   #:make-file-log-appender

branches/bos/thirdparty/arnesi/arnesi.asd

@@ -56 +56 @@
-                             (:file "walk" :depends-on ("packages" "list" "mopp" "lexenv" "one-liners")))))
-  :properties ((:features "v1.4.0" "v1.4.1" "v1.4.2" "cc-interpreter"
-
-
+
-
-(defsystem :arnesi.test
@@ -83 +82 @@
-                :components ((:file "cl-ppcre-extras"))))
-  :depends-on (:cl-ppcre :arnesi))
+
+(defsystem :arnesi.slime-extras
+  :components ((:module :src :components ((:file "slime-extras"))))
+  :depends-on (:arnesi :swank))
-
-(defmethod perform ((op asdf:test-op) (system (eql (find-system :arnesi))))

branches/bos/thirdparty/arnesi/src/call-cc/apply.lisp

@@ -185 +185 @@
-    ;; first the required arguments
-    (loop
+       for parameter = (first remaining-parameters)
-       while remaining-parameters
-       for parameter = (first remaining-parameters)
-       do (typecase parameter
-            (required-function-argument-form

branches/bos/thirdparty/arnesi/src/log.lisp

@@ -77 +77 @@
-    (pushnew l (children anc) :test (lambda (a b)
-                                     (eql (name a) (name b))))))
-
-(defun log-level-setter-inspector-action-for (prompt current-level setter)
-  (lambda ()
-    (with-simple-restart
-        (abort "Abort setting log level")
-      (let ((value-string (swank::eval-in-emacs
-                           `(condition-case c
-                             (let ((arnesi-log-levels '(,@(mapcar #'string-downcase (coerce *log-level-names* 'list)))))
-                               (slime-read-object ,prompt :history (cons 'arnesi-log-levels ,(1+ current-level))
-                                                  :initial-value ,(string-downcase (log-level-name-of current-level))))
-                             (quit nil)))))
-        (when (and value-string
-                   (not (string= value-string "")))
-          (funcall setter (eval (let ((*package* #.(find-package :arnesi)))
-                                  (read-from-string value-string)))))))))
-
-(defmethod swank:inspect-for-emacs ((category log-category) inspector)
-  (let ((class (class-of category)))
-    (values "A log-category."
-            `("Class: " (:value ,class) (:newline)
-              "Runtime level: " (:value ,(log.level category)
-                                 ,(string (log-level-name-of (log.level category))))
-              " "
-              (:action "[set level]" ,(log-level-setter-inspector-action-for
-                                       "Set runtime log level to (evaluated): "
-                                       (log.level category)
-                                       (lambda (value)
-                                         (setf (log.level category) value))))
-              (:newline)
-              "Compile-time level: " (:value ,(log.compile-time-level category)
-                                      ,(string (log-level-name-of (log.compile-time-level category))))
-               " "
-              (:action "[set level]" ,(log-level-setter-inspector-action-for
-                                       "Set compile-time log level to (evaluated): "
-                                       (log.compile-time-level category)
-                                       (lambda (value)
-                                         (setf (log.compile-time-level category) value))))
-              (:newline)
-              ,@(swank::all-slots-for-inspector category inspector)))))
-
-;;; Runtime levels
@@ -204 +165 @@
-         (*print-readably* nil)
-         (*print-length* 64)
-
+
+
-    ,@body))
-
@@ -331 +293 @@
-         args))
-
-(defclass slime-repl-log-appender (appender)
-  ()
-  (:documentation "Logs to the slime repl when there's a valid swank::*emacs-connection* bound. Arguments are presented ready for inspection.
-
-You may want to add this to your init.el to speed up cursor movement in the repl buffer with many presentations:
-
-\(add-hook 'slime-repl-mode-hook
-          (lambda ()
-            (setf parse-sexp-lookup-properties nil)))
-"))
-
-(defmethod append-message ((category log-category) (appender slime-repl-log-appender)
-                           message level)
-  (when (swank::default-connection)
-    (swank::with-connection ((swank::default-connection))
-      (multiple-value-bind (second minute hour day month year)
-          (decode-universal-time (get-universal-time))
-        (declare (ignore second day month year))
-        (swank::present-in-emacs (format nil
-                                         "~2,'0D:~2,'0D ~A/~A: "
-                                         hour minute
-                                         (symbol-name (name category))
-                                         (symbol-name level))))
-      (if (consp message)
-          (let ((format-control (when (stringp (first message))
-                                  (first message)))
-                (args (if (stringp (first message))
-                          (rest message)
-                          message)))
-            (when format-control
-              (setf message (apply #'format nil format-control args)))
-            (swank::present-in-emacs message)
-            (awhen (and format-control
-                        (> (verbosity-of appender) 1)
-                        (remove-if (lambda (el)
-                                     (or (stringp el)
-                                         (null el)))
-                                   args))
-              (swank::present-in-emacs " (")
-              (swank::present-in-emacs it)
-              (swank::present-in-emacs ")")))
-          (swank::present-in-emacs message))
-      (swank::present-in-emacs #.(string #\Newline)))))
-
-(defun arnesi-logger-inspector-lookup-hook (form)
-  (when (symbolp form)
@@ -382 +300 @@
-        (when-bind logger (get-logger logger-name)
-          (values logger t))))))
-
-(awhen (find-symbol (symbol-name '#:*inspector-dwim-lookup-hooks*) :swank)
-  (pushnew 'arnesi-logger-inspector-lookup-hook (symbol-value it)))
-
-(defun make-slime-repl-log-appender (&rest args &key (verbosity 2))
-  (remf-keywords args :verbosity)
-  (apply #'make-instance 'slime-repl-log-appender :verbosity verbosity args))
-
-(defclass file-log-appender (stream-log-appender)

branches/bos/thirdparty/arnesi/src/packages.lisp

@@ -225 +225 @@
-   #:verbose-stream-log-appender
-   #:make-stream-log-appender
-   #:make-slime-repl-log-appender
-   #:file-log-appender
-   #:make-file-log-appender