(defalias 'not 'null)
+(defmacro noreturn (form)
+ "Evaluates FORM, with the expectation that the evaluation will signal an error
+instead of returning to its caller. If FORM does return, an error is
+signalled."
+ `(prog1 ,form
+ (error "Form marked with `noreturn' did return")))
+
+(defmacro 1value (form)
+ "Evaluates FORM, with the expectation that all the same value will be returned
+from all evaluations of FORM. This is the global do-nothing
+version of `1value'. There is also `testcover-1value' that
+complains if FORM ever does return differing values."
+ form)
+
(defmacro lambda (&rest cdr)
"Return a lambda expression.
A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
(defun number-sequence (from &optional to inc)
"Return a sequence of numbers from FROM to TO (both inclusive) as a list.
-INC is the increment used between numbers in the sequence.
-So, the Nth element of the list is (+ FROM (* N INC)) where N counts from
-zero.
-If INC is nil, it defaults to 1 (one).
-If TO is nil, it defaults to FROM.
-If TO is less than FROM, the value is nil.
-Note that FROM, TO and INC can be integer or float."
- (if (not to)
+INC is the increment used between numbers in the sequence and defaults to 1.
+So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from
+zero. TO is only included if there is an N for which TO = FROM + N * INC.
+If TO is nil or numerically equal to FROM, return \(FROM).
+If INC is positive and TO is less than FROM, or INC is negative
+and TO is larger than FROM, return nil.
+If INC is zero and TO is neither nil nor numerically equal to
+FROM, signal an error.
+
+This function is primarily designed for integer arguments.
+Nevertheless, FROM, TO and INC can be integer or float. However,
+floating point arithmetic is inexact. For instance, depending on
+the machine, it may quite well happen that
+\(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4),
+whereas \(number-sequence 0.4 0.8 0.2) returns a list with three
+elements. Thus, if some of the arguments are floats and one wants
+to make sure that TO is included, one may have to explicitly write
+TO as \(+ FROM \(* N INC)) or use a variable whose value was
+computed with this exact expression. Alternatively, you can,
+of course, also replace TO with a slightly larger value
+\(or a slightly more negative value if INC is negative)."
+ (if (or (not to) (= from to))
(list from)
(or inc (setq inc 1))
- (let (seq)
- (while (<= from to)
- (setq seq (cons from seq)
- from (+ from inc)))
+ (when (zerop inc) (error "The increment can not be zero"))
+ (let (seq (n 0) (next from))
+ (if (> inc 0)
+ (while (<= next to)
+ (setq seq (cons next seq)
+ n (1+ n)
+ next (+ from (* n inc))))
+ (while (>= next to)
+ (setq seq (cons next seq)
+ n (1+ n)
+ next (+ from (* n inc)))))
(nreverse seq))))
(defun remove (elt seq)
of the event.
If EVENT is a drag, this returns the drag's starting position.
The return value is of the form
- (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
+ (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW))
The `posn-' functions access elements of such lists."
(if (consp event) (nth 1 event)
(list (selected-window) (point) '(0 . 0) 0)))
"Return the ending location of EVENT. EVENT should be a click or drag event.
If EVENT is a click event, this function is the same as `event-start'.
The return value is of the form
- (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
+ (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW))
The `posn-' functions access elements of such lists."
(if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
(list (selected-window) (point) '(0 . 0) 0)))
(defsubst posn-window (position)
"Return the window in POSITION.
-POSITION should be a list of the form
- (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
(nth 0 position))
+(defsubst posn-area (position)
+ "Return the window area recorded in POSITION, or nil for the text area.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (let ((area (if (consp (nth 1 position))
+ (car (nth 1 position))
+ (nth 1 position))))
+ (and (symbolp area) area)))
+
(defsubst posn-point (position)
"Return the buffer location in POSITION.
-POSITION should be a list of the form
- (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
- (if (consp (nth 1 position))
- (car (nth 1 position))
- (nth 1 position)))
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (or (nth 5 position)
+ (if (consp (nth 1 position))
+ (car (nth 1 position))
+ (nth 1 position))))
(defsubst posn-x-y (position)
"Return the x and y coordinates in POSITION.
-POSITION should be a list of the form
- (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
(nth 2 position))
(defun posn-col-row (position)
- "Return the column and row in POSITION, measured in characters.
-POSITION should be a list of the form
- (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions.
+ "Return the nominal column and row in POSITION, measured in characters.
+The column and row values are approximations calculated from the x
+and y coordinates in POSITION and the frame's default character width
+and height.
For a scroll-bar event, the result column is 0, and the row
-corresponds to the vertical position of the click in the scroll bar."
- (let* ((pair (nth 2 position))
- (window (posn-window position)))
- (if (eq (if (consp (nth 1 position))
- (car (nth 1 position))
- (nth 1 position))
- 'vertical-scroll-bar)
- (cons 0 (scroll-bar-scale pair (1- (window-height window))))
- (if (eq (if (consp (nth 1 position))
- (car (nth 1 position))
- (nth 1 position))
- 'horizontal-scroll-bar)
- (cons (scroll-bar-scale pair (window-width window)) 0)
- (let* ((frame (if (framep window) window (window-frame window)))
- (x (/ (car pair) (frame-char-width frame)))
- (y (/ (cdr pair) (+ (frame-char-height frame)
- (or (frame-parameter frame 'line-spacing)
- default-line-spacing
- 0)))))
- (cons x y))))))
+corresponds to the vertical position of the click in the scroll bar.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (let* ((pair (posn-x-y position))
+ (window (posn-window position))
+ (area (posn-area position)))
+ (cond
+ ((null window)
+ '(0 . 0))
+ ((eq area 'vertical-scroll-bar)
+ (cons 0 (scroll-bar-scale pair (1- (window-height window)))))
+ ((eq area 'horizontal-scroll-bar)
+ (cons (scroll-bar-scale pair (window-width window)) 0))
+ (t
+ (let* ((frame (if (framep window) window (window-frame window)))
+ (x (/ (car pair) (frame-char-width frame)))
+ (y (/ (cdr pair) (+ (frame-char-height frame)
+ (or (frame-parameter frame 'line-spacing)
+ default-line-spacing
+ 0)))))
+ (cons x y))))))
+
+(defun posn-actual-col-row (position)
+ "Return the actual column and row in POSITION, measured in characters.
+These are the actual row number in the window and character number in that row.
+Return nil if POSITION does not contain the actual position; in that case
+`posn-col-row' can be used to get approximate values.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (nth 6 position))
(defsubst posn-timestamp (position)
"Return the timestamp of POSITION.
-POSITION should be a list of the form
- (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
(nth 3 position))
+(defsubst posn-object (position)
+ "Return the object of POSITION.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (nth 4 position))
+
+(defsubst posn-object-x-y (position)
+ "Return the x and y coordinates relative to the object of POSITION.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (nth 7 position))
+
\f
;;;; Obsolescent names for functions.
list of hooks to run in HOOK, then nothing is done. See `add-hook'.
The optional third argument, LOCAL, if non-nil, says to modify
-the hook's buffer-local value rather than its default value.
-This makes the hook buffer-local if needed."
+the hook's buffer-local value rather than its default value."
(or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default hook nil))
- (if local (unless (local-variable-if-set-p hook)
- (set (make-local-variable hook) (list t)))
+ ;; Do nothing if LOCAL is t but this hook has no local binding.
+ (unless (and local (not (local-variable-p hook)))
;; Detect the case where make-local-variable was used on a hook
;; and do what we used to do.
- (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
- (setq local t)))
- (let ((hook-value (if local (symbol-value hook) (default-value hook))))
- ;; Remove the function, for both the list and the non-list cases.
- (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
- (if (equal hook-value function) (setq hook-value nil))
- (setq hook-value (delete function (copy-sequence hook-value))))
- ;; If the function is on the global hook, we need to shadow it locally
- ;;(when (and local (member function (default-value hook))
- ;; (not (member (cons 'not function) hook-value)))
- ;; (push (cons 'not function) hook-value))
- ;; Set the actual variable
- (if (not local)
- (set-default hook hook-value)
- (if (equal hook-value '(t))
- (kill-local-variable hook)
- (set hook hook-value)))))
+ (when (and (local-variable-p hook)
+ (not (and (consp (symbol-value hook))
+ (memq t (symbol-value hook)))))
+ (setq local t))
+ (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+ ;; Remove the function, for both the list and the non-list cases.
+ (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+ (if (equal hook-value function) (setq hook-value nil))
+ (setq hook-value (delete function (copy-sequence hook-value))))
+ ;; If the function is on the global hook, we need to shadow it locally
+ ;;(when (and local (member function (default-value hook))
+ ;; (not (member (cons 'not function) hook-value)))
+ ;; (push (cons 'not function) hook-value))
+ ;; Set the actual variable
+ (if (not local)
+ (set-default hook hook-value)
+ (if (equal hook-value '(t))
+ (kill-local-variable hook)
+ (set hook hook-value))))))
(defun add-to-list (list-var element &optional append)
"Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
(second (read-passwd "Confirm password: " nil default)))
(if (equal first second)
(progn
- (and (arrayp second) (fillarray second ?\0))
+ (and (arrayp second) (clear-string second))
(setq success first))
- (and (arrayp first) (fillarray first ?\0))
- (and (arrayp second) (fillarray second ?\0))
+ (and (arrayp first) (clear-string first))
+ (and (arrayp second) (clear-string second))
(message "Password not repeated accurately; please start over")
(sit-for 1))))
success)
(clear-this-command-keys)
(if (= c ?\C-u)
(progn
- (and (arrayp pass) (fillarray pass ?\0))
+ (and (arrayp pass) (clear-string pass))
(setq pass ""))
(if (and (/= c ?\b) (/= c ?\177))
(let* ((new-char (char-to-string c))
(new-pass (concat pass new-char)))
- (and (arrayp pass) (fillarray pass ?\0))
- (fillarray new-char ?\0)
+ (and (arrayp pass) (clear-string pass))
+ (clear-string new-char)
(setq c ?\0)
(setq pass new-pass))
(if (> (length pass) 0)
(let ((new-pass (substring pass 0 -1)))
- (and (arrayp pass) (fillarray pass ?\0))
+ (and (arrayp pass) (clear-string pass))
(setq pass new-pass))))))
(message nil)
(or pass default ""))))
(defalias 'redraw-modeline 'force-mode-line-update)
(defun force-mode-line-update (&optional all)
- "Force the mode line of the current buffer to be redisplayed.
-With optional non-nil ALL, force redisplay of all mode lines."
+ "Force redisplay of the current buffer's mode line and header line.
+With optional non-nil ALL, force redisplay of all mode lines and
+header lines. This function also forces recomputation of the
+menu bar menus and the frame title."
(if all (save-excursion (set-buffer (other-buffer))))
(set-buffer-modified-p (buffer-modified-p)))
(defvar yank-undo-function)
(defun insert-for-yank (string)
+ "Calls `insert-for-yank-1' repetitively for each `yank-handler' segment.
+
+See `insert-for-yank-1' for more details."
+ (let (to)
+ (while (setq to (next-single-property-change 0 'yank-handler string))
+ (insert-for-yank-1 (substring string 0 to))
+ (setq string (substring string to))))
+ (insert-for-yank-1 string))
+
+(defun insert-for-yank-1 (string)
"Insert STRING at point, stripping some text properties.
+
Strip text properties from the inserted text according to
`yank-excluded-properties'. Otherwise just like (insert STRING).
character numbers specifying the substring. They default to the
beginning and the end of BUFFER. Strip text properties from the
inserted text according to `yank-excluded-properties'."
+ ;; Since the buffer text should not normally have yank-handler properties,
+ ;; there is no need to handle them here.
(let ((opoint (point)))
(insert-buffer-substring buf start end)
(remove-yank-excluded-properties opoint (point))))
;; isearch-mode is deliberately excluded, since you should
;; not call it yourself.
(defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode
- overwrite-mode view-mode)
+ overwrite-mode view-mode
+ hs-minor-mode)
"List of all minor mode functions.")
(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
(put symbol 'abortfunc (or abortfunc 'kill-buffer))
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
+;;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
;;; subr.el ends here
HCoop / bpt / emacs.git / blobdiff