X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fsimple.el;h=c8d5e1fe24e6f645bd17539ac8cfce0e14723a01;hp=cf2652a22c730102c1681c956ba0974f67d3aa3e;hb=59eec5f21669e81977b5b1fe9bf717cab49cf7fb;hpb=a1655b870904de973c366d85ebdc8adde4ef5e1e

diff --git a/lisp/simple.el b/lisp/simple.el
index cf2652a..c8d5e1f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -719,9 +719,18 @@ BUFFER defaults to the current buffer."
 		 (message "Line %d" buffer-line)))))))
   (setq zmacs-region-stays t))
 
-;;; Bob Weiner, Altrasoft, 02/12/1998
-;;; Added the 3rd arg in `count-lines' to conditionalize the counting of
-;;; collapsed lines.
+;; new in XEmacs 21.2 (not in FSF).
+(defun line-number (&optional pos respect-narrowing)
+  "Return the line number of POS (defaults to point).
+If RESPECT-NARROWING is non-nil, then the narrowed line number is returned;
+otherwise, the absolute line number is returned.  The returned line can always
+be given to `goto-line' to get back to the current line."
+  (if (and pos (/= pos (point)))
+      (save-excursion
+	(goto-char pos)
+	(line-number nil respect-narrowing))
+    (1+ (count-lines (if respect-narrowing (point-min) 1) (point-at-bol)))))
+
 (defun count-lines (start end &optional ignore-invisible-lines-flag)
   "Return number of lines between START and END.
 This is usually the number of newlines between them,
@@ -729,7 +738,13 @@ but can be one more if START is not equal to END
 and the greater of them is not at the start of a line.
 
 With optional IGNORE-INVISIBLE-LINES-FLAG non-nil, lines collapsed with
-selective-display are excluded from the line count."
+selective-display are excluded from the line count.
+
+NOTE: The expression to return the current line number is not obvious:
+
+(1+ (count-lines 1 (point-at-bol)))
+
+See also `line-number'."
   (save-excursion
     (save-restriction
       (narrow-to-region start end)
@@ -2001,6 +2016,17 @@ is nil.  If BUFFER is nil, the current buffer is assumed."
       (beginning-of-buffer nil)
       (end-of-buffer nil))))
 
+(defun scroll-up-one ()
+  "Scroll text of current window upward one line.
+On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
+On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
+signaled.
+
+If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
+boundaries do not cause an error to be signaled."
+  (interactive "_")
+  (scroll-up-command 1))
+
 (defun scroll-up-command (&optional n)
   "Scroll text of current window upward ARG lines; or near full screen if no ARG.
 A near full screen is `next-screen-context-lines' less than a full screen.
@@ -2020,6 +2046,17 @@ boundaries do not cause an error to be signaled."
       (beginning-of-buffer nil)
       (end-of-buffer nil))))
 
