Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
95 lines (80 sloc) 3.47 KB
;; Editor extensions unrelated to the HTTP server itself
;; In this file, you'll find some editor commands that I have implemented
;; while writing the http server, to add some features that I am used to
;; having from GNU Emacs.
(in-package :editor)
(define-command (delete-matching-lines-command
:display-name "Delete Matching Lines")
(prefix)
(declare (ignore prefix))
(let* ((match-string (simple-prompt-for-input "Delete lines containing:"))
(search-pattern (make-search-pattern :case-insensitive
:forward
match-string)))
(do* ((match (locate-pattern (current-buffer-point) search-pattern)
(locate-pattern (current-buffer-point) search-pattern)))
((null match))
(setf (line-string (mark-line (current-buffer-point))) ""))))
(define-command (toggle-read-only-command
:display-name "Toggle Read Only")
(prefix)
(declare (ignore prefix))
(setf (buffer-read-only (current-buffer))
(not (buffer-read-only (current-buffer)))))
(bind-command "Toggle Read Only" '#(#\escape #\r) '(:style emacs))
(defmacro save-excursion (&body body)
(let ((saved-position (gensym)))
`(with-mark ((,saved-position (current-buffer-point)))
(prog1
(progn ,@body)
(move-mark (current-buffer-point) ,saved-position)))))
(define-command (evaluate-top-level-form-command
:display-name "Evaluate Top Level Form")
(prefix)
(declare (ignore prefix))
(save-excursion
(select-outermost-form-command nil)
(evaluate-lisp-region-command nil)))
(bind-command "Evaluate Top Level Form" '#(#\escape #\^X) '(:style emacs))
(define-command (evaluate-buffer-command
:display-name "Evaluate Buffer")
(prefix)
(declare (ignore prefix))
(let ((current-package-name (package-name *package*)))
(save-excursion
(with-mark ((start (current-buffer-point))
(end (current-buffer-point)))
(buffer-start start)
(buffer-end end)
(evaluate-lisp-region-command nil (make-region start end))))
(in-package current-package-name)))
(bind-command "Evaluate Buffer" '#(#\^X #\^L) '(:style emacs))
(define-command (only-one-space-command
:display-name "Only One Space")
(prefix)
(declare (ignore prefix))
(if (or (eq (next-character (current-buffer-point)) #\space)
(eq (previous-character (current-buffer-point)) #\space))
(with-mark ((point (current-buffer-point))
(start (current-buffer-point)))
;; goto beginning of spaces
(loop
(if (eq (previous-character point) #\space)
(character-offset point -1)
(return)))
(move-mark start point)
;; look for end of spaces
(loop
(if (eq (next-character point) #\space)
(character-offset point 1)
(return)))
;; remove spaces
(character-offset point -1)
(delete-region (make-region start point)))
(editor-error "Not looking at space")))
(bind-command "Only One Space" '#(#\escape #\space))
(unbind-command #\^g '(:style emacs))
(bind-command "Pause Editor" '#(#\^X #\^Z) '(:style emacs))
(bind-command "Pause Editor" #\^Z '(:style emacs))
(bind-command "Prompt Show Alternatives" '#(#\escape #\^I) :global)
(bind-keyboard-function #\^E 'ed)