simple.el

A framework written in Java for implementing high-level and dynamic languages, compiling them into J

\\[universal-argument] following digits or minus sign ends the argument."
  (interactive "_P")			; XEmacs
  (let* ((event last-command-event)
	 (key (and (key-press-event-p event)
		   (event-key event)))
	 (digit (and key (characterp key) (>= key ?0) (<= key ?9)
		     (- key ?0))))
    (if (null digit)
	(universal-argument-other-key arg)
      (cond ((integerp arg)
	     (setq prefix-arg (+ (* arg 10)
				 (if (< arg 0) (- digit) digit))))
	    ((eq arg '-)
	     ;; Treat -0 as just -, so that -01 will work.
	     (setq prefix-arg (if (zerop digit) '- (- digit))))
	    (t
	     (setq prefix-arg digit)))
      (setq universal-argument-num-events (length (this-command-keys)))
      (setq overriding-terminal-local-map universal-argument-map))))

;; For backward compatibility, minus with no modifiers is an ordinary
;; command if digits have already been entered.
(defun universal-argument-minus (arg)
  (interactive "_P") ; XEmacs
  (if (integerp arg)
      (universal-argument-other-key arg)
    (negative-argument arg)))

;; 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")			; XEmacs
  (setq prefix-arg arg)
  (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 -- keep 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"))

(defun backward-to-indentation (arg)
  "Move backward ARG lines and position at first nonblank character."
  (interactive "_p")
  (forward-line (- arg))
  (skip-chars-forward " \t"))

(defcustom kill-whole-line nil
  "*Control when and whether `kill-line' removes entire lines.
Note: This only applies when `kill-line' is called interactively;
otherwise, it behaves \"historically\".

If `always', `kill-line' with no arg always kills the whole line,
wherever point is in the line. (If you want to just kill to the end
of the line, use \\[historical-kill-line].)

If not `always' but non-nil, `kill-line' with no arg kills the whole
line if point is at the beginning, and otherwise behaves historically.

If nil, `kill-line' behaves historically."
  :type '(radio (const :tag "Kill to end of line" nil)
		(const :tag "Kill whole line" always)
		(const
		 :tag "Kill whole line at beginning, otherwise end of line" t))
  :group 'killing)

(defun historical-kill-line (&optional arg)
  "Same as `kill-line' but ignores value of `kill-whole-line'."
  (interactive "*P")
  (let ((kill-whole-line nil))
    (if (interactive-p)
	(call-interactively 'kill-line)
      (kill-line arg))))

(defun kill-line (&optional arg)
  "Kill the rest of the current line, or the entire line.
If no nonblanks there, kill thru newline.
If called interactively, may kill the entire line; see `kill-whole-line'.
when given no argument at the beginning of a line.
With prefix argument, kill that many lines from point.
Negative arguments kill lines backward.

When calling from a program, nil means \"no arg\",
a number counts as a prefix arg."
  (interactive "*P")
  (kill-region (if (and (interactive-p)
			(not arg)
			(eq kill-whole-line 'always))
		   (save-excursion
		     (beginning-of-line)
		     (point))
		 (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 (interactive-p)
				(or (eq kill-whole-line 'always)
				    (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)
    (kill-region (point) point)))


;;;; Window system cut and paste hooks.
;;;
;;; I think that kill-hooks is a better name and more general mechanism
;;; than interprogram-cut-function (from FSFmacs).  I don't like the behavior
;;; of interprogram-paste-function: ^Y should always come from the kill ring,
;;; not the X selection.  But if that were provided, it should be called (and
;;; behave as) yank-hooks instead.  -- jwz

;; [... code snipped ...]

(defcustom kill-hooks nil
  "*Functions run when something is added to the XEmacs kill ring.
These functions are called with one argument, the string most recently
cut or copied.  You can use this to, for example, make the most recent
kill become the X Clipboard selection."
  :type 'hook
  :group 'killing)

;;; `kill-hooks' seems not sufficient because
;;; `interprogram-cut-function' requires more variable about to rotate
;;; the cut buffers.  I'm afraid to change interface of `kill-hooks',
;;; so I add it. (1997-11-03 by MORIOKA Tomohiko)

(defcustom interprogram-cut-function 'own-clipboard
  "Function to call to make a killed region available to other programs.

Most window systems provide some sort of facility for cutting and
pasting text between the windows of different programs.
This variable holds a function that Emacs calls whenever text
is put in the kill ring, to make the new kill available to other
programs.

The function takes one or two arguments.
The first argument, TEXT, is a string containing
the text which should be made available.
The second, PUSH, if non-nil means this is a \"new\" kill;
nil means appending to an \"old\" kill."
  :type '(radio (function-item :tag "Send to Clipboard"
			       :format "%t\n"
			       own-clipboard)
		(const :tag "None" nil)
		(function :tag "Other"))
  :group 'killing)

(defcustom interprogram-paste-function 'get-clipboard
  "Function to call to get text cut from other programs.

Most window systems provide some sort of facility for cutting and
pasting text between the windows of different programs.
This variable holds a function that Emacs calls to obtain
text that other programs have provided for pasting.

The function should be called with no arguments.  If the function
returns nil, then no other program has provided such text, and the top
of the Emacs kill ring should be used.  If the function returns a
string, that string should be put in the kill ring as the latest kill.

Note that the function should return a string only if a program other
than Emacs has provided a string for pasting; if Emacs provided the
most recent string, the function should return nil.  If it is
difficult to tell whether Emacs or some other program provided the
current string, it is probably good enough to return nil if the string
is equal (according to `string=') to the last text Emacs provided."
  :type '(radio (function-item :tag "Get from Clipboard"
			       :format "%t\n"
			       get-clipboard)
		(const :tag "None" nil)
		(function :tag "Other"))
  :group 'killing)


;;;; The kill ring data structure.

(defvar kill-ring nil
  "List of killed text sequences.
Since the kill ring is supposed to interact nicely with cut-and-paste
facilities offered by window systems, use of this variable should
interact nicely with `interprogram-cut-function' and
`interprogram-paste-function'.  The functions `kill-new',
`kill-append', and `current-kill' are supposed to implement this
interaction; you may want to use them instead of manipulating the kill
ring directly.")

(defcustom kill-ring-max 30
  "*Maximum length of kill ring before oldest elements are thrown away."
  :type 'integer
  :group 'killing)

(defvar kill-ring-yank-pointer nil
  "The tail of the kill ring whose car is the last thing yanked.")

(defun kill-new (string &optional replace)
  "Make STRING the latest kill in the kill ring.
Set the kill-ring-yank pointer to point to it.
Run `kill-hooks'.
Optional second argument REPLACE non-nil means that STRING will replace
the front of the kill ring, rather than being added to the list."
;  (and (fboundp 'menu-bar-update-yank-menu)
;       (menu-bar-update-yank-menu string (and replace (car kill-ring))))
  (if replace
      (setcar kill-ring string)
    (setq kill-ring (cons string kill-ring))
    (if (> (length kill-ring) kill-ring-max)
	(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
  (setq kill-ring-yank-pointer kill-ring)
  (if interprogram-cut-function
      (funcall interprogram-cut-function string (not replace)))
  (run-hook-with-args 'kill-hooks string))

(defun kill-append (string before-p)
  "Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill.
Run `kill-hooks'."
  (kill-new (if before-p
		(concat string (car kill-ring))
	      (concat (car kill-ring) string)) t))

(defun current-kill (n &optional do-not-move)
  "Rotate the yanking point by N places, and then return that kill.
If N is zero, `interprogram-paste-function' is set, and calling it
returns a string, then that string is added to the front of the
kill ring and returned as the latest kill.
If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
yanking point\; just return the Nth kill forward."
  (let ((interprogram-paste (and (= n 0)
				 interprogram-paste-function
				 (funcall interprogram-paste-function))))
    (if interprogram-paste
	(progn
	  ;; Disable the interprogram cut function when we add the new
	  ;; text to the kill ring, so Emacs doesn't try to own the
	  ;; selection, with identical text.
	  (let ((interprogram-cut-function nil))
	    (kill-new interprogram-paste))
	  interprogram-paste)
      (or kill-ring (error "Kill ring is empty"))
      (let* ((tem (nthcdr (mod (- n (length kill-ring-yank-pointer))
			       (length kill-ring))
			  kill-ring)))
	(or do-not-move
	    (setq kill-ring-yank-pointer tem))
	(car tem)))))



;;;; Commands for manipulating the kill ring.

;; In FSF killing read-only text just pastes it into kill-ring.  Which
;; is a very bad idea -- see Jamie's comment below.

;(defvar kill-read-only-ok nil
;  "*Non-nil means don't signal an error for killing read-only text.")

(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.
\(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)

This is the primitive for programs to kill text (as opposed to deleting it).
Supply two arguments, character numbers indicating the stretch of text
 to be killed.
Any command that calls this function is a \"kill command\".
If the previous command was also a kill command,
the text killed this time appends to the text killed last time
to make one entry in the kill ring."
  (interactive "*r\np")
;  (interactive
;   (let ((region-hack (and zmacs-regions (eq last-command 'yank))))
;     ;; This lets "^Y^W" work.  I think this is dumb, but zwei did it.
;     (if region-hack (zmacs-activate-region))
;     (prog1
;	 (list (point) (mark) current-prefix-arg)
;       (if region-hack (zmacs-deactivate-region)))))
  ;; beg and end can be markers but the rest of this function is
  ;; written as if they are only integers
  (if (markerp beg) (setq beg (marker-position beg)))
  (if (markerp end) (setq end (marker-position end)))
  (or (and beg end) (if zmacs-regions ;; rewritten for I18N3 snarfing
			(error "The region is not active now")
		      (error "The mark is not set now")))
  (if verbose (if buffer-read-only
		  (lmessage 'command "Copying %d characters"
			    (- (max beg end) (min beg end)))
		(lmessage 'command "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))
	(text-property-not-all (min beg end) (max beg end) 'read-only nil))
   ;; This is redundant.
   ;; (if verbose (message "Copying %d characters"
   ;;			 (- (max beg end) (min 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)
    (barf-if-buffer-read-only)
    (signal 'buffer-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'