Initial commit

emacsed-el.el

@@ -0,0 +1,480 @@
+;;; emacsed.el -- ed for Emacs.
+
+;; Copyright (c) 2005 Antti Nykänen <aon@iki.fi>
+;;
+;; Permission to use, copy, modify, and distribute this software for any
+;; purpose with or without fee is hereby granted, provided that the above
+;; copyright notice and this permission notice appear in all copies.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+;; Author: Antti Nykänen
+;; X-RCS: $Id: emacsed.el,v 1.47 2005/09/10 07:03:24 aon Exp $
+;; URL: http://aon.iki.fi/emacsed.html
+;; Keywords: emulation
+
+;; Commentary:
+
+;; emacsed.el lets you interact with Emacs buffers like you would
+;; do with the ed editor.
+
+;; Make sure that this file is somewhere along your load-path,
+;; then add (require 'ed) into your .emacs
+
+;; Use ed by opening a file like you'd normally do, and then do:
+;; M-x ed RET
+
+(defvar ed-mode-hook nil
+  "Hook run when entering ed mode.")
+
+(defvar ed-mode-map (make-sparse-keymap)
+  "Keymap for ed mode.")
+
+(define-key ed-mode-map "\r" 'ed-newline)
+
+(defconst ed-cmd-alist 
+  '(("=" "ed-cmd-linenum")
+    ("!" "ed-cmd-exec")
+    ("a" "ed-cmd-append")
+    ("c" "ed-cmd-change")
+    ("d" "ed-cmd-delete")
+    ("f" "ed-cmd-file")
+    ("i" "ed-cmd-insert")
+    ("j" "ed-cmd-join")
+    ("k" "ed-cmd-mark")
+    ("l" "ed-cmd-unambiguous-print")
+    ("m" "ed-cmd-move")
+    ("n" "ed-cmd-numbered-print")
+    ("p" "ed-cmd-print")
+    ("P" "ed-cmd-prompt")
+    ("q" "ed-cmd-quit")
+    ("r" "ed-cmd-read")
+    ("s" "ed-cmd-replace")
+    ("t" "ed-cmd-transfer")
+    ("u" "ed-cmd-undo")
+    ("w" "ed-cmd-write"))
+  "Associated list for ed commands and their respective functions.")
+
+
+(defun ed-line-number-at-pos (&optional pos)
+    "Return (narrowed) buffer line number at position POS.
+If POS is nil, use current buffer location. Provided for
+compatibility with Emacs 21." (let ((opoint (or pos (point))) start)
+      (save-excursion
+	(goto-char (point-min))
+	(setq start (point))
+	(goto-char opoint)
+	(forward-line 0)
+	(1+ (count-lines start (point))))))
+
+(defun ed-get-line ()
+  "Returns the string on the current line."
+  (copy-region-as-kill
+   (+ (if (and (not ed-is-inserting) 
+	       ed-display-prompt)
+	  (length ed-prompt) 
+	0)
+      (point-at-bol))
+   (point-at-eol))
+  (pop kill-ring))
+
+(defun ed-newline ()
+  "Insert a newline, executing the command on this line if in command mode."
+  (interactive)
+  (ed-exec-line)
+  (when (ed-get-ed-buffer)
+    (insert "\n")
+    (if (and (not ed-is-inserting) ed-display-prompt)
+	(insert ed-prompt))))
+
+(defun ed-strtonum (num)
+  "Return the line number indicated by the ed address notation in num."
+  (with-current-buffer ed-associated-buffer
+    (cond 
+     ((or (equal num "") (equal num "."))
+      (ed-line-number-at-pos))
+     ((string-match "^/\\(.*\\)/$" num)
+      (save-excursion
+	(end-of-line)
+	(ed-line-number-at-pos (search-forward-regexp
+				(match-string 1 num) nil t))))
+     ((string-match "^\\?\\(.*\\)\\?$" num)
+      (save-excursion
+	(beginning-of-line)
+	(ed-line-number-at-pos (search-backward-regexp
+				(match-string 1 num) nil t))))
+     ((equal num "$")
+      (if (> (ed-line-number-at-pos (point-max)) 1)
+	  (1+ (count-lines 1 (buffer-size)))
+	1))
+     ((and (equal (string-to-char num) ?') (= (length num) 2))
+      (cdr (assoc (substring num 1) (with-current-buffer (ed-get-ed-buffer)
+				      ed-mark-alist))))
+     ((or (equal (string-to-char num) ?+)
+	  (equal (string-to-char num) ?-))
+      (cond
+       ((or (equal num "-") (equal num "^"))
+	(setq num "-1"))
+       ((equal num "+")
+	(setq num "+1")))
+      (+ (ed-line-number-at-pos) (string-to-number num)))
+     (t (string-to-number num)))))
+
+(defun ed-num-extract (string)
+  "Return a list with the addresses and the rest of the command in
+separate strings."
+  (let ((state 0)
+	(first-num "")
+	(second-num "")
+	(rest "")
+	(is-searchstr nil)
+	(is-mark nil))
+    (dolist (chr (string-to-list string))
+      (let ((schr (char-to-string chr)))
+	(cond
+	 ((and (< state 2) (= chr ?%))
+	  (setq first-num "1")
+	  (setq second-num (number-to-string (ed-strtonum "$")))
+	  (setq state 2))
+	 ((and (< state 2) (= chr ?\;))
+	  (setq first-num (number-to-string (ed-strtonum ".")))
+	  (setq second-num (number-to-string (ed-strtonum "$")))
+	  (setq state 2))
+	 ((and (< state 2) (or (= chr ?/) (= chr ??)))
+	  (setq is-searchstr (not is-searchstr))
+	  (if (= state 0)
+	      (setq first-num (concat first-num schr))
+	    (setq second-num (concat second-num schr))))
+	 ((and (< state 2) (equal chr ?'))
+	  (if (= state 0)
+	      (setq first-num schr)
+	    (setq second-num schr))
+	  (setq is-mark t))
+	 (is-mark
+	  (if (= state 0)
+	      (setq first-num (concat first-num schr))
+	    (setq second-num (concat second-num schr)))
+	  (setq is-mark nil))
+	 ((and (< state 2) (or (> (ed-strtonum schr) 0)
+			       (= chr ?0) is-searchstr))
+	  (if (= state 0)
+	      (setq first-num (concat first-num schr))
+	    (setq second-num (concat second-num schr))))
+	 ((and (= chr ?,) (= state 0))
+	  (if (equal first-num "")
+	      (progn (setq first-num "1")
+		     (setq second-num (number-to-string (ed-strtonum "$")))
+		     (setq state 2))
+	    (setq state (1+ state))))
+	 (t (or (= state 2) (setq state 2))
+	    (setq rest (concat rest schr))))))
+    (unless is-searchstr
+      (when (and (equal second-num "") (or
+					(equal (string-to-char first-num) ??)
+					(equal (string-to-char first-num) ?/)))
+	(setq first-num (number-to-string (ed-strtonum first-num)))
+	(setq second-num first-num))
+      (list first-num second-num rest))))
+
+(defun ed-exec-line ()
+  "Run the ed command on this line."
+  (let ((line (ed-get-line)))
+    (if ed-is-inserting
+	(if (equal "." line)
+	    (progn
+	      (setq ed-is-inserting nil)
+	      (with-current-buffer ed-associated-buffer (previous-line 1)))
+	  (with-current-buffer ed-associated-buffer
+	    (insert line "\n")))
+      (if (< (length line) 1)
+	  (ed-cmd-error)
+	(let* ((extracted (ed-num-extract line))
+	       (start (car extracted))
+	       (end (nth 1 extracted))
+	       (command (if (> (length (nth 2 extracted)) 0)
+			    (substring (nth 2 extracted) 0 1) ""))
+	       (args (if (> (length (nth 2 extracted)) 1)
+			 (substring (nth 2 extracted) 1) ""))
+	       (function (intern-soft (cadr (assoc command ed-cmd-alist)))))
+	  (cond
+	   ((or (> (ed-strtonum start) (ed-strtonum "$"))
+		(> (ed-strtonum end) (ed-strtonum "$"))
+		(< (ed-strtonum start) 1)
+		(< (ed-strtonum end) 1)
+		(and (not (equal end "")) 
+		     (< (ed-strtonum end) (ed-strtonum start))))
+	    (ed-cmd-error))
+	   (function
+	    (funcall function args start end))
+	   ((not (equal end ""))
+	    (ed-goto-line-print (ed-strtonum end)))
+	   (start
+	    (ed-goto-line-print (ed-strtonum start)))
+	   (t (ed-cmd-error))))))))
+
+(defun ed-get-ed-buffer ()
+  "Gets the buffer of this ed instance."
+  (get-buffer (concat "ed: " (buffer-name ed-associated-buffer))))
+
+(defun ed-goto-line-print (line)
+  "Go to a line and output it."
+  (with-current-buffer ed-associated-buffer
+    (goto-line line))
+  (ed-cmd-print "" "." ""))
+
+(defun ed-cmd-append (args start end)
+  "Start appending text."
+  (setq ed-is-inserting t)
+  (let ((start (ed-strtonum start)))
+    (with-current-buffer ed-associated-buffer
+      (goto-line (+ 1 start)))))
+
+(defun ed-cmd-change (args start end)
+  "Delete the text between start and end and insert some new to replace it."
+  (setq ed-is-inserting t)
+  (ed-cmd-delete args start end))
+
+(defun ed-cmd-delete (args start end)
+  "Delete the text between start and end."
+  (setq start (ed-strtonum start))
+  (if (equal "" end) 
+      (setq end start)
+    (setq end (ed-strtonum end)))
+  (with-current-buffer ed-associated-buffer
+    (let* ((current-line (ed-line-number-at-pos))
+	   (start-pos (point-at-bol (- start (- current-line 1))))
+	   (end-pos (point-at-eol (- end (- current-line 1)))))
+      (delete-region (- start-pos 
+			(if (equal (char-after (1- start-pos)) ?\n) 1 0))
+		     end-pos))))
+
+(defun ed-cmd-error (&rest unused)
+  "Throw the error message."
+  (insert "\n?"))
+
+(defun ed-cmd-exec (args &rest unused)
+  (if (or (not (equal end ""))
+	  (< (length args) 1))
+      (ed-cmd-error))
+  (insert "\n" (shell-command-to-string args) "!"))
+
+(defun ed-cmd-file (&rest unused)
+  "Return the name of the file in the associated buffer."
+  (insert "\n" (buffer-file-name ed-associated-buffer)))
+
+(defun ed-cmd-insert (args start end)
+  "Start inserting text."
+  (setq ed-is-inserting t)
+  (let ((start (ed-strtonum start)))
+    (with-current-buffer ed-associated-buffer
+      (goto-line start))))
+
+(defun ed-cmd-join (args start end)
+  (let* ((start (ed-strtonum start))
+	 (end (ed-strtonum end)))
+    (with-current-buffer ed-associated-buffer
+      (goto-line start)
+      (while (<= start end)
+	(join-line 1)
+	(setq start (1+ start))))))
+
+(defun ed-cmd-linenum (args start end) 
+  "Print a line number."
+  (insert "\n" (number-to-string (ed-strtonum start))))
+
+(defun ed-cmd-mark (args start end)
+  "Insert a mark."
+  (if (and (= (length args) 1))
+      (progn
+	(setq ed-mark-alist (remove (assoc args ed-mark-alist) ed-mark-alist))
+	(push (cons args (ed-strtonum start)) ed-mark-alist))
+    (ed-cmd-error)))
+
+(defun ed-cmd-move (args start end)
+  "Move lines"
+  (let* ((start (ed-strtonum start))
+	 (end (+ 1 (ed-strtonum end)))
+	 (to (ed-strtonum args)))
+    (with-current-buffer ed-associated-buffer
+      (let ((current-line (ed-line-number-at-pos)))
+	(kill-region (point-at-bol (- start (- current-line 1)))
+		     (+ (if (= (point-at-eol) (point-max)) 0 1)
+			(point-at-eol (- end current-line))))
+	(goto-line to)
+	(insert (pop kill-ring))))))
+
+(defun ed-cmd-numbered-print (args start end)
+  "Print lines with their line numbers."
+  (let* ((start (ed-strtonum start))
+	 (end (if (equal end "") start (ed-strtonum end))))
+    (with-current-buffer ed-associated-buffer
+      (let ((current-line (ed-line-number-at-pos)))
+	(while (<= start end)
+	  (copy-region-as-kill
+	   (point-at-bol (- start (- current-line 1)))
+	   (point-at-eol (- start (- current-line 1))))
+	  (with-current-buffer (ed-get-ed-buffer) 
+	    (insert "\n" (number-to-string start) 
+		    "\t" (pop kill-ring)))
+	  (setq start (1+ start)))))))
+
+(defun ed-cmd-print (args start end)
+  "The print command."
+  (setq start (ed-strtonum start))
+  (if (equal end "")
+      (setq end start)
+    (setq end (ed-strtonum end)))
+  (with-current-buffer ed-associated-buffer
+    (let ((current-line (ed-line-number-at-pos)))
+      (copy-region-as-kill
+       (point-at-bol (- start (- current-line 1)))
+       (point-at-eol (- end (- current-line 1)))))
+    (goto-line end))
+  (insert "\n" (pop kill-ring)))
+
+(defun ed-cmd-prompt (&rest unused)
+  "Toggle the prompt."
+  (setq ed-display-prompt (not ed-display-prompt)))
+
+(defun ed-cmd-quit (&rest unused)
+  "Quit ed."
+  (let ((ed-buffer (ed-get-ed-buffer)))
+    (if (> (length (window-list)) 1)
+	(delete-window (get-buffer-window ed-buffer)))
+    (kill-buffer ed-buffer)))
+
+(defun ed-cmd-read (args start end)
+  "Insert a file to the buffer."
+  (setq start (ed-strtonum start))
+  (if (or (not (equal end ""))
+	  (< (length args) 2))
+      (ed-cmd-error)
+    (progn
+      (with-current-buffer ed-associated-buffer
+	(goto-line (1+ start))
+	(goto-line
+	 (ed-line-number-at-pos
+	  (+ (point)
+	     (cadr (insert-file-contents (substring args 1))))))))))
+
+(defun ed-cmd-replace (args start end)
+  "The ed replace command."
+  (if (equal args "")
+      (ed-cmd-replace ed-last-replace start end)
+    (progn
+      (if (or (equal start "") (equal end ""))
+	  (setq start (setq end (with-current-buffer ed-associated-buffer 
+				  (ed-line-number-at-pos))))
+	(progn (setq start (ed-strtonum start))
+	       (setq end (ed-strtonum end))))
+      (setq split-regexp (split-string args "/"))
+      (if (equal (car split-regexp) "")
+	  (setq split-regexp (cdr split-regexp)))
+      (if (not (or (= (length split-regexp) 2)
+		   (= (length split-regexp) 3)))
+	  (ed-cmd-error)
+	(let ((from (car split-regexp))
+	      (to (nth 1 split-regexp))
+	      (arg (if (= (length split-regexp) 2) "" (nth 2 split-regexp))))
+	  (setq ed-last-replace args)
+	  (with-current-buffer ed-associated-buffer
+	    (let* ((current-line (ed-line-number-at-pos))
+		   (begin-point (point-at-bol (- start (1- current-line))))
+		   (end-point (point-at-eol (- end (1- current-line)))))
+	      (goto-char begin-point)
+	      (cond 
+	       ((equal arg "g")
+		(while (re-search-forward from end-point t)
+		  (replace-match to t t)))
+	       (t (re-search-forward from end-point t)
+		  (replace-match to t t)))))))
+      (ed-goto-line-print end))))
+
+(defun ed-cmd-transfer (args start end)
+  "Transfer lines."
+  (let* ((start (ed-strtonum start))
+	 (end (+ 1 (ed-strtonum end)))
+	 (to (ed-strtonum args)))
+    (with-current-buffer ed-associated-buffer
+      (let ((current-line (ed-line-number-at-pos)))
+	(copy-region-as-kill (point-at-bol (- start (- current-line 1)))
+			     (+ (if (= (point-at-eol) (point-max)) 0 1)
+				(point-at-eol (- end current-line))))
+	(goto-line to)
+	(insert (pop kill-ring))))))
+
+(defun ed-cmd-unambiguous-print (args start end)
+  "Print lines unambiguously."
+  (let* ((start (ed-strtonum start))
+	 (end (if (equal end "") start (ed-strtonum end))))
+    (with-current-buffer ed-associated-buffer
+      (let ((current-line (ed-line-number-at-pos)))
+	  (copy-region-as-kill
+	   (point-at-bol (- start (- current-line 1)))
+	   (point-at-eol (- end (- current-line 1))))))
+    (let ((contents
+	   (replace-regexp-in-string
+	    "\t" "\\\\t"
+	    (replace-regexp-in-string
+	     "$" "\$" (pop kill-ring)))))
+      (insert "\n" contents))))
+
+(defun ed-cmd-undo (&rest unused)
+  "Undo, currently doesn't probably do what it should."
+  (with-current-buffer ed-associated-buffer
+    (undo)))
+
+(defun ed-cmd-write (&rest unused)
+  "Write changes to the buffer being edited."
+  (with-current-buffer ed-associated-buffer
+    (save-buffer))
+  (insert "\n" (int-to-string (buffer-size ed-associated-buffer))))
+
+(defvar ed-associated-buffer nil
+  "The buffer associated with this ed session.")
+
+(defvar ed-is-inserting nil
+  "t if ed is in accepting text input instead of commands.")
+
+(defvar ed-prompt "*"
+  "The ed prompt.")
+
+(defvar ed-display-prompt nil
+  "t if ed should display the prompt.")
+
+(defvar ed-last-replace nil
+  "Last replaced regexp.")
+
+(defvar ed-mark-alist nil
+  "Stored ed marks in this buffer.")
+
+(defun ed-mode ()
+  "Major mode for ed buffers."
+  (kill-all-local-variables)
+  (use-local-map ed-mode-map)
+  (setq mode-name "ed")
+  (setq major-mode 'ed-mode)
+  (make-local-variable 'ed-associated-buffer)
+  (make-local-variable 'ed-display-prompt)
+  (make-local-variable 'ed-is-inserting)
+  (make-local-variable 'ed-last-replace)
+  (make-local-variable 'ed-mark-alist)
+  (run-hooks 'ed-mode-hook))
+
+(defun ed ()
+  "Launch an ed session associated with the current buffer."
+  (interactive)
+  (let ((edit-buffer (buffer-name)))
+    (pop-to-buffer (concat "ed: " edit-buffer))
+    (ed-mode)
+    (setq ed-associated-buffer (get-buffer edit-buffer))))
+
+(provide 'ed)
+
+;;; emacsed.el ends here.