| 79 | | |
|---|
| 80 | | (defun log-level-setter-inspector-action-for (prompt current-level setter) |
|---|
| 81 | | (lambda () |
|---|
| 82 | | (with-simple-restart |
|---|
| 83 | | (abort "Abort setting log level") |
|---|
| 84 | | (let ((value-string (swank::eval-in-emacs |
|---|
| 85 | | `(condition-case c |
|---|
| 86 | | (let ((arnesi-log-levels '(,@(mapcar #'string-downcase (coerce *log-level-names* 'list))))) |
|---|
| 87 | | (slime-read-object ,prompt :history (cons 'arnesi-log-levels ,(1+ current-level)) |
|---|
| 88 | | :initial-value ,(string-downcase (log-level-name-of current-level)))) |
|---|
| 89 | | (quit nil))))) |
|---|
| 90 | | (when (and value-string |
|---|
| 91 | | (not (string= value-string ""))) |
|---|
| 92 | | (funcall setter (eval (let ((*package* #.(find-package :arnesi))) |
|---|
| 93 | | (read-from-string value-string))))))))) |
|---|
| 94 | | |
|---|
| 95 | | (defmethod swank:inspect-for-emacs ((category log-category)) |
|---|
| 96 | | (let ((class (class-of category))) |
|---|
| 97 | | (values "A log-category." |
|---|
| 98 | | `("Class: " (:value ,class) (:newline) |
|---|
| 99 | | "Runtime level: " (:value ,(log.level category) |
|---|
| 100 | | ,(string (log-level-name-of (log.level category)))) |
|---|
| 101 | | " " |
|---|
| 102 | | (:action "[set level]" ,(log-level-setter-inspector-action-for |
|---|
| 103 | | "Set runtime log level to (evaluated): " |
|---|
| 104 | | (log.level category) |
|---|
| 105 | | (lambda (value) |
|---|
| 106 | | (setf (log.level category) value)))) |
|---|
| 107 | | (:newline) |
|---|
| 108 | | "Compile-time level: " (:value ,(log.compile-time-level category) |
|---|
| 109 | | ,(string (log-level-name-of (log.compile-time-level category)))) |
|---|
| 110 | | " " |
|---|
| 111 | | (:action "[set level]" ,(log-level-setter-inspector-action-for |
|---|
| 112 | | "Set compile-time log level to (evaluated): " |
|---|
| 113 | | (log.compile-time-level category) |
|---|
| 114 | | (lambda (value) |
|---|
| 115 | | (setf (log.compile-time-level category) value)))) |
|---|
| 116 | | (:newline) |
|---|
| 117 | | ,@(swank::all-slots-for-inspector category))))) |
|---|
| 334 | | (defclass slime-repl-log-appender (appender) |
|---|
| 335 | | () |
|---|
| 336 | | (:documentation "Logs to the slime repl when there's a valid swank::*emacs-connection* bound. Arguments are presented ready for inspection. |
|---|
| 337 | | |
|---|
| 338 | | You may want to add this to your init.el to speed up cursor movement in the repl buffer with many presentations: |
|---|
| 339 | | |
|---|
| 340 | | \(add-hook 'slime-repl-mode-hook |
|---|
| 341 | | (lambda () |
|---|
| 342 | | (setf parse-sexp-lookup-properties nil))) |
|---|
| 343 | | ")) |
|---|
| 344 | | |
|---|
| 345 | | (defun swank::present-in-emacs (value-or-values &key (separated-by " ")) |
|---|
| 346 | | "Present VALUE in the Emacs repl buffer of the current thread." |
|---|
| 347 | | (unless (consp value-or-values) |
|---|
| 348 | | (setf value-or-values (list value-or-values))) |
|---|
| 349 | | (flet ((present (value) |
|---|
| 350 | | (if (stringp value) |
|---|
| 351 | | (swank::send-to-emacs `(:write-string ,value)) |
|---|
| 352 | | (let ((id (swank::save-presented-object value))) |
|---|
| 353 | | (swank::send-to-emacs `(:write-string ,(prin1-to-string value) ,id)))))) |
|---|
| 354 | | (map nil (let ((first-time-p t)) |
|---|
| 355 | | (lambda (value) |
|---|
| 356 | | (when (and (not first-time-p) |
|---|
| 357 | | separated-by) |
|---|
| 358 | | (present separated-by)) |
|---|
| 359 | | (present value) |
|---|
| 360 | | (setf first-time-p nil))) |
|---|
| 361 | | value-or-values)) |
|---|
| 362 | | (values)) |
|---|
| 363 | | |
|---|
| 364 | | (defmethod append-message ((category log-category) (appender slime-repl-log-appender) |
|---|
| 365 | | message level) |
|---|
| 366 | | (when (swank::default-connection) |
|---|
| 367 | | (swank::with-connection ((swank::default-connection)) |
|---|
| 368 | | (multiple-value-bind (second minute hour day month year) |
|---|
| 369 | | (decode-universal-time (get-universal-time)) |
|---|
| 370 | | (declare (ignore second day month year)) |
|---|
| 371 | | (swank::present-in-emacs (format nil |
|---|
| 372 | | "~2,'0D:~2,'0D ~A/~A: " |
|---|
| 373 | | hour minute |
|---|
| 374 | | (symbol-name (name category)) |
|---|
| 375 | | (symbol-name level)))) |
|---|
| 376 | | (if (consp message) |
|---|
| 377 | | (let ((format-control (when (stringp (first message)) |
|---|
| 378 | | (first message))) |
|---|
| 379 | | (args (if (stringp (first message)) |
|---|
| 380 | | (rest message) |
|---|
| 381 | | message))) |
|---|
| 382 | | (when format-control |
|---|
| 383 | | (setf message (apply #'format nil format-control args))) |
|---|
| 384 | | (swank::present-in-emacs message) |
|---|
| 385 | | (awhen (and format-control |
|---|
| 386 | | (> (verbosity-of appender) 1) |
|---|
| 387 | | (remove-if (lambda (el) |
|---|
| 388 | | (or (stringp el) |
|---|
| 389 | | (null el))) |
|---|
| 390 | | args)) |
|---|
| 391 | | (swank::present-in-emacs " (") |
|---|
| 392 | | (swank::present-in-emacs it) |
|---|
| 393 | | (swank::present-in-emacs ")"))) |
|---|
| 394 | | (swank::present-in-emacs message)) |
|---|
| 395 | | (swank::present-in-emacs #.(string #\Newline))))) |
|---|
| 396 | | |
|---|
