xemacs-beta: lisp/prim/simple.el comparison

comparison lisp/prim/simple.el @ 4:b82b59fe008d r19-15b3

Import from CVS: tag r19-15b3

author	cvs
date	Mon, 13 Aug 2007 08:46:56 +0200
parents	ac2d302a0011
children	27bc7f280385

comparison

equal deleted inserted replaced

-:30df88044ec6
+:b82b59fe008d
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;; General Public License for more details.
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
-;;; Synched up with: FSF 19.30.
+;;; Synched up with: FSF 19.34 [But not very closely].
 ;;; Commentary:
 ;; A grab-bag of basic XEmacs commands not specifically related to some
 ;; major mode or to file-handling.
-;;; Changes for zmacs-style active-regions:
+;; Changes for zmacs-style active-regions:
-;;;
+;;
-;;; beginning-of-buffer, end-of-buffer, count-lines-region,
+;; beginning-of-buffer, end-of-buffer, count-lines-region,
-;;; count-lines-buffer, what-line, what-cursor-position, set-goal-column,
+;; count-lines-buffer, what-line, what-cursor-position, set-goal-column,
-;;; set-fill-column, prefix-arg-internal, and line-move (which is used by
+;; set-fill-column, prefix-arg-internal, and line-move (which is used by
-;;; next-line and previous-line) set zmacs-region-stays to t, so that they
+;; next-line and previous-line) set zmacs-region-stays to t, so that they
-;;; don't affect the current region-hilighting state.
+;; don't affect the current region-hilighting state.
-;;;
+;;
-;;; mark-whole-buffer, mark-word, exchange-point-and-mark, and
+;; mark-whole-buffer, mark-word, exchange-point-and-mark, and
-;;; set-mark-command (without an argument) call zmacs-activate-region.
+;; set-mark-command (without an argument) call zmacs-activate-region.
-;;;
+;;
-;;; mark takes an optional arg like the new Fmark_marker() does.  When
+;; mark takes an optional arg like the new Fmark_marker() does.  When
-;;; the region is not active, mark returns nil unless the optional arg is true.
+;; the region is not active, mark returns nil unless the optional arg is true.
-;;;
+;;
-;;; push-mark, pop-mark, exchange-point-and-mark, and set-marker, and
+;; push-mark, pop-mark, exchange-point-and-mark, and set-marker, and
-;;; set-mark-command use (mark t) so that they can access the mark whether
+;; set-mark-command use (mark t) so that they can access the mark whether
-;;; the region is active or not.
+;; the region is active or not.
-;;;
+;;
-;;; shell-command, shell-command-on-region, yank, and yank-pop (which all
+;; shell-command, shell-command-on-region, yank, and yank-pop (which all
-;;; push a mark) have been altered to call exchange-point-and-mark with an
+;; push a mark) have been altered to call exchange-point-and-mark with an
-;;; argument, meaning "don't activate the region".  These commands  only use
+;; argument, meaning "don't activate the region".  These commands  only use
-;;; exchange-point-and-mark to position the newly-pushed mark correctly, so
+;; exchange-point-and-mark to position the newly-pushed mark correctly, so
-;;; this isn't a user-visible change.  These functions have also been altered
+;; this isn't a user-visible change.  These functions have also been altered
-;;; to use (mark t) for the same reason.
+;; to use (mark t) for the same reason.
 ;;; Code:
 (defun newline (&optional arg)
 "Insert a newline, and move to left margin of the new line if it's blank.
 ;; try_window_id than inserting at the beginning of a line, and the textual
 ;; result is the same.  So, if we're at beginning of line, pretend to be at
 ;; the end of the previous line.
 (let ((flag (and (not (bobp))
 		   (bolp)
+		   ;; Make sure the newline before point isn't intangible.
+		   (not (get-char-property (1- (point)) 'intangible))
+		   ;; Make sure the newline before point isn't read-only.
+		   (not (get-char-property (1- (point)) 'read-only))
+		   ;; Make sure the newline before point isn't invisible.
+		   (not (get-char-property (1- (point)) 'invisible))
+		   ;; Make sure the newline before point has the same
+		   ;; properties as the char before it (if any).
 		   (< (or (previous-extent-change (point)) -2)
 		      (- (point) 2))))
 	(was-page-start (and (bolp)
 			     (looking-at page-delimiter)))
 	(beforepos (point)))
 ;; If we did *not* get an error, cancel that forward-char.
 (if flag (backward-char 1))
 ;; Mark the newline(s) `hard'.
 (if use-hard-newlines
 	(let* ((from (- (point) (if arg (prefix-numeric-value arg) 1)))
-	       (sticky (get-text-property from 'end-open)))
+	       (sticky (get-text-property from 'end-open))) ; XEmacs
 	  (put-text-property from (point) 'hard 't)
 	  ;; If end-open is not "t", add 'hard to end-open list
 	  (if (and (listp sticky) (not (memq 'hard sticky)))
-	      (put-text-property from (point) 'end-open
+	      (put-text-property from (point) 'end-open ; XEmacs
 				 (cons 'hard sticky)))))
 ;; If the newline leaves the previous line blank,
 ;; and we have a left margin, delete that from the blank line.
 (or flag
 	(save-excursion
 (defun open-line (arg)
 "Insert a newline and leave point before it.
 If there is a fill prefix and/or a left-margin, insert them on the new line
 if the line would have been blank.
 With arg N, insert N newlines."
-;;   "Insert a newline and leave point before it.
-;; If there is a fill prefix, insert the fill prefix on the new line
-;; if the line would have been empty.
-;; With arg N, insert N newlines."
 (interactive "*p")
 (let* ((do-fill-prefix (and fill-prefix (bolp)))
-	 ;well, I'm going to re-enable this.  --ben
-	 ;(do-fill-prefix nil)  ;; screw this -- says JWZ
 	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
 	 (loc (point)))
 (newline arg)
 (goto-char loc)
 (while (> arg 0)
 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
 (defun just-one-space ()
 "Delete all spaces and tabs around point, leaving one space."
 (interactive "*")
-(if abbrev-mode
+(if abbrev-mode ; XEmacs
 (expand-abbrev))
 (skip-chars-backward " \t")
 (if (= (following-char) ? )
 (forward-char 1)
 (insert ? ))
 (if (looking-at "^[ \t]*\n\\'")
 	(delete-region (point) (point-max)))))
 (defun back-to-indentation ()
 "Move point to the first non-whitespace character on this line."
+;; XEmacs change
 (interactive "_")
 (beginning-of-line 1)
 (skip-chars-forward " \t"))
 (defun newline-and-indent ()
 	      (insert-char ?\ col)
 	      (delete-char 1)))
 	(forward-char -1)
 	(setq count (1- count)))))
 (delete-backward-char arg killp)
-;; In overwrite mode, back over columns while clearing them out,
+;; XEmacs: In overwrite mode, back over columns while clearing them out,
 ;; unless at end of line.
 (and overwrite-mode (not (eolp))
 (save-excursion (insert-char ?\  arg))))
 (defun zap-to-char (arg char)
 If the buffer is narrowed, this command uses the beginning and size
 of the accessible part of the buffer.
 Don't use this command in Lisp programs!
 \(goto-char (point-min)) is faster and avoids clobbering the mark."
+;; XEmacs change
 (interactive "_P")
 (push-mark)
 (let ((size (- (point-max) (point-min))))
 (goto-char (if arg
 		   (+ (point-min)
 If the buffer is narrowed, this command uses the beginning and size
 of the accessible part of the buffer.
 Don't use this command in Lisp programs!
 \(goto-char (point-max)) is faster and avoids clobbering the mark."
+;; XEmacs change
 (interactive "_P")
 (push-mark)
 ;; XEmacs changes here.
 (let ((scroll-to-end (not (pos-visible-in-window-p (point-max))))
 	(size (- (point-max) (point-min))))
 		 (point-max)))
 (cond (arg
 ;; If we went to a place in the middle of the buffer,
 ;; adjust it to the beginning of a line.
 (forward-line 1))
+	  ;; XEmacs change
 	  (scroll-to-end
 ;; If the end of the buffer is not already on the screen,
 ;; then scroll specially to put it near, but not at, the bottom.
 (recenter -3)))))
+;; XEmacs (not in FSF)
 (defun mark-beginning-of-buffer (&optional arg)
 "Push a mark at the beginning of the buffer; leave point where it is.
 With arg N, push mark N/10 of the way from the true beginning."
 (interactive "P")
 (push-mark (if arg
 	       (point-min))
 nil
 t))
 (define-function 'mark-bob 'mark-beginning-of-buffer)
+;; XEmacs (not in FSF)
 (defun mark-end-of-buffer (&optional arg)
 "Push a mark at the end of the buffer; leave point where it is.
 With arg N, push mark N/10 of the way from the true end."
 (interactive "P")
 (push-mark (if arg
 (interactive)
 (push-mark (point))
 (push-mark (point-max) nil t)
 (goto-char (point-min)))
+;; XEmacs
 (defun eval-current-buffer (&optional printflag)
 "Evaluate the current buffer as Lisp code.
 Programs can pass argument PRINTFLAG which controls printing of output:
 nil means discard it; anything else is stream for print."
 (interactive)
 (eval-buffer (current-buffer) printflag))
+;; XEmacs
 (defun count-words-buffer (b)
 (interactive "b")
 (save-excursion
 (let ((buf (or b (current-buffer))))
 (set-buffer buf)
 (message "Buffer has %d words"
 	       (count-words-region (point-min) (point-max))))))
+;; XEmacs
 (defun count-words-region (start end)
 (interactive "r")
 (save-excursion
 (let ((n 0))
 (goto-char start)
 (message "Region has %d words" n)
 n)))
 (defun count-lines-region (start end)
 "Print number of lines and characters in the region."
+;; XEmacs change
 (interactive "_r")
-(let ((n (count-lines start end)))
+(message "Region has %d lines, %d characters"
-(message "Region has %d lines, %d characters"
+	   (count-lines start end) (- end start)))
-	     n (- end start))
-n))
+;; XEmacs
 (defun count-lines-buffer (b)
 "Print number of lines and charcters in the specified buffer."
 (interactive "_b")
 (save-excursion
 (let ((buf (or b (current-buffer)))
 cnt)
 (set-buffer buf)
 (setq cnt (count-lines (point-min) (point-max)))
-(message "Region has %d lines, %d characters"
+(message "Buffer has %d lines, %d characters"
 cnt (- (point-max) (point-min)))
 cnt)))
 (defun what-line ()
 "Print the current buffer line number and narrowed line number of point."
+;; XEmacs change
 (interactive "_")
 (let ((opoint (point)) start)
 (save-excursion
 (save-restriction
 	(goto-char (point-min))
 		done)))
 	(- (buffer-size) (forward-line (buffer-size)))))))
 (defun what-cursor-position ()
 "Print info on cursor position (on screen and within buffer)."
+;; XEmacs change
 (interactive "_")
 (let* ((char (following-char))
 	 (beg (point-min))
 	 (end (point-max))
 (pos (point))
 	(if (or (/= beg 1) (/= end (1+ total)))
 	    (message "point=%d of %d(%d%%) <%d - %d>  column %d %s"
 		     pos total percent beg end col hscroll)
 	  (message "point=%d of %d(%d%%)  column %d %s"
 		   pos total percent col hscroll))
+;; XEmacs: don't use single-key-description
 (if (or (/= beg 1) (/= end (1+ total)))
 	  (message "Char: %s (0%o, %d, 0x%x)  point=%d of %d(%d%%) <%d - %d>  column %d %s"
 		   (text-char-description char) char char char pos total
 		   percent beg end col hscroll)
 	(message "Char: %s (0%o, %d, 0x%x)  point=%d of %d(%d%%)  column %d %s"
 "Major mode not specialized for anything in particular.
 Other major modes are defined by comparison with this one."
 (interactive)
 (kill-all-local-variables))
+;; XEmacs the following are declared elsewhere
+;(defvar read-expression-map (cons 'keymap minibuffer-local-map)
+;  "Minibuffer keymap used for reading Lisp expressions.")
+;(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
+;(put 'eval-expression 'disabled t)
+;(defvar read-expression-history nil)
 ;; We define this, rather than making `eval' interactive,
 ;; for the sake of completion of names like eval-region, eval-current-buffer.
 (defun eval-expression (expression)
 "Evaluate EXPRESSION and print value in minibuffer.
 Value is also consed on to front of the variable `values'."
-(interactive "xEval: ")
+;(interactive "xEval: ")
+(interactive
+(list (read-from-minibuffer "Eval: "
+			       nil read-expression-map t
+			       'read-expression-history)))
 (setq values (cons (eval expression) values))
 (prin1 (car values) t))
+;; XEmacs -- extra parameter (variant, but equivalent logic)
 (defun edit-and-eval-command (prompt command &optional history)
 "Prompting with PROMPT, let user edit COMMAND and eval result.
 COMMAND is a Lisp expression.  Let user edit that expression in
 the minibuffer, then read and evaluate the result."
 (let ((command (read-expression prompt
 If the command has been changed or is not the most recent previous command
 it is added to the front of the command history.
 You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
 to get different commands to edit and resubmit."
 (interactive "p")
+;; XEmacs: It looks like our version is better -sb
 (let ((print-level nil))
 (edit-and-eval-command "Redo: "
 			   (or (nth (1- arg) command-history)
 			       (error ""))
 			   (cons 'command-history arg))))
+;; XEmacs: Functions moved to minibuf.el
+;; previous-matching-history-element
+;; next-matching-history-element
+;; next-history-element
+;; previous-history-element
+;; next-complete-history-element
+;; previous-complete-history-element
 (defun goto-line (arg)
 "Goto line ARG, counting from line 1 at beginning of buffer."
 (interactive "NGoto line: ")
 (setq arg (prefix-numeric-value arg))
 (let ((modified (buffer-modified-p))
 	(recent-save (recent-auto-save-p)))
 (or (eq (selected-window) (minibuffer-window))
 	(message "Undo!"))
 (or (and (eq last-command 'undo)
-	     (eq (current-buffer) last-undo-buffer))
+	     (eq (current-buffer) last-undo-buffer)) ; XEmacs
 	(progn (undo-start)
 	       (undo-more 1)))
 (undo-more (or arg 1))
 ;; Don't specify a position in the undo record for the undo command.
 ;; Instead, undoing this should move point to where the change is.
 (setq this-command 'undo))
 (defvar pending-undo-list nil
 "Within a run of consecutive undo commands, list remaining to be undone.")
-(defvar last-undo-buffer nil)
+(defvar last-undo-buffer nil)	; XEmacs
 (defun undo-start ()
 "Set `pending-undo-list' to the front of the undo list.
 The next call to `undo-more' will undo the most recently made change."
 (if (eq buffer-undo-list t)
 Call `undo-start' to get ready to undo recent changes,
 then call `undo-more' one or more times to undo them."
 (or pending-undo-list
 (error "No further undo information"))
 (setq pending-undo-list (primitive-undo count pending-undo-list)
-	last-undo-buffer (current-buffer)))
+	last-undo-buffer (current-buffer)))	; XEmacs
+;; XEmacs
 (defun call-with-transparent-undo (fn &rest args)
 "Apply FN to ARGS, and then undo all changes made by FN to the current
 buffer.  The undo records are processed even if FN returns non-locally.
 There is no trace of the changes made by FN in the buffer's undo history.
 	    (let ((tail buffer-undo-list))
 	      (setq buffer-undo-list t)
 	      (while tail
 		(setq tail (primitive-undo (length tail) tail))))))))))
+;; XEmacs: The following are in other files
+;; shell-command-history
+;; shell-command-switch
+;; shell-command
+;; shell-command-sentinel
 (defconst universal-argument-map
 (let ((map (make-sparse-keymap)))
 (set-keymap-default-binding map 'universal-argument-other-key)
 ;FSFmacs (define-key map [switch-frame] nil)
+(define-key map [(t)] 'universal-argument-other-key)
+(define-key map [(meta t)] 'universal-argument-other-key)
 (define-key map [(control u)] 'universal-argument-more)
-(define-key map ?- 'universal-argument-minus)
+(define-key map [?-] 'universal-argument-minus)
-(define-key map ?0 'digit-argument)
+(define-key map [?0] 'digit-argument)
-(define-key map ?1 'digit-argument)
+(define-key map [?1] 'digit-argument)
-(define-key map ?2 'digit-argument)
+(define-key map [?2] 'digit-argument)
-(define-key map ?3 'digit-argument)
+(define-key map [?3] 'digit-argument)
-(define-key map ?4 'digit-argument)
+(define-key map [?4] 'digit-argument)
-(define-key map ?5 'digit-argument)
+(define-key map [?5] 'digit-argument)
-(define-key map ?6 'digit-argument)
+(define-key map [?6] 'digit-argument)
-(define-key map ?7 'digit-argument)
+(define-key map [?7] 'digit-argument)
-(define-key map ?8 'digit-argument)
+(define-key map [?8] 'digit-argument)
-(define-key map ?9 'digit-argument)
+(define-key map [?9] 'digit-argument)
 map)
 "Keymap used while processing \\[universal-argument].")
 (defvar universal-argument-num-events nil
 "Number of argument-specifying events read by `universal-argument'.
 \\[universal-argument] without digits or minus sign provides 4 as argument.
 Repeating \\[universal-argument] without digits or minus sign
 multiplies the argument by 4 each time."
 (interactive)
 (setq prefix-arg (list 4))
-(setq zmacs-region-stays t)
+(setq zmacs-region-stays t)	; XEmacs
 (setq universal-argument-num-events (length (this-command-keys)))
 (setq overriding-terminal-local-map universal-argument-map))
 ;; A subsequent C-u means to multiply the factor by 4 if we've typed
 ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
 (interactive "P")
 (if (consp arg)
 (setq prefix-arg (list (* 4 (car arg))))
 (setq prefix-arg arg)
 (setq overriding-terminal-local-map nil))
-(setq zmacs-region-stays t)
+(setq zmacs-region-stays t)	; XEmacs
 (setq universal-argument-num-events (length (this-command-keys))))
 (defun negative-argument (arg)
 "Begin a negative numeric argument for the next command.
 \\[universal-argument] following digits or minus sign ends the argument."
 	  (setq prefix-arg (- arg)))
 	 ((eq arg '-)
 	  (setq prefix-arg nil))
 	 (t
 	  (setq prefix-arg '-)))
-(setq zmacs-region-stays t)
+(setq zmacs-region-stays t)	; XEmacs
 (setq universal-argument-num-events (length (this-command-keys)))
 (setq overriding-terminal-local-map universal-argument-map))
+;; XEmacs:  This function not synched with FSF
 (defun digit-argument (arg)
 "Part of the numeric argument for the next command.
 \\[universal-argument] following digits or minus sign ends the argument."
 (interactive "P")
 (let* ((event last-command-event)
 ;; Anything else terminates the argument and is left in the queue to be
 ;; executed as a command.
 (defun universal-argument-other-key (arg)
 (interactive "P")
 (setq prefix-arg arg)
-(setq zmacs-region-stays t)
+(setq zmacs-region-stays t)	; XEmacs
 (let* ((key (this-command-keys))
 	 ;; FSF calls silly function `listify-key-sequence' here.
 	  (keylist (append key nil)))
 (setq unread-command-events
 	   (append (nthcdr universal-argument-num-events keylist)
 		   unread-command-events)))
 (reset-this-command-lengths)
 (setq overriding-terminal-local-map nil))
+;; XEmacs -- shouldn't these functions keep the zmacs region active?
 (defun forward-to-indentation (arg)
 "Move forward ARG lines and position at first nonblank character."
 (interactive "p")
 (forward-line arg)
 (skip-chars-forward " \t"))
 when given no argument at the beginning of a line."
 (interactive "*P")
 (kill-region (point)
 	       ;; Don't shift point before doing the delete; that way,
 	       ;; undo will record the right position of point.
+;; FSF
+;	       ;; It is better to move point to the other end of the kill
+;	       ;; before killing.  That way, in a read-only buffer, point
+;	       ;; moves across the text that is copied to the kill ring.
+;	       ;; The choice has no effect on undo now that undo records
+;	       ;; the value of point from before the command was run.
+;              (progn
 	       (save-excursion
 		 (if arg
 		     (forward-line (prefix-numeric-value arg))
 		   (if (eobp)
 		       (signal 'end-of-buffer nil))
 		   (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
 		       (forward-line 1)
 		     (end-of-line)))
 		 (point))))
+;; XEmacs
 (defun backward-kill-line nil
 "Kill back to the beginning of the line."
 (interactive)
 (let ((point (point)))
 (beginning-of-line nil)
 ;;;; The kill ring data structure.
 (defvar kill-ring nil
 "List of killed text sequences.
-In order to maintain correct interaction with cut-and-paste facilities
+Since the kill ring is supposed to interact nicely with cut-and-paste
-offered by window systems, the functions `kill-new', `kill-append', and
+facilities offered by window systems, use of this variable should
-`current-kill' should be used to access the kill ring, instead of using
+interact nicely with `interprogram-cut-function' and
-this variable directly.")
+`interprogram-paste-function'.  The functions `kill-new',
+`kill-append', and `current-kill' are supposed to implement this
-(defvar kill-ring-max 30
+interaction; you may want to use them instead of manipulating the kill
+ring directly.")
+(defconst kill-ring-max 30
 "*Maximum length of kill ring before oldest elements are thrown away.")
 (defvar kill-ring-yank-pointer nil
 "The tail of the kill ring whose car is the last thing yanked.")
 ;;;; Commands for manipulating the kill ring.
 ;;FSFmacs
 ;(defvar kill-read-only-ok nil
 ;  "*Non-nil means don't signal an error for killing read-only text.")
+;(put 'text-read-only 'error-conditions
+;     '(text-read-only buffer-read-only error))
+;(put 'text-read-only 'error-message "Text is read-only")
 (defun kill-region (beg end &optional verbose) ; verbose is XEmacs addition
 "Kill between point and mark.
 The text is deleted but saved in the kill ring.
 The command \\[yank] can retrieve it from there.
 		  (message "Killing %d characters"
 		       (- (max beg end) (min beg end)))))
 (cond
 ;; I don't like this large change in behavior -- jwz
+;; Read-Only text means it shouldn't be deleted, so I'm restoring
+;; this code, but only for text-properties and not full extents. -sb
 ;; If the buffer is read-only, we should beep, in case the person
 ;; just isn't aware of this.  However, there's no harm in putting
 ;; the region's text in the kill ring, anyway.
-;;((or (and buffer-read-only (not inhibit-read-only))
+((or (and buffer-read-only (not inhibit-read-only))
-;;	  (text-property-not-all beg end 'read-only nil))
+	(text-property-not-all beg end 'read-only nil))
+;; This is redundant.
 ;; (if verbose (message "Copying %d characters"
-;;		      (- (max beg end) (min beg end))))
+;;			 (- (max beg end) (min beg end))))
-;; (copy-region-as-kill beg end)
+(copy-region-as-kill beg end)
 ;; ;; This should always barf, and give us the correct error.
 ;; (if kill-read-only-ok
 ;;	  (message "Read only text copied to kill ring")
-;;	(setq this-command 'kill-region)
+(setq this-command 'kill-region)
-;;	(barf-if-buffer-read-only)))
+(barf-if-buffer-read-only)
+(signal 'text-read-only (list (current-buffer))))
 ;; In certain cases, we can arrange for the undo list and the kill
 ;; ring to share the same string object.  This code does that.
 ((not (or (eq buffer-undo-list t)
 	     (eq last-command 'kill-region)
 	     ;; Use = since positions may be numbers or markers.
 	     (= beg end)))
 ;; Don't let the undo list be truncated before we can even access it.
+;; FSF calls this `undo-strong-limit'
 (let ((undo-high-threshold (+ (- (max beg end) (min beg end)) 100))
 	  ;(old-list buffer-undo-list)
 	  tail)
 (delete-region beg end)
 ;; Search back in buffer-undo-list for this string,
 ;; in case a change hook made property changes.
 (setq tail buffer-undo-list)
-(while (not (stringp (car-safe (car-safe tail))))
+(while (not (stringp (car-safe (car-safe tail)))) ; XEmacs
 	(setq tail (cdr tail)))
 ;; Take the same string recorded for undo
 ;; and put it in the kill-ring.
 (kill-new (car (car tail)))))
 	    ;; Inhibit quitting so we can make a quit here
 	    ;; look like a C-g typed as a command.
 	    (inhibit-quit t))
 	(if (pos-visible-in-window-p other-end (selected-window))
 	    (progn
+	      ;; FSF (I'm not sure what this does -sb)
+;	      ;; Swap point and mark.
+;	      (set-marker (mark-marker) (point) (current-buffer))
 	      (goto-char other-end)
 (sit-for 1)
+;	      ;; Swap back.
+;	      (set-marker (mark-marker) other-end (current-buffer))
 (goto-char opoint)
 ;; If user quit, deactivate the mark
 	      ;; as C-g would as a command.
 	      (and quit-flag (mark)
 (zmacs-deactivate-region)))
 ;		      (substring killed-text 0 message-len))))
 	  ))))
 (defun append-next-kill ()
 "Cause following command, if it kills, to append to previous kill."
+;; XEmacs
 (interactive "_")
 (if (interactive-p)
 (progn
 	(setq this-command 'kill-region)
 	(message "If the next command is a kill, it will append"))
 comes the newest one."
 (interactive "*p")
 (if (not (eq last-command 'yank))
 (error "Previous command was not a yank"))
 (setq this-command 'yank)
-(let ((before (< (point) (mark t))))
+(let ((inhibit-read-only t)
+	(before (< (point) (mark t))))
 (delete-region (point) (mark t))
+;;(set-marker (mark-marker) (point) (current-buffer))
 (set-mark (point))
 (insert (current-kill arg))
-(if before (exchange-point-and-mark t))))
+(if before
+	;; This is like exchange-point-and-mark, but doesn't activate the mark.
+	;; It is cleaner to avoid activation, even though the command
+	;; loop would deactivate the mark because we inserted text.
+	(goto-char (prog1 (mark t)
+		     (set-marker (mark-marker) (point) (current-buffer))))))
+nil)
 (defun yank (&optional arg)
 "Reinsert the last stretch of killed text.
 More precisely, reinsert the stretch of killed text most recently
 killed OR yanked.  Put point at end, and set mark at beginning.
 With just C-u as argument, same but put point at beginning (and mark at end).
-With argument N, reinsert the Nth most recently killed stretch of killed text.
+With argument N, reinsert the Nth most recently killed stretch of killed
+text.
 See also the command \\[yank-pop]."
 (interactive "*P")
 ;; If we don't get all the way through, make last-command indicate that
 ;; for the following command.
 (setq this-command t)
 (insert (current-kill (cond
 			 ((listp arg) 0)
 			 ((eq arg '-) -1)
 			 (t (1- arg)))))
 (if (consp arg)
-(exchange-point-and-mark t))
+;; This is like exchange-point-and-mark, but doesn't activate the mark.
-;; If we do get all the way through, make this-command indicate that.
+;; It is cleaner to avoid activation, even though the command
-(setq this-command 'yank))
+;; loop would deactivate the mark because we inserted text.
+(goto-char (prog1 (mark t)
+		   (set-marker (mark-marker) (point) (current-buffer)))))
+;; If we do get all the way thru, make this-command indicate that.
+(setq this-command 'yank)
+nil)
 (defun rotate-yank-pointer (arg)
 "Rotate the yanking point in the kill ring.
 With argument, rotate that many kills forward (or backward, if negative)."
 (interactive "p")
 (defun insert-buffer (buffer)
 "Insert after point the contents of BUFFER.
 Puts mark after the inserted text.
 BUFFER may be a buffer or a buffer name."
-(interactive (list (progn (barf-if-buffer-read-only)
+(interactive
-			    (read-buffer "Insert buffer: "
+(list
-					 ;; XEmacs: we have different args
+(progn
-					 (other-buffer (current-buffer) nil t)
+(barf-if-buffer-read-only)
-					 t))))
+(read-buffer "Insert buffer: "
+		   ;; XEmacs: we have different args
+		   (other-buffer (current-buffer) nil t)
+		   t))))
 (or (bufferp buffer)
 (setq buffer (get-buffer buffer)))
 (let (start end newmark)
 (save-excursion
 (save-excursion
 (erase-buffer)
 (save-excursion
 	(insert-buffer-substring oldbuf start end)))))
 ;FSFmacs
-;(define-error 'mark-inactive "The mark is not active now")
+;(put 'mark-inactive 'error-conditions '(mark-inactive error))
+;(put 'mark-inactive 'error-message "The mark is not active now")
 (defun mark (&optional force buffer)
 "Return this buffer's mark value as integer, or nil if no mark.
 If `zmacs-regions' is true, then this returns nil unless the region is
 (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
 (setq buffer (decode-buffer buffer))
 (set-marker (mark-marker t buffer) pos buffer))
+;; FSF
+;  (if pos
+;     (progn
+;	(setq mark-active t)
+;	(run-hooks 'activate-mark-hook)
+;	(set-marker (mark-marker) pos (current-buffer)))
+;    ;; Normally we never clear mark-active except in Transient Mark mode.
+;    ;; But when we actually clear out the mark value too,
+;    ;; we must clear mark-active in any mode.
+;    (setq mark-active nil)
+;    (run-hooks 'deactivate-mark-hook)
+;    (set-marker (mark-marker) nil)))
 (defvar mark-ring nil
 "The list of former marks of the current buffer, most recent first.")
 (make-variable-buffer-local 'mark-ring)
 (put 'mark-ring 'permanent-local t)
-(defvar mark-ring-max 16
+(defconst mark-ring-max 16
 "*Maximum size of mark ring.  Start discarding off end if gets this big.")
 (defvar global-mark-ring nil
 "The list of saved global marks, most recent first.")
 "*Maximum size of global mark ring.  \
 Start discarding off end if gets this big.")
 (defun set-mark-command (arg)
 "Set mark at where point is, or jump to mark.
-With no prefix argument, set mark,  push old mark position on local mark
+With no prefix argument, set mark, push old mark position on local mark
 ring, and push mark on global mark ring.
 With argument, jump to mark, and pop a new position for mark off the ring
 \(does not affect global mark ring\).
 Novice Emacs Lisp programmers often try to use the mark for the wrong
 (if (null (mark t))
 	(error "No mark set in this buffer")
 (goto-char (mark t))
 (pop-mark))))
+;; XEmacs: Extra parameter
 (defun push-mark (&optional location nomsg activate-region buffer)
 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
 If the last global mark pushed was not in the current buffer,
 also push LOCATION on the global mark ring.
 Display `Mark set' unless the optional second arg NOMSG is non-nil.
 Activate mark if optional third arg ACTIVATE-REGION non-nil.
 Novice Emacs Lisp programmers often try to use the mark for the wrong
 purposes.  See the documentation of `set-mark' for more information."
-(setq buffer (decode-buffer buffer))
+(setq buffer (decode-buffer buffer)) ; XEmacs
-(if (null (mark t buffer))
+(if (null (mark t buffer)) ; XEmacs
 nil
 ;; The save-excursion / set-buffer is necessary because mark-ring
 ;; is a buffer local variable
 (save-excursion
 (set-buffer buffer)
 (if (> (length mark-ring) mark-ring-max)
 	  (progn
 	    (move-marker (car (nthcdr mark-ring-max mark-ring)) nil buffer)
 	    (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))))
 (set-mark (or location (point buffer)) buffer)
+; (set-marker (mark-marker) (or location (point)) (current-buffer)) ; FSF
 ;; Now push the mark on the global mark ring.
 (if (or (null global-mark-ring)
 (not (eq (marker-buffer (car global-mark-ring)) buffer)))
 ;; The last global mark pushed wasn't in this same buffer.
 (progn
 (message "Mark set"))
 (if activate-region
 (progn
 	(setq zmacs-region-stays t)
 	(zmacs-activate-region)))
+; (if (or activate (not transient-mark-mode)) ; FSF
+;     (set-mark (mark t))) ; FSF
 nil)
 (defun pop-mark ()
 "Pop off mark ring into the buffer's actual mark.
 Does not set point.  Does nothing if mark ring is empty."
 (let ((omark (mark t)))
 (if (null omark)
 	(error "No mark set in this buffer"))
 (set-mark (point))
 (goto-char omark)
-(or dont-activate-region (zmacs-activate-region))
+(or dont-activate-region (zmacs-activate-region)) ; XEmacs
 nil))
+;; XEmacs
 (defun mark-something (mark-fn movement-fn arg)
 "internal function used by mark-sexp, mark-word, etc."
 (let (newmark (pushp t))
 (save-excursion
 (if (and (eq last-command mark-fn) (mark))
 in `goal-column', which is nil when there is none.
 If you are thinking of using this in a Lisp program, consider
 using `forward-line' instead.  It is usually easier to use
 and more reliable (no dependence on goal column, etc.)."
-(interactive "_p")
+(interactive "_p") ; XEmacs
 (if (and next-line-add-newlines (= arg 1))
 (let ((opoint (point)))
 	(end-of-line)
 	(if (eobp)
 	    (newline 1)
 Then it does not try to move vertically.
 If you are thinking of using this in a Lisp program, consider using
 `forward-line' with a negative argument instead.  It is usually easier
 to use and more reliable (no dependence on goal column, etc.)."
-(interactive "_p")
+(interactive "_p") ; XEmacs
 (if (interactive-p)
 (condition-case nil
 	  (line-move (- arg))
 	((beginning-of-buffer end-of-buffer) (ding nil 'buffer-bound)))
 (line-move (- arg)))
 nil)
-(defvar track-eol nil
+(defconst track-eol nil
 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
 This means moving to the end of each line moved onto.
 The beginning of a blank line does not count as the end of a line.")
 (defvar goal-column nil
 				prop
 			      (or (memq prop buffer-invisibility-spec)
 				  (assq prop buffer-invisibility-spec)))))
 		(if (get-text-property (point) 'invisible)
 		    (goto-char (next-single-property-change (point) 'invisible))
-		  (goto-char (next-extent-change (point)))))
+		  (goto-char (next-extent-change (point))))) ; XEmacs
 	      (setq arg (1- arg)))
 	    (while (< arg 0)
 	      (beginning-of-line)
 	      (and (zerop (vertical-motion -1))
 		   (signal 'beginning-of-buffer nil))
 				prop
 			      (or (memq prop buffer-invisibility-spec)
 				  (assq prop buffer-invisibility-spec)))))
 		(if (get-text-property (1- (point)) 'invisible)
 		    (goto-char (previous-single-property-change (point) 'invisible))
-		  (goto-char (previous-extent-change (point)))))
+		  (goto-char (previous-extent-change (point))))) ; XEmacs
 	      (setq arg (1+ arg))))
 	  (move-to-column (or goal-column temporary-goal-column)))
 ;; Remember where we moved to, go back home,
 ;; then do the motion over again
 ;; in just one step, with intangibility and point-motion hooks
 Those commands will move to this position in the line moved to
 rather than trying to keep the same horizontal position.
 With a non-nil argument, clears out the goal column
 so that \\[next-line] and \\[previous-line] resume vertical motion.
 The goal column is stored in the variable `goal-column'."
-(interactive "_P")
+(interactive "_P") ; XEmacs
 (if arg
 (progn
 (setq goal-column nil)
 (message "No goal column"))
 (setq goal-column (current-column))
 (message (substitute-command-keys
 	      "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
 	     goal-column))
 nil)
+;; deleted FSFmacs terminal randomness hscroll-point-visible stuff.
-;;; deleted FSFmacs terminal randomness hscroll-point-visible stuff.
+;; hscroll-step
+;; hscroll-point-visible
+;; hscroll-window-column
+;; right-arrow
+;; left-arrow
 (defun scroll-other-window-down (lines)
 "Scroll the \"other window\" down.
 For more details, see the documentation for `scroll-other-window'."
 (interactive "P")
 ;; Just invert the argument's meaning.
 ;; We can do that without knowing which window it will be.
 (if (eq lines '-) nil
 (if (null lines) '-
 (- (prefix-numeric-value lines))))))
+;(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
 (defun beginning-of-buffer-other-window (arg)
 "Move point to the beginning of the buffer in the other window.
 Leave mark at previous position.
 With arg N, put point N/10 of the way from the true beginning."
 	  (save-excursion
 	    (funcall mover 1)
 	    (setq end2 (point))
 	    (funcall mover -1)
 	    (setq start2 (point))
-	    (goto-char (mark t))
+	    (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)))
+	  (exchange-point-and-mark t))) ; XEmacs
 (while (> arg 0)
 (funcall mover -1)
 (setq start1 (point))
 (funcall mover 1)
 (setq end1 (point))
 (goto-char (if (< start1 start2) start1
 		 (+ start1 (- (length word1) (length word2)))))
 (delete-char (length word1))
 (insert word2)))
-(defvar comment-column 32
+(defconst comment-column 32
 "*Column to indent right-margin comments to.
 Setting this variable automatically makes it local to the current buffer.
 Each mode establishes a different default value for this variable; you
 can set the value for a particular mode using that mode's hook.")
 (make-variable-buffer-local 'comment-column)
-(defvar comment-start nil
+(defconst comment-start nil
 "*String to insert to start a new comment, or nil if no comment syntax.")
-(defvar comment-start-skip nil
+(defconst comment-start-skip nil
 "*Regexp to match the start of a comment plus everything up to its body.
 If there are any \\(...\\) pairs, the comment delimiter text is held to begin
 at the place matched by the close of the first pair.")
-(defvar comment-end ""
+(defconst comment-end ""
 "*String to insert to end a new comment.
 Should be an empty string if comments are terminated by end-of-line.")
 (defconst comment-indent-hook nil
 "Obsolete variable for function to compute desired indentation for a comment.
 Use `comment-indent-function' instead.
 This function is called with no args with point at the beginning of
 the comment's starting delimiter.")
-(defvar comment-indent-function
+(defconst comment-indent-function
 ;; XEmacs - add at least one space after the end of the text on the
 ;; current line...
 #'(lambda ()
 (save-excursion
 	(beginning-of-line)
 (if (string= "" ce) ()
 (end-of-line)
 (insert ce)))
 (search-forward "\n" nil 'move)))))))
+;; XEmacs
 (defun prefix-region (prefix)
 "Add a prefix string to each line between mark and point."
 (interactive "sPrefix string: ")
 (if prefix
 (let ((count (count-lines (mark) (point))))
 	  (insert prefix)
 	  (end-of-line 1)
 	  (forward-char 1)))))
+;; XEmacs - extra parameter
 (defun backward-word (arg &optional buffer)
 "Move backward until encountering the end of a word.
 With argument, do this that many times.
 In programs, it is faster to call `forward-word' with negative arg."
-(interactive "_p")
+(interactive "_p") ; XEmacs
 (forward-word (- arg) buffer))
 (defun mark-word (arg)
 "Set mark arg words away from point."
 (interactive "p")
 (mark-something 'mark-word 'forward-word arg))
+;; XEmacs modified
 (defun kill-word (arg)
 "Kill characters forward until encountering the end of a word.
 With argument, do this that many times."
 (interactive "*p")
 (kill-region (point) (save-excursion (forward-word arg) (point))))
 (defun backward-kill-word (arg)
 "Kill characters backward until encountering the end of a word.
 With argument, do this that many times."
-(interactive "*p")
+(interactive "*p") ; XEmacs
 (kill-word (- arg)))
 (defun current-word (&optional strict)
 "Return the word point is on (or a nearby word) as a string.
 If optional arg STRICT is non-nil, return nil unless point is within
 (skip-syntax-backward "w_")
 (setq start (point)))
 		 (buffer-substring start end)))
 (buffer-substring start end)))))
-(defvar fill-prefix nil
+(defconst fill-prefix nil
 "*String for filling to insert at front of new line, or nil for none.
 Setting this variable automatically makes it local to the current buffer.")
 (make-variable-buffer-local 'fill-prefix)
-(defvar auto-fill-inhibit-regexp nil
+(defconst auto-fill-inhibit-regexp nil
 "*Regexp to match lines which should not be auto-filled.")
+;; This function is the auto-fill-function of a buffer
+;; when Auto-Fill mode is enabled.
+;; It returns t if it really did any work.
+;; XEmacs:  This function is totally different.
 (defun do-auto-fill ()
 (let (give-up)
 (or (and auto-fill-inhibit-regexp
 	     (save-excursion (beginning-of-line)
 			     (looking-at auto-fill-inhibit-regexp)))
 		  (if (>= (current-column) prev-column)
 		      (setq give-up t)))
 	      ;; No place to break => stop trying.
 	      (setq give-up t)))))))
+;; Put FSF one in until I can one or the other working properly, then the
+;; other one is history.
+(defun fsf:do-auto-fill ()
+(let (fc justify bol give-up
+	   (fill-prefix fill-prefix))
+(if (or (not (setq justify (current-justification)))
+	    (null (setq fc (current-fill-column)))
+	    (and (eq justify 'left)
+		 (<= (current-column) fc))
+	    (save-excursion (beginning-of-line)
+			    (setq bol (point))
+			    (and auto-fill-inhibit-regexp
+				 (looking-at auto-fill-inhibit-regexp))))
+	nil ;; Auto-filling not required
+(if (memq justify '(full center right))
+	  (save-excursion (unjustify-current-line)))
+;; Choose a fill-prefix automatically.
+(if (and adaptive-fill-mode
+	       (or (null fill-prefix) (string= fill-prefix "")))
+	  (let ((prefix
+		 (fill-context-prefix
+		  (save-excursion (backward-paragraph 1) (point))
+		  (save-excursion (forward-paragraph 1) (point))
+		  ;; Don't accept a non-whitespace fill prefix
+		  ;; from the first line of a paragraph.
+		  "^[ \t]*$")))
+	    (and prefix (not (equal prefix ""))
+		 (setq fill-prefix prefix))))
+(while (and (not give-up) (> (current-column) fc))
+	;; Determine where to split the line.
+	(let ((fill-point
+	       (let ((opoint (point))
+		     bounce
+		     (first t))
+		 (save-excursion
+		   (move-to-column (1+ fc))
+		   ;; Move back to a word boundary.
+		   (while (or first
+			      ;; If this is after period and a single space,
+			      ;; move back once more--we don't want to break
+			      ;; the line there and make it look like a
+			      ;; sentence end.
+			      (and (not (bobp))
+				   (not bounce)
+				   sentence-end-double-space
+				   (save-excursion (forward-char -1)
+						   (and (looking-at "\\. ")
+							(not (looking-at "\\.  "))))))
+		     (setq first nil)
+		     (skip-chars-backward "^ \t\n")
+		     ;; If we find nowhere on the line to break it,
+		     ;; break after one word.  Set bounce to t
+		     ;; so we will not keep going in this while loop.
+		     (if (bolp)
+			 (progn
+			   (re-search-forward "[ \t]" opoint t)
+			   (setq bounce t)))
+		     (skip-chars-backward " \t"))
+		   ;; Let fill-point be set to the place where we end up.
+		   (point)))))
+	  ;; If that place is not the beginning of the line,
+	  ;; break the line there.
+	  (if (save-excursion
+		(goto-char fill-point)
+		(not (bolp)))
+	      (let ((prev-column (current-column)))
+		;; If point is at the fill-point, do not `save-excursion'.
+		;; Otherwise, if a comment prefix or fill-prefix is inserted,
+		;; point will end up before it rather than after it.
+		(if (save-excursion
+		      (skip-chars-backward " \t")
+		      (= (point) fill-point))
+		    (indent-new-comment-line t)
+		  (save-excursion
+		    (goto-char fill-point)
+		    (indent-new-comment-line t)))
+		;; Now do justification, if required
+		(if (not (eq justify 'left))
+		    (save-excursion
+		      (end-of-line 0)
+		      (justify-current-line justify nil t)))
+		;; If making the new line didn't reduce the hpos of
+		;; the end of the line, then give up now;
+		;; trying again will not help.
+		(if (>= (current-column) prev-column)
+		    (setq give-up t)))
+	    ;; No place to break => stop trying.
+	    (setq give-up t))))
+;; Justify last line.
+(justify-current-line justify t t)
+t)))
+(defvar normal-auto-fill-function 'do-auto-fill
+"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
+Some major modes set this.")
+(defun auto-fill-mode (&optional arg)
+"Toggle auto-fill mode.
+With arg, turn auto-fill mode on if and only if arg is positive.
+In Auto-Fill mode, inserting a space at a column beyond `current-fill-column'
+automatically breaks the line at a previous space.
+The value of `normal-auto-fill-function' specifies the function to use
+for `auto-fill-function' when turning Auto Fill mode on."
+(interactive "P")
+(prog1 (setq auto-fill-function
+	       (if (if (null arg)
+		       (not auto-fill-function)
+		       (> (prefix-numeric-value arg) 0))
+		   normal-auto-fill-function
+		   nil))
+(redraw-modeline)))
+;; This holds a document string used to document auto-fill-mode.
+(defun auto-fill-function ()
+"Automatically break line at a previous space, in insertion of text."
+nil)
+(defun turn-on-auto-fill ()
+"Unconditionally turn on Auto Fill mode."
+(auto-fill-mode 1))
+(defun set-fill-column (arg)
+"Set `fill-column' to current column, or to argument if given.
+The variable `fill-column' has a separate value for each buffer."
+(interactive "_P") ; XEmacs
+(cond ((integerp arg)
+	 (setq fill-column arg))
+	((consp arg)
+	 (setq fill-column (current-column)))
+	;; Disallow missing argument; it's probably a typo for C-x C-f.
+	(t
+	 (error "set-fill-column requires an explicit argument")))
+(message "fill-column set to %d" fill-column))
 (defvar comment-multi-line t ; XEmacs - this works well with adaptive fill
 "*Non-nil means \\[indent-new-comment-line] should continue same comment
 on new line, with no new terminator or starter.
 This is obsolete because you might as well use \\[newline-and-indent].")
 	      ;; Make sure we delete the newline inserted above.
 	      (end-of-line)
 	      (delete-char 1)))
 	(indent-according-to-mode)))))
-(defun auto-fill-mode (&optional arg)
-"Toggle auto-fill mode.
-With arg, turn auto-fill mode on if and only if arg is positive.
-In Auto-Fill mode, inserting a space at a column beyond `current-fill-column'
-automatically breaks the line at a previous space."
-(interactive "P")
-(prog1 (setq auto-fill-function
-	       (if (if (null arg)
-		       (not auto-fill-function)
-		       (> (prefix-numeric-value arg) 0))
-		   'do-auto-fill
-		   nil))
-(redraw-modeline)))
-;; This holds a document string used to document auto-fill-mode.
-(defun auto-fill-function ()
-"Automatically break line at a previous space, in insertion of text."
-nil)
-(defun turn-on-auto-fill ()
-"Unconditionally turn on Auto Fill mode."
-(auto-fill-mode 1))
-(defun set-fill-column (arg)
-"Set `fill-column' to current column, or to argument if given.
-The variable `fill-column' has a separate value for each buffer."
-(interactive "_P")
-(setq fill-column (if (integerp arg) arg (current-column)))
-(message "fill-column set to %d" fill-column))
 (defun set-selective-display (arg)
 "Set `selective-display' to ARG; clear it if no arg.
 When the value of `selective-display' is a number > 0,
 lines whose indentation is >= that value are not displayed.
 ;; #### doesn't localize properly:
 (princ "selective-display set to " t)
 (prin1 selective-display t)
 (princ "." t))
+;; XEmacs
 (defun nuke-selective-display ()
 "Ensure that the buffer is not in selective-display mode.
 If `selective-display' is t, then restore the buffer text to it's original
 state before disabling selective display."
 ;; by Stig@hackvan.com
 	     ))))
 (setq selective-display nil))
 (add-hook 'change-major-mode-hook 'nuke-selective-display)
-(defvar overwrite-mode-textual (purecopy " Ovwrt")
+(defconst overwrite-mode-textual (purecopy " Ovwrt")
-"The string displayed in the modeline when in overwrite mode.")
+"The string displayed in the mode line when in overwrite mode.")
-(defvar overwrite-mode-binary (purecopy " Bin Ovwrt")
+(defconst overwrite-mode-binary (purecopy " Bin Ovwrt")
-"The string displayed in the modeline when in binary overwrite mode.")
+"The string displayed in the mode line when in binary overwrite mode.")
 (defun overwrite-mode (arg)
 "Toggle overwrite mode.
 With arg, turn overwrite mode on iff arg is positive.
 In overwrite mode, printing characters typed in replace existing text
 (defun line-number-mode (arg)
 "Toggle Line Number mode.
 With arg, turn Line Number mode on iff arg is positive.
 When Line Number mode is enabled, the line number appears
-in the modeline."
+in the mode line."
 (interactive "P")
 (setq line-number-mode
 	(if (null arg) (not line-number-mode)
 	  (> (prefix-numeric-value arg) 0)))
 (redraw-modeline))
 (defvar column-number-mode nil
-"*Non-nil means display column number in modeline.")
+"*Non-nil means display column number in mode line.")
 (defun column-number-mode (arg)
 "Toggle Column Number mode.
 With arg, turn Column Number mode on iff arg is positive.
 When Column Number mode is enabled, the column number appears
-in the modeline."
+in the mode line."
 (interactive "P")
 (setq column-number-mode
 	(if (null arg) (not column-number-mode)
 	  (> (prefix-numeric-value arg) 0)))
 (redraw-modeline))
 (defvar blink-matching-paren t
 "*Non-nil means show matching open-paren when close-paren is inserted.")
-(defvar blink-matching-paren-distance 12000
+(defvar blink-matching-paren-on-screen t
+"*Non-nil means show matching open-paren when it is on screen.
+nil means don't show it (but the open-paren can still be shown
+when it is off screen.")
+(defconst blink-matching-paren-distance 12000
 "*If non-nil, is maximum distance to search for matching open-paren.")
 (defconst blink-matching-delay 1
 "*The number of seconds that `blink-matching-open' will delay at a match.")
 (defconst blink-matching-paren-dont-ignore-comments nil
 "*Non-nil means `blink-matching-paren' should not ignore comments.")
 (defun blink-matching-open ()
 "Move cursor momentarily to the beginning of the sexp before point."
-(interactive "_")
+(interactive "_") ; XEmacs
 (and (> (point) (1+ (point-min)))
 blink-matching-paren
 ;; Verify an even number of quoting characters precede the close.
 (= 1 (logand 1 (- (point)
 			 (save-excursion
 	   (if mismatch (setq blinkpos nil))
 	   (if blinkpos
 	       (progn
 		(goto-char blinkpos)
 		(if (pos-visible-in-window-p)
-		    (sit-for blink-matching-delay)
+		    (and blink-matching-paren-on-screen
+			 (sit-for blink-matching-delay))
 		  (goto-char blinkpos)
 		  (message
 		   "Matches %s"
 		   ;; Show what precedes the open in its line, if anything.
 		   (if (save-excursion
 		     ;; Show what follows the open in its line, if anything.
 		     (if (save-excursion
 			   (forward-char 1)
 			   (skip-chars-forward " \t")
 			   (not (eolp)))
-(buffer-substring blinkpos
+			 (buffer-substring blinkpos
-(progn (end-of-line) (point)))
+					   (progn (end-of-line) (point)))
 		       ;; Otherwise show the previous nonblank line,
 		       ;; if there is one.
 		       (if (save-excursion
 			     (skip-chars-backward "\n \t")
 			     (not (bobp)))
 ;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
+;; buffer-quit-function
+;; keyboard-escape-quit
 (defun set-variable (var val)
 "Set VARIABLE to VALUE.  VALUE is a Lisp object.
 When using this interactively, supply a Lisp expression for VALUE.
 If you want VALUE to be a string, you must surround it with doublequotes.
 					   (list 'interactive prop)
 					   'arg))
 	       (eval-minibuffer (format "Set %s to value: " var)))))))
 (set var val))
+;; XEmacs
 (defun activate-region ()
 "Activate the region, if `zmacs-regions' is true.
 Setting `zmacs-regions' to true causes LISPM-style active regions to be used.
 This function has no effect if `zmacs-regions' is false."
 (interactive)
 (and zmacs-regions (zmacs-activate-region)))
+;; XEmacs
 (defsubst region-exists-p ()
 "Non-nil iff the region exists.
 If active regions are in use (i.e. `zmacs-regions' is true), this means that
 the region is active.  Otherwise, this means that the user has pushed
 a mark in this buffer at some point in the past.
 The functions `region-beginning' and `region-end' can be used to find the
 limits of the region."
 (not (null (mark))))
+;; XEmacs
 (defun region-active-p ()
 "Non-nil iff the region is active.
 If `zmacs-regions' is true, this is equivalent to `region-exists-p'.
 Otherwise, this function always returns false."
 (and zmacs-regions zmacs-region-extent))
+;; A bunch of stuff was moved elsewhere:
+;; completion-list-mode-map
+;; completion-reference-buffer
+;; completion-base-size
+;; delete-completion-window
+;; previous-completion
+;; next-completion
+;; choose-completion
+;; choose-completion-delete-max-match
+;; choose-completion-string
+;; completion-list-mode
+;; completion-fixup-function
+;; completion-setup-function
+;; switch-to-completions
+;; event stuffs
+;; keypad stuffs
+;; The rest of this file is not in Lisp in FSF
 (defun capitalize-region-or-word (arg)
 "Capitalize the selected region or the following word (or ARG words)."
 (interactive "p")
 (if (region-active-p) (capitalize-region (region-beginning) (region-end))
 (capitalize-word arg)))
 ;;; Bits of the logging code are borrowed from log-messages.el by
 ;;; Robert Potter (rpotter@grip.cis.upenn.edu).
 ;; need this to terminate the currently-displayed message
 ;; ("Loading simple ...")
-(or (fboundp 'display-message) (send-string-to-terminal "\n"))
+(when (and
+(not (fboundp 'display-message))
+(not (featurep 'debug)))
+(send-string-to-terminal "\n"))
 (defvar message-stack nil
 "An alist of label/string pairs representing active echo-area messages.
 The first element in the list is currently displayed in the echo area.
 Do not modify this directly--use the `message' or
 If a message remains at the head of the message-stack and NO-RESTORE
 is nil, it will be displayed.  The string which remains in the echo
 area will be returned, or nil if the message-stack is now empty.
 If LABEL is nil, the entire message-stack is cleared.
-Unless you need the return value or you need to specify a lable,
+Unless you need the return value or you need to specify a label,
 you should just use (message nil)."
 (or frame (setq frame (selected-frame)))
 (let ((clear-stream (and message-stack (eq 'stream (frame-type frame)))))
 (remove-message label frame)
 (let ((buffer (get-buffer " *Echo Area*"))
 	(progn
 	  (setq warning-marker (make-marker))
 	  (set-marker warning-marker 1 buffer)))
 (set-window-start (display-buffer buffer) warning-marker)
 (set-marker warning-marker (point-max buffer) buffer)))
+;;; simple.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/prim/simple.el @ 4:b82b59fe008d r19-15b3