(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,
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)
(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.
(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.
(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))))))
+
\f
(defcustom comment-column 32
"*Column to indent right-margin comments to.
;Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)
\f
-(eval-when-compile (defvar myhelp)) ; suppress compiler warning
;; XEmacs: Some functions moved to cmdloop.el:
;; keyboard-quit
(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*"
(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
(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)))
(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
projects / chise / xemacs-chise.git.1 / blobdiff