+(defun scroll-down-one ()
+  "Scroll text of current window downward one line.
+On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
+On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
+signaled.
+
+If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
+boundaries do not cause an error to be signaled."
+  (interactive "_")
+  (scroll-down-command 1))
+
 (defun scroll-down-command (&optional n)
   "Scroll text of current window downward ARG lines; or near full screen if no ARG.
 A near full screen is `next-screen-context-lines' less than a full screen.
@@ -2356,67 +2393,86 @@ With argument 0, interchanges line point is in with line mark is in."
 		       (forward-line arg)))
 		  arg))
 
-(eval-when-compile
-  ;; avoid byte-compiler warnings...
-  (defvar start1)
-  (defvar start2)
-  (defvar end1)
-  (defvar end2))
+(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 to current line 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))
+
+(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 to current line 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))
 
-; start[12] and end[12] used in transpose-subr-1 below
 (defun transpose-subr (mover arg)
   (let (start1 end1 start2 end2)
-    (if (= arg 0)
-	(progn
-	  (save-excursion
-	    (funcall mover 1)
-	    (setq end2 (point))
-	    (funcall mover -1)
-	    (setq start2 (point))
-	    (goto-char (mark t)) ; XEmacs
-	    (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)))))
-
-; start[12] and end[12] used free
-(defun transpose-subr-1 ()
-  (if (> (min end1 end2) (max start1 start2))
-      (error "Don't have two things to transpose"))
-  (let ((word1 (buffer-substring start1 end1))
-	(word2 (buffer-substring start2 end2)))
-    (delete-region start2 end2)
-    (goto-char start2)
-    (insert word1)
-    (goto-char (if (< start1 start2) start1
-		 (+ start1 (- (length word1) (length word2)))))
-    (delete-char (length word1))
-    (insert word2)))
+    ;; XEmacs -- use flet instead of defining a separate function and
+    ;; relying on dynamic scope!!!
+    (flet ((transpose-subr-1 ()
+	     (if (> (min end1 end2) (max start1 start2))
+		 (error "Don't have two things to transpose"))
+	     (let ((word1 (buffer-substring start1 end1))
+		   (word2 (buffer-substring start2 end2)))
+	       (delete-region start2 end2)
+	       (goto-char start2)
+	       (insert word1)
+	       (goto-char (if (< start1 start2) start1
+			    (+ start1 (- (length word1) (length word2)))))
+	       (delete-char (length word1))
+	       (insert word2))))
+      (if (= arg 0)
+	  (progn
+	    (save-excursion
+	      (funcall mover 1)
+	      (setq end2 (point))
+	      (funcall mover -1)
+	      (setq start2 (point))
+	      (goto-char (mark t)) ; XEmacs
+	      (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))))))
+
 
 (defcustom comment-column 32
   "*Column to indent right-margin comments to.
@@ -3336,7 +3392,6 @@ when it is off screen."
 ;Turned off because it makes dbx bomb out.
 (setq blink-paren-function 'blink-matching-open)
 
-(eval-when-compile (defvar myhelp))	; suppress compiler warning
 
 ;; XEmacs: Some functions moved to cmdloop.el:
 ;; keyboard-quit
@@ -3520,8 +3575,6 @@ it were the arg to `interactive' (which see) to interactively read the value."
    (let* ((var (read-variable "Set variable: "))
 	  ;; #### - yucky code replication here.  This should use something
 	  ;; from help.el or hyper-apropos.el
-	  (minibuffer-help-form
-	   '(funcall myhelp))
 	  (myhelp
 	   #'(lambda ()
 	      (with-output-to-temp-buffer "*Help*"
@@ -3536,7 +3589,9 @@ it were the arg to `interactive' (which see) to interactively read the value."
 		(save-excursion
 		  (set-buffer standard-output)
 		  (help-mode))
-		nil))))
+		nil)))
+	  (minibuffer-help-form
+	   '(funcall myhelp)))
      (list var
 	   (let ((prop (get var 'variable-interactive)))
 	     (if prop
@@ -4322,17 +4377,10 @@ The C code calls this periodically, right before redisplay."
       (setq warning-marker (make-marker))
       (set-marker warning-marker 1 buffer))
     (if temp-buffer-show-function
-        (let ((show-buffer (get-buffer-create "*Warnings-Show*")))
-          (save-excursion
-            (set-buffer show-buffer)
-            (setq buffer-read-only nil)
-            (erase-buffer))
-          (save-excursion
-            (set-buffer buffer)
-            (copy-to-buffer show-buffer
-                            (marker-position warning-marker)
-                            (point-max)))
-          (funcall temp-buffer-show-function show-buffer))
+        (progn
+          (funcall temp-buffer-show-function buffer)
+	  (mapc #'(lambda (win) (set-window-start win warning-marker))
+		(windows-of-buffer buffer nil t)))
       (set-window-start (display-buffer buffer) warning-marker))
     (set-marker warning-marker (point-max buffer) buffer)))
 
@@ -4346,5 +4394,10 @@ The C code calls this periodically, right before redisplay."
   (cond ((featurep 'infodock) "InfoDock")
 	((featurep 'xemacs) "XEmacs")
 	(t "Emacs")))
+
+(defun debug-print (format &rest args)
+  "Send a string to the debugging output.
+The string is formatted using (apply #'format FORMAT ARGS)."
+  (princ (apply #'format format args) 'external-debugging-output))
 	  
 ;;; simple.el ends here