Mercurial > hg > xemacs-beta

diff lisp/simple.el @ 613:023b83f4e54b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-06-10 10:42:16 by ben] ------ signal-code changes ------ data.c, device-tty.c, emacs.c, floatfns.c, linuxplay.c, nas.c, process-unix.c, signal.c, sunplay.c, sysdep.c, syssignal.h: use EMACS_SIGNAL everywhere instead of playing preprocessing games with signal(). s\windowsnt.h, s\mingw32.h, syssignal.h: Remove mswindows signal code from s+m headers and move to syssignal.h as one of the five ways of signal handling, instead of playing preprocessing games. fileio.c, sysdep.c: Rename sys_do_signal to qxe_reliable_signal. signal.c, process-unix.c, profile.c: Create set_timeout_signal(); use instead of just EMACS_SIGNAL to establish a signal handler on a timeout signal; this does special things under Cygwin. nt.c: Eliminate term_ntproc(), which is blank; used as a SIGABRT handler, which was wrong anyway. nt.c, win32.c: Move signal code from nt.c to win32.c, since Cygwin needs it too when dealing with timeout signals. s\cygwin32.h: Define CYGWIN_BROKEN_SIGNALS. ------ other changes ------ s\mingw32.h: Fix problems with NOT_C_CODE being in the wrong place and excluding defines needed when building Makefile.in.in. filelock.c, mule-canna.c, mule-ccl.c, mule-ccl.h, ralloc.c, unexalpha.c, unexapollo.c, unexcw.c, unexelfsgi.c, unexnt.c, unexsni.c, s\aix3-1.h, s\bsd4-1.h, s\bsd4-2.h, s\bsd4-3.h, s\cxux.h, s\cygwin32.h, s\dgux.h, s\dgux5-4r2.h, s\dgux5-4r3.h, s\dgux5-4r4.h, s\ewsux5r4.h, s\gnu.h, s\hpux.h, s\iris3-5.h, s\iris3-6.h, s\irix3-3.h, s\linux.h, s\mingw32.h, s\newsos5.h, s\nextstep.h, s\ptx.h, s\riscix1-1.h, s\riscix1-2.h, s\rtu.h, s\sco4.h, s\sco5.h, s\template.h, s\ultrix.h, s\umax.h, s\umips.h, s\unipl5-0.h, s\unipl5-2.h, s\usg5-0.h, s\usg5-2-2.h, s\usg5-2.h, s\usg5-3.h, s\usg5-4.h, s\windowsnt.h, s\xenix.h: Rename 'GNU Emacs' to XEmacs in the copyright and comments. nas.c: Stylistic cleanup. Avoid preprocessing games with names such as play_sound_file. ------ signal-code changes ------ data.c, device-tty.c, emacs.c, floatfns.c, linuxplay.c, nas.c, process-unix.c, signal.c, sunplay.c, sysdep.c, syssignal.h: use EMACS_SIGNAL everywhere instead of playing preprocessing games with signal(). s\windowsnt.h, s\mingw32.h, syssignal.h: Remove mswindows signal code from s+m headers and move to syssignal.h as one of the five ways of signal handling, instead of playing preprocessing games. fileio.c, sysdep.c: Rename sys_do_signal to qxe_reliable_signal. signal.c, process-unix.c, profile.c: Create set_timeout_signal(); use instead of just EMACS_SIGNAL to establish a signal handler on a timeout signal; this does special things under Cygwin. nt.c: Eliminate term_ntproc(), which is blank; used as a SIGABRT handler, which was wrong anyway. nt.c, win32.c: Move signal code from nt.c to win32.c, since Cygwin needs it too when dealing with timeout signals. s\cygwin32.h: Define CYGWIN_BROKEN_SIGNALS. ------ other changes ------ s\mingw32.h: Fix problems with NOT_C_CODE being in the wrong place and excluding defines needed when building Makefile.in.in. filelock.c, mule-canna.c, mule-ccl.c, mule-ccl.h, ralloc.c, unexalpha.c, unexapollo.c, unexcw.c, unexelfsgi.c, unexnt.c, unexsni.c, s\aix3-1.h, s\bsd4-1.h, s\bsd4-2.h, s\bsd4-3.h, s\cxux.h, s\cygwin32.h, s\dgux.h, s\dgux5-4r2.h, s\dgux5-4r3.h, s\dgux5-4r4.h, s\ewsux5r4.h, s\gnu.h, s\hpux.h, s\iris3-5.h, s\iris3-6.h, s\irix3-3.h, s\linux.h, s\mingw32.h, s\newsos5.h, s\nextstep.h, s\ptx.h, s\riscix1-1.h, s\riscix1-2.h, s\rtu.h, s\sco4.h, s\sco5.h, s\template.h, s\ultrix.h, s\umax.h, s\umips.h, s\unipl5-0.h, s\unipl5-2.h, s\usg5-0.h, s\usg5-2-2.h, s\usg5-2.h, s\usg5-3.h, s\usg5-4.h, s\windowsnt.h, s\xenix.h: Rename 'GNU Emacs' to XEmacs in the copyright and comments. nas.c: Stylistic cleanup. Avoid preprocessing games with names such as play_sound_file. xemacs-faq.texi: Update sections on Windows and MacOS availability. alist.el, apropos.el, autoload.el, bytecomp.el, cl-compat.el, cl-extra.el, cl-macs.el, cl-seq.el, cl.el, cmdloop.el, cus-edit.el, derived.el, gpm.el, itimer.el, lisp-mode.el, shadow.el, version.el, wid-browse.el: Rename 'GNU Emacs' to XEmacs in the copyright. Fix other references to GNU Emacs that should be XEmacs or just Emacs. files.el: Fix warning. simple.el: transpose-line-up/down will now move the region up or down by a line if active. cvtmail.c, fakemail.c, gnuserv.c, gnuserv.h, gnuslib.c, make-msgfile.c, make-path.c, pop.c, pop.h, profile.c, tcp.c: Rename 'GNU Emacs' to XEmacs in the copyright. Fix comments in similar ways. digest-doc.c, sorted-doc.c: Fix program and author name to reflect XEmacs.
author ben
date Sun, 10 Jun 2001 10:42:39 +0000
parents 98fb34b6fbe9
children 943eaba38521
line wrap: on
line diff
--- a/lisp/simple.el	Sat Jun 09 09:02:04 2001 +0000
+++ b/lisp/simple.el	Sun Jun 10 10:42:39 2001 +0000
@@ -2517,53 +2517,62 @@
   (interactive "*p")
   (transpose-subr 'forward-sexp arg))
 
+(defun Simple-forward-line-creating-newline ()
+  ;; Move forward over a line,
+  ;; but create a newline if none exists yet.
+  (end-of-line)
+  (if (eobp)
+      (newline)
+    (forward-char 1)))
+
+(defun Simple-transpose-lines-mover (arg)
+  (if (= arg 1)
+      (Simple-forward-line-creating-newline)
+    (forward-line arg)))
+
 (defun transpose-lines (arg)
   "Exchange current line and previous line, leaving point after both.
 With argument ARG, takes previous line and moves it past ARG lines.
 With argument 0, interchanges line point is in with line mark is in."
   (interactive "*p")
-  (transpose-subr #'(lambda (arg)
-		     (if (= arg 1)
-			 (progn
-			   ;; Move forward over a line,
-			   ;; but create a newline if none exists yet.
-			   (end-of-line)
-			   (if (eobp)
-			       (newline)
-			     (forward-char 1)))
-		       (forward-line arg)))
-		  arg))
+  (transpose-subr 'Simple-transpose-lines-mover arg))
 
 (defun transpose-line-up (arg)
   "Move current line one line up, leaving point at beginning of that line.
-This can be run repeatedly to move the current line up a number of lines."
+With argument ARG, move it ARG lines up.  This can be run repeatedly
+to move the current line up a number of lines.
+
+If the region is active, move the region up one line (or ARG lines,
+if specified).  The region will not be selected afterwards, but this
+command can still be run repeatedly to move the region up a number
+of lines."
   (interactive "*p")
-  ;; Move forward over a line,
-  ;; but create a newline if none exists yet.
-  (end-of-line)
-  (if (eobp)
-      (newline)
-    (forward-char 1))
-  (transpose-lines (- arg))
-  (forward-line -1))
+  (transpose-line-down (- arg)))
 
 (defun transpose-line-down (arg)
   "Move current line one line down, leaving point at beginning of that line.
-This can be run repeatedly to move the current line down a number of lines."
+With argument ARG, move it ARG lines down.  This can be run repeatedly
+to move the current line down a number of lines.
+
+If the region is active, move the region down one line (or ARG lines,
+if specified).  The region will not be selected afterwards, but this
+command can still be run repeatedly to move the region down a number
+of lines."
   (interactive "*p")
-  ;; Move forward over a line,
-  ;; but create a newline if none exists yet.
-  (end-of-line)
-  (if (eobp)
-      (newline)
-    (forward-char 1))
-  (transpose-lines arg)
-  (forward-line -1))
-
-(defun transpose-subr (mover arg)
+  (if (or (region-active-p)
+	  (getf last-command-properties 'transpose-region-by-line-command))
+      (progn
+	(transpose-subr 'Simple-transpose-lines-mover arg t)
+	(putf this-command-properties 'transpose-region-by-line-command t))
+    (Simple-forward-line-creating-newline)
+    (transpose-subr 'Simple-transpose-lines-mover arg)
+    (forward-line -1)))
+
+(defun transpose-subr (mover arg &optional move-region)
   (let (start1 end1 start2 end2)
     ;; XEmacs -- use flet instead of defining a separate function and
-    ;; relying on dynamic scope!!!
+    ;; relying on dynamic scope; use (mark t) etc; add code to support
+    ;; the new MOVE-REGION arg.
     (flet ((transpose-subr-1 ()
 	     (if (> (min end1 end2) (max start1 start2))
 		 (error "Don't have two things to transpose"))
@@ -2583,36 +2592,63 @@
 	      (setq end2 (point))
 	      (funcall mover -1)
 	      (setq start2 (point))
-	      (goto-char (mark t)) ; XEmacs
+	      (goto-char (mark t))
 	      (funcall mover 1)
 	      (setq end1 (point))
 	      (funcall mover -1)
 	      (setq start1 (point))
 	      (transpose-subr-1))
-	    (exchange-point-and-mark t))) ; XEmacs
-      (while (> arg 0)
-	(funcall mover -1)
-	(setq start1 (point))
-	(funcall mover 1)
-	(setq end1 (point))
-	(funcall mover 1)
-	(setq end2 (point))
-	(funcall mover -1)
-	(setq start2 (point))
-	(transpose-subr-1)
-	(goto-char end2)
-	(setq arg (1- arg)))
-      (while (< arg 0)
-	(funcall mover -1)
-	(setq start2 (point))
-	(funcall mover -1)
-	(setq start1 (point))
-	(funcall mover 1)
-	(setq end1 (point))
-	(funcall mover 1)
-	(setq end2 (point))
-	(transpose-subr-1)
-	(setq arg (1+ arg))))))
+	    (exchange-point-and-mark t)))
+      (if move-region
+	  (let ((rbeg (region-beginning))
+		(rend (region-end)))
+	    (while (> arg 0)
+	      (goto-char rend)
+	      (funcall mover 1)
+	      (setq end2 (point))
+	      (funcall mover -1)
+	      (setq start2 (point))
+	      (setq start1 rbeg end1 rend)
+	      (transpose-subr-1)
+	      (incf rbeg (- end2 start2))
+	      (incf rend (- end2 start2))
+	      (setq arg (1- arg)))
+	    (while (< arg 0)
+	      (goto-char rbeg)
+	      (funcall mover -1)
+	      (setq start1 (point))
+	      (funcall mover 1)
+	      (setq end1 (point))
+	      (setq start2 rbeg end2 rend)
+	      (transpose-subr-1)
+	      (decf rbeg (- end1 start1))
+	      (decf rend (- end1 start1))
+	      (setq arg (1+ arg)))
+	    (set-mark rbeg)
+	    (goto-char rend))
+	(while (> arg 0)
+	  (funcall mover -1)
+	  (setq start1 (point))
+	  (funcall mover 1)
+	  (setq end1 (point))
+	  (funcall mover 1)
+	  (setq end2 (point))
+	  (funcall mover -1)
+	  (setq start2 (point))
+	  (transpose-subr-1)
+	  (goto-char end2)
+	  (setq arg (1- arg)))
+	(while (< arg 0)
+	  (funcall mover -1)
+	  (setq start2 (point))
+	  (funcall mover -1)
+	  (setq start1 (point))
+	  (funcall mover 1)
+	  (setq end1 (point))
+	  (funcall mover 1)
+	  (setq end2 (point))
+	  (transpose-subr-1)
+	  (setq arg (1+ arg)))))))
 
 
 (defcustom comment-column 32