~ubuntu-branches/ubuntu/trusty/slime/trusty : revision 4

70

(defvar slime-use-highlight-edits-mode nil

71

"When non-nil always enable slime-highlight-edits-mode in slime-mode")

72

73

(defvar slime-highlight-compiler-notes t

74

"When non-nil highlight buffers with compilation notes, warnings and errors.")

75

73

76

(defun* slime-setup (&key autodoc typeout-frame highlight-edits)

74

77

"Setup Emacs so that lisp-mode buffers always use SLIME."

75

78

(when (member 'lisp-mode slime-lisp-modes)

105

108

The default value is automatically computed from the location of the

106

109

Emacs Lisp package."))

107

110

111

(eval-and-compile

112

(defun slime-changelog-date ()

113

"Return the datestring of the latest entry in the ChangeLog file.

114

Return nil if the ChangeLog file cannot be found."

115

(let ((changelog "/usr/share/doc/cl-swank/changelog"))

116

(if (file-exists-p changelog)

117

(with-temp-buffer

118

(insert-file-contents changelog nil 0 100)

119

(goto-char (point-min))

120

(symbol-name (read (current-buffer))))

121

nil))))

122

123

(defvar slime-protocol-version nil)

124

(setq slime-protocol-version

125

(eval-when-compile (slime-changelog-date)))

126

108

127

109

128

;;;; Customize groups

110

129

;;

258

277

:group 'slime-mode

259

278

:type 'boolean)

260

279

261

(defcustom slime-complete-keywords-contextually t

262

"Use information from the arglist of the surrounding function call

263

to complete keywords."

280

(defcustom slime-fuzzy-completion-in-place nil

281

"When non-NIL the fuzzy symbol completion is done in place as

282

opposed to moving the point to the completion buffer."

264

283

:group 'slime-mode

265

284

:type 'boolean)

266

285

286

(defcustom slime-fuzzy-completion-limit 300

287

"Only return and present this many symbols from swank."

288

:group 'slime-mode

289

:type 'integer)

290

291

(defcustom slime-fuzzy-completion-time-limit-in-msec 1500

292

"Limit the time spent (given in msec) in swank while gathering comletitions.

293

\(NOTE: currently it's rounded up the nearest second)"

294

:group 'slime-mode

295

:type 'integer)

296

267

297

(defcustom slime-space-information-p t

268

298

"Have the SPC key offer arglist information."

269

299

:type 'boolean

502

532

:type 'string

503

533

:group 'slime-repl)

504

534

505

(defcustom slime-repl-history-size 1000

535

(defcustom slime-repl-history-size 200

506

536

"*Maximum number of lines for persistent REPL history."

507

537

:type 'integer

508

538

:group 'slime-repl)

509

539

510

540

511

541

;;;; Minor modes

542

;;;; slime-target-buffer-fuzzy-completions-mode

543

;;;; NOTE: this mode has to be able to override key mappings in slime-mode

544

545

(defun mimic-key-bindings (from-keymap to-keymap bindings-or-operation operation)

546

"Iterate on BINDINGS-OR-OPERATION. If an element is a symbol then

547

try to look it up (as an operation) in FROM-KEYMAP. Non symbols are taken

548

as default key bindings when none to be mimiced was found in FROM-KEYMAP.

549

Set the resulting list of keys in TO-KEYMAP to OPERATION."

550

(let ((mimic-keys nil)

551

(direct-keys nil))

552

(dolist (key-or-operation bindings-or-operation)

553

(if (symbolp key-or-operation)

554

(setf mimic-keys (append mimic-keys (where-is-internal key-or-operation from-keymap nil t)))

555

(push key-or-operation direct-keys)))

556

(dolist (key (or mimic-keys direct-keys))

557

(define-key to-keymap key operation))))

558

559

(defvar slime-target-buffer-fuzzy-completions-map

560

(let* ((map (make-sparse-keymap)))

561

(flet ((remap (keys to)

562

(mimic-key-bindings global-map map keys to)))

563

564

(remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort)

565

566

(remap (list 'slime-fuzzy-indent-and-complete-symbol

567

'slime-indent-and-complete-symbol

568

(kbd "<tab>"))

569

'slime-fuzzy-select-or-update-completions)

570

(remap (list 'previous-line (kbd "<up>")) 'slime-fuzzy-prev)

571

(remap (list 'next-line (kbd "<down>")) 'slime-fuzzy-next)

572

(remap (list 'isearch-forward (kbd "C-s"))

573

(lambda ()

574

(interactive)

575

(select-window (get-buffer-window (slime-get-fuzzy-buffer)))

576

(call-interactively 'isearch-forward)))

577

578

;; some unconditional direct bindings

579

(dolist (key (list (kbd "RET") (kbd "<SPC>") "(" ")" "[" "]"))

580

(define-key map key 'slime-fuzzy-select-and-process-event-in-target-buffer)))

581

map

582

)

583

"Keymap for slime-target-buffer-fuzzy-completions-mode. This will override the key

584

bindings in the target buffer temporarily during completion.")

585

586

(define-minor-mode slime-fuzzy-target-buffer-completions-mode

587

"This minor mode is intented to override key bindings during fuzzy

588

completions in the target buffer. Most of the bindings will do an implicit select

589

in the completion window and let the keypress be processed in the target buffer."

590

nil

591

nil

592

slime-target-buffer-fuzzy-completions-map)

593

594

(add-to-list 'minor-mode-alist

595

'(slime-fuzzy-target-buffer-completions-mode

596

" Fuzzy Target Buffer Completions"))

597

598

512

599

;;;;; slime-mode

513

514

600

(define-minor-mode slime-mode

515

601

"\\<slime-mode-map>\

516

602

SLIME: The Superior Lisp Interaction Mode for Emacs (minor-mode).

948

1034

(easy-menu-add slime-sldb-easy-menu 'sldb-mode-map)))

949

1035

950

1036

1037

;;;; Emacs compatibility

1038

1039

(or (fboundp 'add-local-hook)

1040

(defun add-local-hook (hook function &optional append)

1041

(make-local-hook hook)

1042

(add-hook hook function append t)))

1043

1044

(or (fboundp 'remove-local-hook)

1045

(defun remove-local-hook (hook function)

1046

(if (local-variable-p hook (current-buffer))

1047

(remove-hook hook function t))))

1048

1049

951

1050

;;;; Setup initial `slime-mode' hooks

952

1051

953

1052

(make-variable-buffer-local

966

1065

(add-hook 'pre-command-hook 'slime-pre-command-hook)))

967

1066

968

1067

(defun slime-setup-command-hooks ()

969

"Setup a buffer-local `pre-command-h'ook' to call `slime-pre-command-hook'."

970

(make-local-hook 'pre-command-hook)

971

(make-local-hook 'post-command-hook)

972

;; alanr: need local t

973

(add-hook 'pre-command-hook 'slime-pre-command-hook nil t)

974

(add-hook 'post-command-hook 'slime-post-command-hook nil t)

1068

"Setup a buffer-local `pre-command-hook' to call `slime-pre-command-hook'."

1069

(add-local-hook 'pre-command-hook 'slime-pre-command-hook)

1070

(add-local-hook 'post-command-hook 'slime-post-command-hook)

975

1071

(when slime-repl-enable-presentations

976

(make-local-variable 'after-change-functions)

977

(add-hook 'after-change-functions 'slime-after-change-function nil t)))

1072

(add-local-hook 'after-change-functions 'slime-after-change-function)))

978

1073

979

1074

980

1075

;;;; Framework'ey bits

1255

1350

1256

1351

;; Interface

1257

1352

(defun slime-temp-buffer-quit ()

1258

"Kill the current buffer and restore the old window configuration.

1259

See `slime-temp-buffer-dismiss'."

1353

"Kill the current (temp) buffer without asking. To restore the

1354

window configuration without killing the buffer see

1355

`slime-dismiss-temp-buffer'."

1260

1356

(interactive)

1261

(let ((buf (current-buffer)))

1262

(slime-dismiss-temp-buffer)

1263

(kill-buffer buf)))

1357

(let* ((buffer (current-buffer))

1358

(window (get-buffer-window buffer)))

1359

(kill-buffer buffer)

1360

(when window

1361

(delete-window window))))

1264

1362

1265

1363

;; Interface

1266

1364

(defun slime-dismiss-temp-buffer ()

1315

1413

1316

1414

(defun slime-make-tramp-file-name (username remote-host lisp-filename)

1317

1415

"Old (with multi-hops) tramp compatability function"

1416

(require 'tramp)

1318

1417

(if (boundp 'tramp-multi-methods)

1319

1418

(tramp-make-tramp-file-name nil nil

1320

1419

username

1614

1713

slime-backend

1615

1714

(concat slime-path slime-backend)))

1616

1715

(encoding (slime-coding-system-cl-name coding-system)))

1617

(format "%S\n%S\n\n"

1618

`(load ,loader :verbose t)

1619

`(swank:start-server ,port-filename :external-format ,encoding))))

1716

;; Return a single form to avoid problems with buffered input.

1717

(format "%S\n\n"

1718

`(progn

1719

(load ,loader :verbose t)

1720

(funcall (read-from-string "swank:start-server")

1721

,port-filename

1722

:coding-system ,encoding)))))

1620

1723

1621

1724

(defun slime-swank-port-file ()

1622

1725

"Filename where the SWANK server writes its TCP port number."

1778

1881

;;;;; Coding system madness

1779

1882

1780

1883

(defvar slime-net-valid-coding-systems

1781

'((iso-latin-1-unix nil :iso-latin-1-unix)

1782

(iso-8859-1-unix nil :iso-latin-1-unix)

1783

(binary nil :iso-latin-1-unix)

1784

(utf-8-unix t :utf-8-unix)

1785

(emacs-mule-unix t :emacs-mule-unix)

1786

(euc-jp-unix t :euc-jp-unix))

1884

'((iso-latin-1-unix nil "iso-latin-1-unix")

1885

(iso-8859-1-unix nil "iso-latin-1-unix")

1886

(binary nil "iso-latin-1-unix")

1887

(utf-8-unix t "utf-8-unix")

1888

(emacs-mule-unix t "emacs-mule-unix")

1889

(euc-jp-unix t "euc-jp-unix"))

1787

1890

"A list of valid coding systems.

1788

1891

Each element is of the form: (NAME MULTIBYTEP CL-NAME)")

1789

1892

2162

2265

"Initialize CONNECTION with INFO received from Lisp."

2163

2266

(let ((slime-dispatching-connection connection))

2164

2267

(destructuring-bind (&key pid style lisp-implementation machine

2165

features package) info

2268

features package version &allow-other-keys) info

2269

(or (equal version slime-protocol-version)

2270

(yes-or-no-p "Protocol version mismatch. Continue anyway? ")

2271

(slime-net-close connection)

2272

(top-level))

2166

2273

(setf (slime-pid) pid

2167

2274

(slime-communication-style) style

2168

2275

(slime-lisp-features) features)

2379

2486

(widen)

2380

2487

(slime-find-buffer-package)))))

2381

2488

2382

(defvar slime-find-buffer-package-function nil

2383

"Function to use instead of `slime-find-buffer-package'.

2384

The result should be a string. The string will be READ at the Lisp

2385

side.")

2489

(defvar slime-find-buffer-package-function 'slime-search-buffer-package

2490

"*Function to use for `slime-find-buffer-package'.

2491

The result should be the package-name (a string)

2492

or nil if nothing suitable can be found.")

2386

2493

2387

2494

(defun slime-find-buffer-package ()

2388

2495

"Figure out which Lisp package the current buffer is associated with."

2389

(if slime-find-buffer-package-function

2390

(funcall slime-find-buffer-package-function)

2496

(funcall slime-find-buffer-package-function))

2497

2498

;; When modifing this code consider cases like:

2499

;; (in-package #.*foo*)

2500

;; (in-package #:cl)

2501

;; (in-package :cl)

2502

;; (in-package "CL")

2503

;; (in-package |CL|)

2504

;; (in-package #+ansi-cl :cl #-ansi-cl 'lisp)

2505

(defun slime-search-buffer-package ()

2506

(let ((case-fold-search t)

2507

(regexp (concat "^(\$cl:\\|common-lisp:\$?in-package\\>[ \n\t\r']*"

2508

"\$[^)]+\$[ \n\t]*)")))

2391

2509

(save-excursion

2392

(when (let ((case-fold-search t)

2393

(regexp "^(\$cl:\\|common-lisp:\$?in-package\\>"))

2394

(or (re-search-backward regexp nil t)

2395

(re-search-forward regexp nil t)))

2396

(goto-char (match-end 0))

2397

(skip-chars-forward " \n\t\f\r#'")

2398

(cond

2399

((looking-at "\\.\\*swig-module-name\\*") ; # was skipped

2400

(if (re-search-backward "(defparameter \\*swig-module-name\\* \$:?\\sw*\$)"

2401

nil t)

2402

(match-string-no-properties 1)))

2403

(t

2404

(let ((pkg (ignore-errors (read (current-buffer)))))

2405

(if pkg (format "%S" pkg)))))))))

2510

(when (or (re-search-backward regexp nil t)

2511

(re-search-forward regexp nil t))

2512

(let ((string (match-string-no-properties 2)))

2513

(cond ((string-match "^\"" string) (ignore-errors (read string)))

2514

((string-match "^#?:" string) (substring string (match-end 0)))

2515

(t string)))))))

2406

2516

2407

2517

;;; Synchronous requests are implemented in terms of asynchronous

2408

2518

;;; ones. We make an asynchronous request with a continuation function

2538

2648

(assert thread)

2539

2649

(sldb-exit thread level stepping))

2540

2650

((:emacs-interrupt thread)

2541

(cond ((slime-use-sigint-for-interrupt) (slime-send-sigint))

2542

(t (slime-send `(:emacs-interrupt ,thread)))))

2651

(slime-send `(:emacs-interrupt ,thread)))

2543

2652

((:read-string thread tag)

2544

2653

(assert thread)

2545

2654

(slime-repl-read-string thread tag))

2708

2817

(slime-repl-insert-prompt (cond (use-header-p `(:suppress-output))

2709

2818

(t `(:values (,(concat "; " banner))))))))

2710

2819

2711

(defun slime-changelog-date ()

2712

"Return the datestring of the latest entry in the ChangeLog file.

2713

Return nil if the ChangeLog file cannot be found."

2714

(let ((changelog "/usr/share/doc/cl-swank/changelog"))

2715

(if (file-exists-p changelog)

2716

(with-temp-buffer

2717

(insert-file-contents changelog nil 0 100)

2718

(goto-char (point-min))

2719

(symbol-name (read (current-buffer))))

2720

nil)))

2721

2722

2820

(defun slime-init-output-buffer (connection)

2723

2821

(with-current-buffer (slime-output-buffer t)

2724

2822

(setq slime-buffer-connection connection

2827

2925

2828

2926

(defstruct slime-presentation text id)

2829

2927

2928

(defvar slime-presentation-syntax-table

2929

(let ((table (copy-syntax-table lisp-mode-syntax-table)))

2930

;; We give < and > parenthesis syntax, so that #< ... > is treated

2931

;; as a balanced expression. This allows to use C-M-k, C-M-SPC,

2932

;; etc. to deal with a whole presentation. (For Lisp mode, this

2933

;; is not desirable, since we do not wish to get a mismatched

2934

;; paren highlighted everytime we type < or >.)

2935

(modify-syntax-entry ?< "(>" table)

2936

(modify-syntax-entry ?> ")<" table)

2937

table)

2938

"Syntax table for presentations.")

2939

2830

2940

(defun slime-add-presentation-properties (start end id result-p)

2831

2941

"Make the text between START and END a presentation with ID.

2832

2942

RESULT-P decides whether a face for a return value or output text is used."

2837

2947

`(modification-hooks (slime-after-change-function)

2838

2948

insert-in-front-hooks (slime-after-change-function)

2839

2949

insert-behind-hooks (slime-after-change-function)

2950

syntax-table ,slime-presentation-syntax-table

2840

2951

rear-nonsticky t))

2841

2952

;; Use the presentation as the key of a text property

2842

2953

(case (- end start)

2879

2990

(defun slime-remove-presentation-properties (from to presentation)

2880

2991

(let ((inhibit-read-only t))

2881

2992

(remove-text-properties from to

2882

`(,presentation t rear-nonsticky t))

2993

`(,presentation t syntax-table t rear-nonsticky t))

2883

2994

(when (eq (get-text-property from 'slime-repl-presentation) presentation)

2884

2995

(remove-text-properties from (1+ from) `(slime-repl-presentation t)))

2885

2996

(when (eq (get-text-property (1- to) 'slime-repl-presentation) presentation)

2888

2999

(when (eq (overlay-get overlay 'slime-repl-presentation) presentation)

2889

3000

(delete-overlay overlay)))))

2890

3001

2891

(defun slime-insert-presentation (result output-id)

2892

(let ((start (point)))

2893

(insert result)

2894

(slime-add-presentation-properties start (point) output-id t)))

3002

(defun slime-insert-presentation (string output-id)

3003

(cond ((not slime-repl-enable-presentations)

3004

(insert string))

3005

(t

3006

(let ((start (point)))

3007

(insert string)

3008

(slime-add-presentation-properties start (point) output-id t)))))

2895

3009

2896

3010

(defun slime-open-stream-to-lisp (port)

2897

3011

(let ((stream (open-network-stream "*lisp-output-stream*"

3067

3181

(set (make-local-variable 'scroll-conservatively) 20)

3068

3182

(set (make-local-variable 'scroll-margin) 0)

3069

3183

(slime-repl-safe-load-history)

3070

(make-local-hook 'kill-buffer-hook)

3071

(add-hook 'kill-buffer-hook 'slime-repl-safe-save-merged-history nil t)

3184

(add-local-hook 'kill-buffer-hook 'slime-repl-safe-save-merged-history)

3072

3185

(add-hook 'kill-emacs-hook 'slime-repl-save-all-histories)

3073

3186

(slime-setup-command-hooks)

3074

3187

(when slime-use-autodoc-mode

3075

3188

(slime-autodoc-mode 1))

3189

(when slime-repl-enable-presentations

3190

;; Respect the syntax text properties of presentations.

3191

(set (make-local-variable 'parse-sexp-lookup-properties) t))

3076

3192

(run-hooks 'slime-repl-mode-hook))

3077

3193

3078

3194

(defun slime-presentation-whole-p (presentation start end &optional object)

3490

3606

(when (and (plusp (length string))

3491

3607

(eq ?\n (aref string (1- (length string)))))

3492

3608

(setq string (substring string 0 -1)))

3493

(unless (equal string (car slime-repl-input-history))

3609

(unless (or (= (length string) 0)

3610

(equal string (car slime-repl-input-history)))

3494

3611

(push string slime-repl-input-history))

3495

3612

(setq slime-repl-input-history-position -1))

3496

3613

3825

3942

(defvar slime-repl-history-pattern nil

3826

3943

"The regexp most recently used for finding input history.")

3827

3944

3828

(defun slime-repl-history-replace (direction regexp &optional delete-at-end-p)

3945

;; initialized later when slime-repl-mode-map is available

3946

(defvar slime-repl-history-map (make-sparse-keymap)

3947

"Map active while in the minibuffer reading repl search regexp.")

3948

3949

(defun* slime-repl-history-replace (direction &optional regexp delete-at-end-p)

3829

3950

"Replace the current input with the next line in DIRECTION matching REGEXP.

3830

3951

DIRECTION is 'forward' or 'backward' (in the history list).

3831

3952

If DELETE-AT-END-P is non-nil then remove the string if the end of the

3832

history is reached."

3833

(setq slime-repl-history-pattern regexp)

3834

(let ((pos (slime-repl-position-in-history direction regexp))

3835

(forward (eq direction 'forward)))

3953

history is reached. Returns t if there were any matches."

3954

(when regexp

3955

(setq slime-repl-history-pattern regexp))

3956

(let* ((forward (eq direction 'forward))

3957

(history-length (length slime-repl-input-history))

3958

(pos (if regexp

3959

(slime-repl-position-in-history direction regexp)

3960

(if (>= slime-repl-input-history-position 0)

3961

(+ slime-repl-input-history-position

3962

(if forward -1 1))

3963

(unless forward

3964

0)))))

3965

(when (and pos

3966

(or (< pos 0)

3967

(>= pos history-length)))

3968

3969

(setf pos nil))

3836

3970

(cond (pos

3837

3971

(slime-repl-replace-input (nth pos slime-repl-input-history))

3838

3972

(setq slime-repl-input-history-position pos)

3842

3976

(message "End of history"))

3843

3977

(t (message "Beginning of history")))

3844

3978

(setq slime-repl-input-history-position

3845

(if forward -1 (length slime-repl-input-history))))

3979

(if forward -1 history-length)))

3846

3980

((and delete-at-end-p slime-repl-wrap-history)

3847

3981

(slime-repl-replace-input "")

3848

3982

(setq slime-repl-input-history-position

3849

(if forward (length slime-repl-input-history) -1)))

3983

(if forward history-length -1)))

3850

3984

(t

3851

(message "End of history; no matching item")))))

3985

(message "End of history; no matching item")

3986

(return-from slime-repl-history-replace nil))))

3987

t)

3852

3988

3853

3989

(defun slime-repl-position-in-history (direction regexp)

3854

3990

"Return the position of the history item matching regexp.

3857

3993

(let* ((step (ecase direction

3858

3994

(forward -1)

3859

3995

(backward 1)))

3860

(history-pos0 slime-repl-input-history-position))

3996

(history-pos0 slime-repl-input-history-position)

3997

(history-length (length slime-repl-input-history)))

3861

3998

(loop for pos = (+ history-pos0 step) then (+ pos step)

3862

3999

while (and (<= 0 pos)

3863

(< pos (length slime-repl-input-history)))

4000

(< pos history-length))

3864

4001

do (let ((string (nth pos slime-repl-input-history)))

3865

4002

(when (and (string-match regexp string)

3866

4003

(not (string= string (slime-repl-current-input))))

3867

4004

(return pos))))))

3868

4005

4006

(defun slime-repl-previous-input ()

4007

(interactive)

4008

(slime-repl-history-replace 'backward nil t))

4009

4010

(defun slime-repl-next-input ()

4011

(interactive)

4012

(slime-repl-history-replace 'forward nil t))

4013

3869

4014

(defun slime-repl-matching-input-regexp ()

3870

4015

(if (memq last-command

3871

'(slime-repl-previous-input slime-repl-next-input))

4016

'(slime-repl-previous-input-starting-with-current-input slime-repl-next-input-starting-with-current-input))

3872

4017

slime-repl-history-pattern

3873

(concat "^" (regexp-quote (slime-buffer-substring-with-reified-output

3874

slime-repl-input-start-mark

3875

(if (> (point) slime-repl-input-start-mark)

3876

(point)

3877

slime-repl-input-end-mark))))))

4018

(concat "^" (regexp-quote (slime-repl-current-input)))))

3878

4019

3879

(defun slime-repl-previous-input ()

4020

(defun slime-repl-previous-input-starting-with-current-input ()

3880

4021

(interactive)

3881

4022

(slime-repl-history-replace 'backward (slime-repl-matching-input-regexp) t))

3882

4023

3883

(defun slime-repl-next-input ()

4024

(defun slime-repl-next-input-starting-with-current-input ()

3884

4025

(interactive)

3885

4026

(slime-repl-history-replace 'forward (slime-repl-matching-input-regexp) t))

3886

4027

3887

(defun slime-repl-previous-matching-input (regexp)

3888

(interactive "sPrevious element matching (regexp): ")

3889

(slime-repl-history-replace 'backward regexp))

3890

3891

(defun slime-repl-next-matching-input (regexp)

3892

(interactive "sNext element matching (regexp): ")

3893

(slime-repl-history-replace 'forward regexp))

4028

(defun slime-repl-continue-search-with-last-pattern ()

4029

(interactive)

4030

(when slime-repl-history-pattern

4031

(throw 'continue slime-repl-history-pattern)))

4032

4033

(defun slime-repl-previous-or-next-matching-input (regexp direction prompt)

4034

(let ((command this-command))

4035

(unless regexp

4036

(setf regexp (if (and slime-repl-history-pattern

4037

(memq last-command

4038

'(slime-repl-previous-matching-input slime-repl-next-matching-input)))

4039

slime-repl-history-pattern

4040

(catch 'continue

4041

(slime-read-from-minibuffer

4042

prompt (slime-symbol-name-at-point) slime-repl-history-map)))))

4043

(when (and regexp (> (length regexp) 0))

4044

(when (slime-repl-history-replace direction regexp)

4045

(setf this-command command)))))

4046

4047

(defun slime-repl-previous-matching-input ()

4048

(interactive)

4049

(slime-repl-previous-or-next-matching-input

4050

nil 'backward "Previous element matching (regexp): "))

4051

4052

(defun slime-repl-next-matching-input ()

4053

(interactive)

4054

(slime-repl-previous-or-next-matching-input

4055

nil 'forward "Next element matching (regexp): "))

3894

4056

3895

4057

;;;;; Persistent History

3896

4058

4019

4181

("\C-a" 'slime-repl-bol)

4020

4182

([home] 'slime-repl-bol)

4021

4183

("\C-e" 'slime-repl-eol)

4022

("\M-p" 'slime-repl-previous-input)

4184

("\M-p" 'slime-repl-previous-input-starting-with-current-input)

4023

4185

((kbd "C-<up>") 'slime-repl-previous-input)

4024

("\M-n" 'slime-repl-next-input)

4186

("\M-n" 'slime-repl-next-input-starting-with-current-input)

4025

4187

((kbd "C-<down>") 'slime-repl-next-input)

4026

4188

("\M-r" 'slime-repl-previous-matching-input)

4027

4189

("\M-s" 'slime-repl-next-matching-input)

4047

4209

("\C-c\C-k" 'slime-compile-and-load-file)

4048

4210

("\C-c\C-z" 'slime-nop))

4049

4211

4212

;; set up slime-repl-history-map

4213

(flet ((remap (keys to)

4214

(mimic-key-bindings slime-repl-mode-map slime-repl-history-map keys to)))

4215

(remap (list 'slime-repl-previous-matching-input (kbd "M-r"))

4216

'slime-repl-continue-search-with-last-pattern)

4217

(remap (list 'slime-repl-next-matching-input (kbd "M-n"))

4218

'slime-repl-continue-search-with-last-pattern))

4219

4050

4220

;;;;;; REPL Read Mode

4051

4221

4052

4222

(define-key slime-repl-mode-map

4088

4258

4089

4259

(defun slime-repl-read-break ()

4090

4260

(interactive)

4091

(slime-eval-async `(swank:simple-break)))

4261

(slime-dispatch-event `(:emacs-interrupt ,(car slime-read-string-threads))))

4092

4262

4093

4263

(defun slime-repl-abort-read (thread tag)

4094

4264

(with-current-buffer (slime-output-buffer)

4111

4281

4112

4282

(defun slime-handle-repl-shortcut ()

4113

4283

(interactive)

4114

(if (= (point) slime-repl-input-start-mark)

4284

(if (> (point) slime-repl-input-start-mark)

4285

(insert (string slime-repl-shortcut-dispatch-char))

4115

4286

(let ((shortcut (slime-lookup-shortcut

4116

4287

(completing-read "Command: "

4117

4288

(slime-bogus-completion-alist

4118

4289

(slime-list-all-repl-shortcuts))

4119

4290

nil t nil

4120

4291

'slime-repl-shortcut-history))))

4121

(call-interactively (slime-repl-shortcut.handler shortcut)))

4122

(insert (string slime-repl-shortcut-dispatch-char))))

4292

(call-interactively (slime-repl-shortcut.handler shortcut)))))

4123

4293

4124

4294

(defun slime-list-all-repl-shortcuts ()

4125

4295

(loop for shortcut in slime-repl-shortcut-table

4400

4570

4401

4571

(defvar slime-lisp-modes '(lisp-mode))

4402

4572

4403

(defvar slime-coding nil

4404

"*The coding to use for `slime-compile-file'. Only used if buffer local.")

4405

4406

4573

(defun slime-compile-file (&optional load)

4407

4574

"Compile current buffer's file and highlight resulting compiler notes.

4408

4575

4424

4591

(slime-display-output-buffer))

4425

4592

(slime-eval-async

4426

4593

`(swank:compile-file-for-emacs

4427

,lisp-filename ,(if load t nil)

4428

,@(if (local-variable-p 'slime-coding (current-buffer))

4429

(list (slime-coding-system-cl-name slime-coding))))

4594

,lisp-filename ,(if load t nil))

4430

4595

(slime-compilation-finished-continuation))

4431

4596

(message "Compiling %s.." lisp-filename)))

4432

4597

4551

4716

(setf slime-compilation-just-finished t)

4552

4717

(multiple-value-bind (result secs) result

4553

4718

(slime-show-note-counts notes secs)

4554

(slime-highlight-notes notes)))

4719

(when slime-highlight-compiler-notes

4720

(slime-highlight-notes notes))))

4555

4721

(run-hook-with-args 'slime-compilation-finished-hook notes)))

4556

4722

4557

4723

(defun slime-compilation-finished-continuation ()

5562

5728

(when-let (name (slime-symbol-name-at-point))

5563

5729

(if (slime-global-variable-name-p name) name)))

5564

5730

5731

(defcustom slime-global-variable-name-regexp "^\$.*:\$?\$[*+]\$.+\\2$"

5732

"Regexp used to check if a symbol name is a global variable.

5733

5734

Default value assumes +this+ or *that* naming conventions."

5735

:type 'regexp

5736

:group 'slime)

5737

5565

5738

(defun slime-global-variable-name-p (name)

5566

5739

"Is NAME a global variable?

5567

5740

Globals are recognised purely by *this-naming-convention*."

5568

(string-match "^\$.*::?\$?[*+].*[*+]$" name))

5741

(and (< (length name) 80) ; avoid overflows in regexp matcher

5742

(string-match slime-global-variable-name-regexp name)))

5569

5743

5570

5744

(defun slime-get-cached-autodoc (symbol-name)

5571

5745

"Return the cached autodoc documentation for SYMBOL-NAME, or nil."

5977

6151

"Minibuffer keymap used for reading CL expressions.")

5978

6152

5979

6153

(set-keymap-parent slime-read-expression-map minibuffer-local-map)

6154

(set-keymap-parent slime-repl-history-map slime-read-expression-map)

5980

6155

5981

6156

(define-key slime-read-expression-map "\t" 'slime-complete-symbol)

5982

6157

(define-key slime-read-expression-map "\M-\t" 'slime-complete-symbol)

5984

6159

(defvar slime-read-expression-history '()

5985

6160

"History list of expressions read from the minibuffer.")

5986

6161

5987

(defun slime-read-from-minibuffer (prompt &optional initial-value)

6162

(defun slime-read-from-minibuffer (prompt &optional initial-value keymap)

5988

6163

"Read a string from the minibuffer, prompting with PROMPT.

5989

6164

If INITIAL-VALUE is non-nil, it is inserted into the minibuffer before

5990

6165

reading input. The result is a string (\"\" if no input was given)."

5996

6171

(setq slime-buffer-connection connection)

5997

6172

(set-syntax-table lisp-mode-syntax-table)))

5998

6173

minibuffer-setup-hook)))

5999

(read-from-minibuffer prompt initial-value slime-read-expression-map

6174

(read-from-minibuffer prompt initial-value

6175

(or keymap slime-read-expression-map)

6000

6176

nil 'slime-read-expression-history)))

6001

6177

6002

6178

(defun slime-bogus-completion-alist (list)

6010

6186

"Return a list of completions of the token from BEG to END in the

6011

6187

current buffer."

6012

6188

(let ((token (buffer-substring-no-properties beg end)))

6013

(when (and (< beg (point-max))

6189

(cond

6190

((and (< beg (point-max))

6014

6191

(string= (buffer-substring-no-properties beg (1+ beg)) ":"))

6015

6192

;; Contextual keyword completion

6016

6193

(multiple-value-bind (operator-names arg-indices)

6026

6203

;; If no matching keyword was found, do regular symbol

6027

6204

;; completion.

6028

6205

))))

6206

((and (> beg 2)

6207

(string= (buffer-substring-no-properties (- beg 2) beg) "#\\"))

6208

;; Character name completion

6209

(return-from slime-contextual-completions

6210

(slime-completions-for-character token))))

6029

6211

;; Regular symbol completion

6030

(slime-completions (buffer-substring-no-properties beg end))))

6212

(slime-completions token)))

6031

6213

6032

6214

(defun slime-completions (prefix)

6033

6215

(slime-eval `(swank:completions ,prefix ',(slime-current-package))))

6041

6223

,prefix

6042

6224

',arg-indices)))

6043

6225

6226

(defun slime-completions-for-character (prefix)

6227

(slime-eval `(swank:completions-for-character ,prefix)))

6228

6044

6229

6045

6230

;;;; Fuzzy completion

6046

6231

6070

6255

"The current completion object. If this is the same before and

6071

6256

after point moves in the completions buffer, the text is not

6072

6257

replaced in the target for efficiency.")

6258

(defvar slime-fuzzy-current-completion-overlay nil

6259

"The overlay representing the current completion in the completion

6260

buffer. This is used to hightlight the text.")

6073

6261

6074

6262

(define-derived-mode slime-fuzzy-completions-mode

6075

6263

fundamental-mode "Fuzzy Completions"

6081

6269

6082

6270

(defvar slime-fuzzy-completions-map

6083

6271

(let* ((map (make-sparse-keymap)))

6084

6085

(define-key map "q" 'slime-fuzzy-abort)

6086

(define-key map "\r" 'slime-fuzzy-select)

6087

6088

(define-key map "n" 'slime-fuzzy-next)

6089

(define-key map "\M-n" 'slime-fuzzy-next)

6090

6091

(define-key map "p" 'slime-fuzzy-prev)

6092

(define-key map "\M-p" 'slime-fuzzy-prev)

6093

6094

(define-key map "\d" 'scroll-down)

6095

(define-key map " " 'scroll-up)

6096

6097

(define-key map [mouse-2] 'slime-fuzzy-select/mouse)

6272

(flet ((remap (keys to)

6273

(mimic-key-bindings global-map map keys to)))

6274

(remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort)

6275

(define-key map "q" 'slime-fuzzy-abort)

6276

6277

(remap (list 'previous-line (kbd "<up>")) 'slime-fuzzy-prev)

6278

(remap (list 'next-line (kbd "<down>")) 'slime-fuzzy-next)

6279

6280

(define-key map "n" 'slime-fuzzy-next)

6281

(define-key map "\M-n" 'slime-fuzzy-next)

6282

6283

(define-key map "p" 'slime-fuzzy-prev)

6284

(define-key map "\M-p" 'slime-fuzzy-prev)

6285

6286

(define-key map "\d" 'scroll-down)

6287

6288

(remap (list 'slime-fuzzy-indent-and-complete-symbol

6289

'slime-indent-and-complete-symbol

6290

(kbd "<tab>"))

6291

'slime-fuzzy-select)

6292

6293

(define-key map (kbd "<mouse-2>") 'slime-fuzzy-select/mouse))

6294

6295

(define-key map (kbd "RET") 'slime-fuzzy-select)

6296

(define-key map (kbd "<SPC>") 'slime-fuzzy-select)

6098

6297

6099

6298

map)

6100

"Keymap for slime-fuzzy-completions-mode.")

6299

"Keymap for slime-fuzzy-completions-mode when in the completion buffer.")

6101

6300

6102

6301

(defun slime-fuzzy-completions (prefix &optional default-package)

6103

6302

"Get the list of sorted completion objects from completing

6108

6307

(slime-eval `(swank:fuzzy-completions ,prefix

6109

6308

,(or default-package

6110

6309

(slime-find-buffer-package)

6111

(slime-current-package))))))

6310

(slime-current-package))

6311

:limit ,slime-fuzzy-completion-limit

6312

:time-limit-in-msec ,slime-fuzzy-completion-time-limit-in-msec))))

6112

6313

6113

6314

(defun slime-fuzzy-selected (prefix completion)

6114

6315

"Tell the connected Lisp that the user selected completion

6118

6319

(slime-eval `(swank:fuzzy-completion-selected ,no-properties

6119

6320

',completion))))

6120

6321

6322

(defun slime-fuzzy-indent-and-complete-symbol ()

6323

"Indent the current line and perform fuzzy symbol completion. First

6324

indent the line. If indenting doesn't move point, complete the

6325

symbol. If there's no symbol at the point, show the arglist for the

6326

most recently enclosed macro or function."

6327

(interactive)

6328

(let ((pos (point)))

6329

(unless (get-text-property (line-beginning-position) 'slime-repl-prompt)

6330

(lisp-indent-line))

6331

(when (= pos (point))

6332

(cond ((save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t))

6333

(slime-fuzzy-complete-symbol))

6334

((memq (char-before) '(?\t ?\ ))

6335

(slime-echo-arglist))))))

6336

6121

6337

(defun* slime-fuzzy-complete-symbol ()

6122

6338

"Fuzzily completes the abbreviation at point into a symbol."

6123

6339

(interactive)

6134

6350

(progn (slime-minibuffer-respecting-message

6135

6351

"Can't find completion for \"%s\"" prefix)

6136

6352

(ding)

6137

(slime-complete-restore-window-configuration))

6353

(slime-fuzzy-done))

6138

6354

(goto-char end)

6139

6355

(cond ((= (length completion-set) 1)

6140

6356

(insert-and-inherit (caar completion-set))

6141

6357

(delete-region beg end)

6142

6358

(goto-char (+ beg (length (caar completion-set))))

6143

(slime-minibuffer-respecting-message "Sole completion"))

6359

(slime-minibuffer-respecting-message "Sole completion")

6360

(slime-fuzzy-done))

6144

6361

;; Incomplete

6145

6362

(t

6146

6363

(slime-minibuffer-respecting-message "Complete but not unique")

6216

6433

`end'. This saves the window configuration before popping the

6217

6434

buffer so that it can possibly be restored when the user is

6218

6435

done."

6219

(setq slime-fuzzy-target-buffer (current-buffer))

6220

(setq slime-fuzzy-start (move-marker (make-marker) start))

6221

(setq slime-fuzzy-end (move-marker (make-marker) end))

6222

(set-marker-insertion-type slime-fuzzy-end t)

6223

(setq slime-fuzzy-original-text (buffer-substring start end))

6224

(setq slime-fuzzy-text slime-fuzzy-original-text)

6225

(slime-fuzzy-save-window-configuration)

6436

(let ((new-completion-buffer (not slime-fuzzy-target-buffer)))

6437

(when new-completion-buffer

6438

(slime-fuzzy-save-window-configuration))

6439

(slime-fuzzy-enable-target-buffer-completions-mode)

6440

(setq slime-fuzzy-target-buffer (current-buffer))

6441

(setq slime-fuzzy-start (move-marker (make-marker) start))

6442

(setq slime-fuzzy-end (move-marker (make-marker) end))

6443

(set-marker-insertion-type slime-fuzzy-end t)

6444

(setq slime-fuzzy-original-text (buffer-substring start end))

6445

(setq slime-fuzzy-text slime-fuzzy-original-text)

6446

(slime-fuzzy-fill-completions-buffer completions)

6447

(pop-to-buffer (slime-get-fuzzy-buffer))

6448

(when new-completion-buffer

6449

(add-local-hook 'kill-buffer-hook 'slime-fuzzy-abort))

6450

(when slime-fuzzy-completion-in-place

6451

;; switch back to the original buffer

6452

(switch-to-buffer-other-window slime-fuzzy-target-buffer))))

6453

6454

(defun slime-fuzzy-fill-completions-buffer (completions)

6455

"Erases and fills the completion buffer with the given completions."

6226

6456

(with-current-buffer (slime-get-fuzzy-buffer)

6227

6457

(setq buffer-read-only nil)

6228

6458

(erase-buffer)

6242

6472

(setq buffer-read-only t))

6243

6473

(setq slime-fuzzy-current-completion

6244

6474

(caar completions))

6245

(slime-fuzzy-insert (caar completions))

6246

(goto-char slime-fuzzy-first)

6247

(pop-to-buffer (current-buffer))

6248

(add-hook (make-local-variable 'post-command-hook)

6249

'slime-fuzzy-post-command-hook)))

6475

(goto-char 0)

6476

(slime-fuzzy-next)))

6477

6478

(defun slime-fuzzy-enable-target-buffer-completions-mode ()

6479

"Store the target buffer's local map, so that we can restore it."

6480

(unless slime-fuzzy-target-buffer-completions-mode

6481

; (slime-log-event "Enabling target buffer completions mode")

6482

(slime-fuzzy-target-buffer-completions-mode 1)))

6483

6484

(defun slime-fuzzy-disable-target-buffer-completions-mode ()

6485

"Restores the target buffer's local map when completion is finished."

6486

(when slime-fuzzy-target-buffer-completions-mode

6487

; (slime-log-event "Disabling target buffer completions mode")

6488

(slime-fuzzy-target-buffer-completions-mode 0)))

6250

6489

6251

6490

(defun slime-fuzzy-insert-from-point ()

6252

6491

"Inserts the completion that is under point in the completions

6278

6517

"Moves point directly to the next completion in the completions

6279

6518

buffer."

6280

6519

(interactive)

6281

(goto-char

6282

(next-single-char-property-change (point) 'completion)))

6520

(with-current-buffer (slime-get-fuzzy-buffer)

6521

(slime-fuzzy-dehighlight-current-completion)

6522

(let ((point (next-single-char-property-change (point) 'completion)))

6523

(when (= point (point-max))

6524

(setf point (previous-single-char-property-change (point-max) 'completion nil slime-fuzzy-first)))

6525

(set-window-point (get-buffer-window (current-buffer)) point)

6526

(goto-char point))

6527

(slime-fuzzy-highlight-current-completion)))

6283

6528

6284

6529

(defun slime-fuzzy-prev ()

6285

6530

"Moves point directly to the previous completion in the

6286

6531

completions buffer."

6287

6532

(interactive)

6288

(goto-char (previous-single-char-property-change

6289

(point) 'completion

6290

nil slime-fuzzy-first)))

6533

(with-current-buffer (slime-get-fuzzy-buffer)

6534

(slime-fuzzy-dehighlight-current-completion)

6535

(let ((point (previous-single-char-property-change (point) 'completion nil slime-fuzzy-first)))

6536

(set-window-point (get-buffer-window (current-buffer)) point)

6537

(goto-char point))

6538

(slime-fuzzy-highlight-current-completion)))

6539

6540

(defun slime-fuzzy-dehighlight-current-completion ()

6541

"Restores the original face for the current completion."

6542

(when slime-fuzzy-current-completion-overlay

6543

(overlay-put slime-fuzzy-current-completion-overlay 'face 'nil)))

6544

6545

(defun slime-fuzzy-highlight-current-completion ()

6546

"Highlights the current completion, so that the user can see it on the screen."

6547

(let ((pos (point)))

6548

(setq slime-fuzzy-current-completion-overlay (make-overlay (point) (search-forward " ") (current-buffer) t nil))

6549

(overlay-put slime-fuzzy-current-completion-overlay 'face 'secondary-selection)

6550

(goto-char pos)))

6291

6551

6292

6552

(defun slime-fuzzy-abort ()

6293

6553

"Aborts the completion process, setting the completions slot in

6294

6554

the target buffer back to its original contents."

6295

6555

(interactive)

6296

6556

(when slime-fuzzy-target-buffer

6297

(slime-fuzzy-insert slime-fuzzy-original-text)

6298

6557

(slime-fuzzy-done)))

6299

6558

6300

6559

(defun slime-fuzzy-select ()

6311

6570

completion)

6312

6571

(slime-fuzzy-done))))))

6313

6572

6573

(defun slime-fuzzy-select-or-update-completions ()

6574

"If there were no changes since the last time fuzzy completion was started

6575

this function will select the current completion. Otherwise refreshes the completion

6576

list based on the changes made."

6577

(interactive)

6578

; (slime-log-event "Selecting or updating completions")

6579

(if (string-equal slime-fuzzy-original-text

6580

(buffer-substring slime-fuzzy-start

6581

slime-fuzzy-end))

6582

(slime-fuzzy-select)

6583

(slime-fuzzy-complete-symbol)))

6584

6585

(defun slime-fuzzy-process-event-in-completions-buffer ()

6586

"Simply processes the event in the target buffer"

6587

(interactive)

6588

(with-current-buffer (slime-get-fuzzy-buffer)

6589

(push last-input-event unread-command-events)))

6590

6591

(defun slime-fuzzy-select-and-process-event-in-target-buffer ()

6592

"Selects the current completion, making sure that it is inserted

6593

into the target buffer and processes the event in the target buffer."

6594

(interactive)

6595

; (slime-log-event "Selecting and processing event in target buffer")

6596

(when slime-fuzzy-target-buffer

6597

(let ((buff slime-fuzzy-target-buffer))

6598

(slime-fuzzy-select)

6599

(with-current-buffer buff

6600

(slime-fuzzy-disable-target-buffer-completions-mode)

6601

(push last-input-event unread-command-events)))))

6602

6314

6603

(defun slime-fuzzy-select/mouse (event)

6315

6604

"Handle a mouse-2 click on a completion choice as if point were

6316

6605

on the completion choice and the slime-fuzzy-select command was

6328

6617

and attempts to restore the window configuration. If this fails,

6329

6618

it just burys the completions buffer and leaves the window

6330

6619

configuration alone."

6331

(set-buffer slime-fuzzy-target-buffer)

6332

(remove-hook 'post-command-hook

6333

'slime-fuzzy-post-command-hook)

6334

(if (slime-fuzzy-maybe-restore-window-configuration)

6335

(bury-buffer (slime-get-fuzzy-buffer))

6336

;; We couldn't restore the windows, so just bury the fuzzy

6337

;; completions buffer and let something else fill it in.

6338

(pop-to-buffer (slime-get-fuzzy-buffer))

6339

(bury-buffer))

6340

(pop-to-buffer slime-fuzzy-target-buffer)

6341

(goto-char slime-fuzzy-end)

6342

(setq slime-fuzzy-target-buffer nil))

6620

(when slime-fuzzy-target-buffer

6621

(set-buffer slime-fuzzy-target-buffer)

6622

(slime-fuzzy-disable-target-buffer-completions-mode)

6623

(if (slime-fuzzy-maybe-restore-window-configuration)

6624

(bury-buffer (slime-get-fuzzy-buffer))

6625

;; We couldn't restore the windows, so just bury the fuzzy

6626

;; completions buffer and let something else fill it in.

6627

(pop-to-buffer (slime-get-fuzzy-buffer))

6628

(bury-buffer))

6629

(pop-to-buffer slime-fuzzy-target-buffer)

6630

(goto-char slime-fuzzy-end)

6631

(setq slime-fuzzy-target-buffer nil)))

6343

6632

6344

6633

(defun slime-fuzzy-save-window-configuration ()

6345

6634

"Saves the current window configuration, and (if the

6413

6702

function name is prompted."

6414

6703

(interactive (list (slime-read-symbol-name "Name: ")))

6415

6704

(let ((definitions (slime-eval `(swank:find-definitions-for-emacs ,name))))

6416

(cond

6705

(cond

6417

6706

((null definitions)

6418

6707

(if slime-edit-definition-fallback-function

6419

6708

(funcall slime-edit-definition-fallback-function name)

6522

6811

(save-match-data

6523

6812

(when (and (buffer-file-name)

6524

6813

(slime-background-activities-enabled-p))

6525

(let ((filename (slime-to-lisp-filename (buffer-file-name))))

6526

(slime-eval-async `(swank:buffer-first-change ,filename)))))))

6814

(let ((filename (slime-to-lisp-filename (buffer-file-name))))

6815

(slime-eval-async `(swank:buffer-first-change ,filename)))))))

6527

6816

6528

6817

(defun slime-setup-first-change-hook ()

6529

6818

(add-hook (make-local-variable 'first-change-hook)

6921

7210

"A helper function to determine the current context.

6922

7211

The pattern can have the form:

6923

7212

pattern ::= () ;matches always

6924

| (*) ;matches insde a list

7213

| (*) ;matches inside a list

6925

7214

| (<symbol> <pattern>) ;matches if the first element in

6926

; current the list is <symbol> and

7215

; the current list is <symbol> and

6927

7216

; if <pattern> matches.

6928

| ((<pattern>)) ;matches if are in a nested list."

7217

| ((<pattern>)) ;matches if we are in a nested list."

6929

7218

(save-excursion

6930

7219

(let ((path (reverse (slime-pattern-path pattern))))

6931

7220

(loop for p in path

6932

7221

always (ignore-errors

6933

7222

(etypecase p

6934

7223

(symbol (slime-beginning-of-list)

6935

(looking-at (symbol-name p)))

7224

(eq (read (current-buffer)) p))

6936

7225

(number (backward-up-list p)

6937

7226

t)))))))

6938

7227

7559

7848

(defun slime-interrupt ()

7560

7849

"Interrupt Lisp."

7561

7850

(interactive)

7562

(slime-dispatch-event `(:emacs-interrupt ,slime-current-thread)))

7851

(cond ((slime-use-sigint-for-interrupt) (slime-send-sigint))

7852

(t (slime-dispatch-event `(:emacs-interrupt ,slime-current-thread)))))

7563

7853

7564

7854

(defun slime-quit ()

7565

7855

(error "Not implemented properly. Use `slime-interrupt' instead."))

7723

8013

(slime-autodoc-mode 1))

7724

8014

;; Make original slime-connection "sticky" for SLDB commands in this buffer

7725

8015

(setq slime-buffer-connection (slime-connection))

7726

(make-local-variable 'kill-buffer-hook)

7727

(add-hook 'kill-buffer-hook 'sldb-delete-overlays nil t))

8016

(add-local-hook 'kill-buffer-hook 'sldb-delete-overlays))

7728

8017

7729

8018

(defun sldb-help-summary ()

7730

8019

"Show summary of important sldb commands"

7888

8177

(defun sldb-activate (thread level)

7889

8178

(unless (let ((b (sldb-find-buffer thread)))

7890

8179

(and b (with-current-buffer b (equal sldb-level level))))

7891

(with-lexical-bindings (thread level)

7892

(slime-eval-async `(swank:debugger-info-for-emacs 0 10)

7893

(lambda (result)

7894

(apply #'sldb-setup thread level result))))))

8180

(slime-rex (thread level)

8181

('(swank:debugger-info-for-emacs 0 10)

8182

nil thread)

8183

((:ok result)

8184

(apply #'sldb-setup thread level result)))))

7895

8185

7896

8186

(defun sldb-exit (thread level &optional stepping)

7897

8187

(when-let (sldb (sldb-find-buffer thread))

8155

8445

(let ((start (or start (point)))

8156

8446

(end (or end (save-excursion (ignore-errors (forward-sexp)) (point)))))

8157

8447

(push (make-overlay start (1+ start)) sldb-overlays)

8158

(push (make-overlay (1- end) end) sldb-overlays)

8159

(dolist (overlay sldb-overlays)

8160

(overlay-put overlay 'face 'secondary-selection))))

8448

(push (make-overlay (1- end) end) sldb-overlays))

8449

(dolist (overlay sldb-overlays)

8450

(overlay-put overlay 'face 'secondary-selection)))

8161

8451

8162

8452

8163

8453

(defun sldb-toggle-details (&optional on)

9539

9829

(slime-test-heading 1 "%s" name)

9540

9830

(dolist (input inputs)

9541

9831

(incf slime-total-tests)

9832

(message "%s: %s" name input)

9542

9833

(slime-test-heading 2 "input: %s" input)

9543

9834

(if slime-test-debug-on-error

9544

9835

(let ((debug-on-error t)

9898

10189

debug-hook-max-depth depth)

9899

10190

(= debug-hook-max-depth depth))))))

9900

10191

10192

(def-slime-test unwind-to-previous-sldb-level (level2 level1)

10193

"Test recursive debugging and returning to lower SLDB levels."

10194

'((2 1) (4 2))

10195

(slime-check-top-level)

10196

(lexical-let ((level2 level2)

10197

(level1 level1)

10198

(state 'enter)

10199

(max-depth 0))

10200

(let ((debug-hook

10201

(lambda ()

10202

(with-current-buffer (sldb-get-default-buffer)

10203

(setq max-depth (max sldb-level max-depth))

10204

(ecase state

10205

(enter

10206

(cond ((= sldb-level level2)

10207

(setq state 'leave)

10208

(sldb-invoke-restart 0))

10209

(t

10210

(slime-eval-async `(cl:aref cl:nil ,sldb-level)))))

10211

(leave

10212

(cond ((= sldb-level level1)

10213

(setq state 'ok)

10214

(sldb-quit))

10215

(t

10216

(sldb-invoke-restart 0)))))))))

10217

(let ((sldb-hook (cons debug-hook sldb-hook)))

10218

(slime-eval-async `(cl:aref cl:nil 0))

10219

(slime-sync-to-top-level 15)

10220

(slime-check-top-level)

10221

(slime-check ("Maximum depth reached (%S) is %S." max-depth level2)

10222

(= max-depth level2))

10223

(slime-check ("Final state reached.")

10224

(eq state 'ok))))))

10225

9901

10226

(def-slime-test loop-interrupt-quit

9902

10227

()

9903

10228

"Test interrupting a loop."

10125

10450

("(princ 10)" ";;;; (princ 10) ...

10126

10451

10

10127

10452

SWANK> " t)

10128

("(princ \"��\")"

10129

";;;; (princ \"��\") ...

10130

��

10453

("(princ \"��\")"

10454

";;;; (princ \"��\") ...

10455

��

10131

10456

SWANK> " t))

10132

10457

(when (and (fboundp 'string-to-multibyte)

10133

10458

(with-current-buffer (process-buffer (slime-connection))

10454

10779

(accept-process-output process timeout))

10455

10780

(t

10456

10781

(accept-process-output process

10457

(truncate timeout)

10782

(if timeout (truncate timeout))

10458

10783

;; Emacs 21 uses microsecs; Emacs 22 millisecs

10459

(truncate (* timeout 1000000))))))

10784

(if timeout (truncate (* timeout 1000000)))))))

10460

10785

10461

10786

(put 'slime-defun-if-undefined 'lisp-indent-function 2)

10462

10787