editfns.lisp

   1 (in-package "LICE")
   2
   3 (defvar *inhibit-field-text-motion* nil
   4   "Non-nil means text motion commands don't notice fields.")
   5
   6 (defvar *buffer-access-fontify-functions* nil
   7 "List of functions called by `buffer-substring' to fontify if necessary.
   8 Each function is called with two arguments which specify the range
   9 of the buffer being accessed.")
  10
  11 (defvar *buffer-access-fontified-property* nil
  12 "Property which (if non-nil) indicates text has been fontified.
  13 `buffer-substring' need not call the `buffer-access-fontify-functions'
  14 functions if all the text being accessed has this property.")
  15
  16 (defvar *system-name* nil
  17   "The host name of the machine Emacs is running on.")
  18
  19 (defvar *user-full-name* nil
  20   "The full name of the user logged in.")
  21
  22 (defvar *user-login-name* nil
  23   "The user's name, taken from environment variables if possible.")
  24
  25 (defvar *user-real-login-name* nil
  26   "The user's name, based upon the real uid only.")
  27
  28 (defvar *operating-system-release* nil
  29   "The release of the operating system Emacs is running on.")
  30
  31 (defun get-pos-property (position prop &optional (object (current-buffer)))
  32   "Return the value of property PROP, in OBJECT at POSITION.
  33 It's the value of PROP that a char inserted at POSITION would get.
  34 OBJECT is optional and defaults to the current buffer.
  35 If OBJECT is a buffer, then overlay properties are considered as well as
  36 text properties.
  37 If OBJECT is a window, then that window's buffer is used, but
  38 window-specific overlays are considered only if they are associated
  39 with OBJECT."
  40   (when (typep object 'window)
  41     (setf object (window-buffer object)))
  42   (if (not (typep object 'buffer))
  43       (get-text-property position prop object)
  44     ;;; XXX: handle overlays.
  45     (let ((stickiness (text-property-stickiness prop position object)))
  46       (cond
  47        ((eq stickiness 'after)
  48         (get-text-property position prop object))
  49        ((eq stickiness 'before)
  50         (get-text-property (1- position) prop object))
  51        (t nil)))))
  52
  53 (defun find-field (pos merge-at-boundary &key beg-limit beg end-limit end (buf (current-buffer)))
  54   "Find the field surrounding POS and return the beginning and end of
  55 the field in a values list.  If POS is nil, the value of point is used
  56 instead. If BEG or END is nil then that boundary isn't calculated.
  57
  58 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
  59 results; they do not effect boundary behavior.
  60
  61 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
  62 position of a field, then the beginning of the previous field is
  63 returned instead of the beginning of POS's field (since the end of a
  64 field is actually also the beginning of the next input field, this
  65 behavior is sometimes useful).  Additionally in the MERGE_AT_BOUNDARY
  66 true case, if two fields are separated by a field with the special
  67 value `boundary', and POS lies within it, then the two separated
  68 fields are considered to be adjacent, and POS between them, when
  69 finding the beginning and ending of the \"merged\" field.
  70
  71 Either BEG or END may be 0, in which case the corresponding value
  72 is not stored."
  73   (let ((at-field-start nil)
  74         (at-field-end nil)
  75         before-field after-field)
  76     (unless pos
  77       (setf pos (pt)))
  78     (setf after-field (get-char-property-and-overlay pos 'field buf nil)
  79           before-field (if (> pos (begv buf))
  80                            (get-char-property-and-overlay (1- pos) 'field buf nil)
  81                          nil))
  82     ;; See if we need to handle the case where MERGE_AT_BOUNDARY is nil
  83     ;; and POS is at beginning of a field, which can also be interpreted
  84     ;; as the end of the previous field.  Note that the case where if
  85     ;; MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
  86     ;; more natural one; then we avoid treating the beginning of a field
  87     ;; specially.
  88     (unless merge-at-boundary
  89       (let ((field (get-pos-property pos 'field buf)))
  90         (when (not (eq field after-field))
  91           (setf at-field-end t))
  92         (when (not (eq field before-field))
  93           (setf at-field-start t))
  94         (when (and (null field)
  95                    at-field-start
  96                    at-field-end)
  97           ;; If an inserted char would have a nil field while the surrounding
  98           ;; text is non-nil, we're probably not looking at a
  99           ;; zero-length field, but instead at a non-nil field that's
 100           ;; not intended for editing (such as comint's prompts).
 101           (setf at-field-end nil
 102                 at-field-start nil))))
 103     ;; Note about special `boundary' fields:
 104
 105     ;; Consider the case where the point (`.') is between the fields `x' and `y':
 106
 107     ;;  xxxx.yyyy
 108
 109     ;; In this situation, if merge_at_boundary is true, we consider the
 110     ;; `x' and `y' fields as forming one big merged field, and so the end
 111     ;; of the field is the end of `y'.
 112
 113     ;; However, if `x' and `y' are separated by a special `boundary' field
 114     ;; (a field with a `field' char-property of 'boundary), then we ignore
 115     ;; this special field when merging adjacent fields.  Here's the same
 116     ;; situation, but with a `boundary' field between the `x' and `y' fields:
 117
 118     ;;  xxx.BBBByyyy
 119
 120     ;; Here, if point is at the end of `x', the beginning of `y', or
 121     ;; anywhere in-between (within the `boundary' field), we merge all
 122     ;; three fields and consider the beginning as being the beginning of
 123     ;; the `x' field, and the end as being the end of the `y' field.  */
 124
 125     ;; Return field boundary
 126     (values (and beg
 127                  (if at-field-start
 128                      pos
 129                    (let ((p pos))
 130                      (if (and (null merge-at-boundary)
 131                               (eq before-field 'boundary))
 132                          (setf p (previous-single-char-property-change p 'field buf beg-limit))
 133                        (setf p (previous-single-char-property-change p 'field buf beg-limit)))
 134                      (or p
 135                          (begv buf)))))
 136             (and end
 137                  (if at-field-end
 138                      pos
 139                    (progn
 140                      (when (and (null merge-at-boundary)
 141                                 (eq after-field 'boundary))
 142                        (setf pos (next-single-char-property-change pos 'field buf end-limit)))
 143                      (setf pos (next-single-char-property-change pos 'field buf end-limit))
 144                      (or pos
 145                          (zv buf))))))))
 146
 147 (defun buffer-substring (start end &optional (buffer (current-buffer)))
 148   "Return the contents of part of the current buffer as a string.
 149 The two arguments START and END are character positions;
 150 they can be in either order.
 151 The string returned is multibyte if the buffer is multibyte.
 152
 153 This function copies the text properties of that part of the buffer
 154 into the result string; if you don't want the text properties,
 155 use `buffer-substring-no-properties' instead."
 156   (multiple-value-setq (start end) (validate-region start end buffer))
 157   (make-buffer-string start end t buffer))
 158
 159 (defun buffer-substring-no-properties (start end &optional (buffer (current-buffer)))
 160   "Return the characters of part of the buffer, without the text properties.
 161 The two arguments START and END are character positions;
 162 they can be in either order."
 163   (multiple-value-setq (start end) (validate-region start end buffer))
 164   (make-buffer-string start end nil buffer))
 165
 166
 167 (defun field-string (pos)
 168   "Return the contents of the field surrounding POS as a string.
 169 A field is a region of text with the same `field' property.
 170 If POS is nil, the value of point is used for POS."
 171   (multiple-value-bind (beg end) (find-field pos nil :beg t :end t)
 172     (make-buffer-string beg end t)))
 173
 174 (defun field-beginning (&optional pos escape-from-edge limit)
 175   "Return the beginning of the field surrounding POS.
 176 A field is a region of text with the same `field' property.
 177 If POS is nil, the value of point is used for POS.
 178 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
 179 field, then the beginning of the *previous* field is returned.
 180 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
 181 is before LIMIT, then LIMIT will be returned instead."
 182     (declare (ignore escape-from-edge))
 183   (multiple-value-bind (beg end) (find-field pos nil :beg-limit limit :beg t)
 184     (declare (ignore end))
 185     beg))
 186
 187 (defun field-end (&optional pos escape-from-edge limit)
 188   "Return the end of the field surrounding POS.
 189 A field is a region of text with the same `field' property.
 190 If POS is nil, the value of point is used for POS.
 191 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
 192 then the end of the *following* field is returned.
 193 If LIMIT is non-nil, it is a buffer position; if the end of the field
 194 is after LIMIT, then LIMIT will be returned instead."
 195   (declare (ignore escape-from-edge))
 196   (multiple-value-bind (beg end) (find-field pos nil :end-limit limit :end t)
 197     (declare (ignore beg))
 198     end))
 199
 200 (defun constrain-to-field (new-pos old-pos &optional escape-from-edge only-in-line inhibit-capture-property)
 201   "Return the position closest to NEW-POS that is in the same field as OLD-POS.
 202
 203 A field is a region of text with the same `field' property.
 204 If NEW-POS is nil, then the current point is used instead, and set to the
 205 constrained position if that is different.
 206
 207 If OLD-POS is at the boundary of two fields, then the allowable
 208 positions for NEW-POS depends on the value of the optional argument
 209 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
 210 constrained to the field that has the same `field' char-property
 211 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
 212 is non-nil, NEW-POS is constrained to the union of the two adjacent
 213 fields.  Additionally, if two fields are separated by another field with
 214 the special value `boundary', then any point within this special field is
 215 also considered to be `on the boundary'.
 216
 217 If the optional argument ONLY-IN-LINE is non-nil and constraining
 218 NEW-POS would move it to a different line, NEW-POS is returned
 219 unconstrained.  This useful for commands that move by line, like
 220 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
 221 only in the case where they can still move to the right line.
 222
 223 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
 224 a non-nil property of that name, then any field boundaries are ignored.
 225
 226 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil."
 227   (let ((orig-point 0)
 228         fwd prev-old prev-new)
 229     (unless new-pos
 230       ;; Use the current point, and afterwards, set it.
 231       (setf new-pos (pt)
 232             orig-point new-pos))
 233     (check-type new-pos number)
 234     (check-type old-pos number)
 235     (setf fwd (> new-pos old-pos)
 236           prev-old (1- old-pos)
 237           prev-new (1- new-pos))
 238     (when (and (null *inhibit-field-text-motion*)
 239                (/= new-pos old-pos)
 240                (or (get-char-property new-pos 'field)
 241                    (get-char-property old-pos 'field)
 242                    ;; To recognize field boundaries, we must also look at the
 243                    ;; previous positions; we could use `get_pos_property'
 244                    ;; instead, but in itself that would fail inside non-sticky
 245                    ;; fields (like comint prompts).
 246                    (and (> new-pos (begv))
 247                         (get-char-property prev-new 'field))
 248                    (and (> old-pos (begv))
 249                         (get-char-property prev-old 'field)))
 250                (or (null inhibit-capture-property)
 251                    (and (null (get-pos-property old-pos inhibit-capture-property nil))
 252                         (or (<= old-pos (begv))
 253                             (null (get-char-property old-pos inhibit-capture-property))
 254                             (null (get-char-property prev-old inhibit-capture-property))))))
 255       ;; It is possible that NEW_POS is not within the same field as
 256       ;; OLD_POS; try to move NEW_POS so that it is.
 257       (let ((field-bound (if fwd
 258                              (field-end old-pos escape-from-edge new-pos)
 259                              (field-beginning old-pos escape-from-edge new-pos))))
 260         (when (and
 261                ;; See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
 262                ;; other side of NEW_POS, which would mean that NEW_POS is
 263                ;; already acceptable, and it's not necessary to constrain it
 264                ;; to FIELD_BOUND.
 265                (if (< field-bound new-pos) fwd (not fwd))
 266                ;; NEW_POS should be constrained, but only if either
 267                ;; ONLY_IN_LINE is nil (in which case any constraint is OK),
 268                ;; or NEW_POS and FIELD_BOUND are on the same line (in which
 269                ;; case the constraint is OK even if ONLY_IN_LINE is non-nil). */
 270                (or (null only-in-line)
 271                    ;; This is the ONLY_IN_LINE case, check that NEW_POS and
 272                    ;; FIELD_BOUND are on the same line by seeing whether
 273                    ;; there's an intervening newline or not.
 274                    (progn
 275                      (multiple-value-bind (p nfound)
 276                          (buffer-scan-newline (current-buffer) new-pos field-bound (if fwd -1 1))
 277                        (declare (ignore p))
 278                        (zerop nfound)))))
 279           ;; Constrain NEW_POS to FIELD_BOUND.
 280           (setf new-pos field-bound))
 281         (when (and orig-point
 282                    (/= new-pos orig-point))
 283           (set-point new-pos))))
 284     new-pos))
 285
 286 (defun npropertize (string &rest props)
 287   "Same as propertize but don't make a copy of STRING."
 288   (declare (type string string))
 289   (let ((ps (make-instance 'pstring
 290                            :data string)))
 291     (create-root-interval ps)
 292     (add-text-properties 0 (pstring-length ps) props ps)
 293     ps))
 294
 295 (defun propertize (string &rest props)
 296   "Return a copy of STRING with text properties added.
 297 First argument is the string to copy.
 298 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
 299 properties to add to the result.
 300 usage: (propertize STRING &rest PROPERTIES)"
 301   (declare (type string string))
 302   (apply #'npropertize (copy-seq string) props))
 303
 304 (defun delete-region (start end &optional (buffer (current-buffer)))
 305   "Delete the text between point and mark.
 306
 307 expects two arguments, positions (integers or markers) specifying
 308 the stretch to be deleted."
 309   (multiple-value-setq (start end) (validate-region start end buffer))
 310   (buffer-delete buffer start (- end start)))
 311
 312 (defun point (&aux (buffer (current-buffer)))
 313   "Return the point in the current buffer."
 314   (pt buffer))
 315
 316 (defun point-marker (&aux (buffer (current-buffer)))
 317   "Return value of point, as a marker object."
 318   (buffer-point buffer))
 319
 320 (defun point-min (&aux (buffer (current-buffer)))
 321   "Return the minimum permissible value of point in the current buffer."
 322   (declare (ignore buffer))
 323   0)
 324
 325 (defun point-max (&aux (buffer (current-buffer)))
 326   "Return the maximum permissible value of point in the current buffer."
 327   (buffer-size buffer))
 328
 329 (defmacro save-current-buffer (&body body)
 330   "Save the current buffer; execute BODY; restore the current buffer.
 331 Executes BODY just like `progn'."
 332   (let ((cb (gensym "CB")))
 333     `(let ((,cb (current-buffer)))
 334        (unwind-protect (progn ,@body)
 335          (when (get-buffer ,cb)
 336            (set-buffer cb))))))
 337
 338 (defmacro save-excursion (&body body)
 339   "Save point, mark, and current buffer; execute BODY; restore those things.
 340 Executes BODY just like `progn'.
 341 The values of point, mark and the current buffer are restored
 342 even in case of abnormal exit (throw or error).
 343 *The state of activation of the mark is also restored.
 344
 345 *This construct does not save `deactivate-mark', and therefore
 346 *functions that change the buffer will still cause deactivation
 347 *of the mark at the end of the command.  To prevent that, bind
 348 *`deactivate-mark' with `let'."
 349   (let ((cb (gensym "CB"))
 350         (point (gensym "POINT"))
 351         (mark (gensym "MARK")))
 352     `(let ((,cb (current-buffer))
 353            (,point (copy-marker (point-marker)))
 354            (,mark (copy-marker (mark-marker))))
 355        (unwind-protect (progn ,@body)
 356          (when (get-buffer ,cb)
 357            (set-buffer ,cb)
 358            (setf (buffer-mark-marker ,cb) ,mark
 359                  (buffer-point ,cb) ,point))))))
 360
 361 (defun insert (&rest objects)
 362   "Insert the arguments, either strings or characters, at point.
 363 Point and before-insertion markers move forward to end up
 364  after the inserted text.
 365 Any other markers at the point of insertion remain before the text.
 366
 367 If the current buffer is multibyte, unibyte strings are converted
 368 to multibyte for insertion (see `string-make-multibyte').
 369 If the current buffer is unibyte, multibyte strings are converted
 370 to unibyte for insertion (see `string-make-unibyte').
 371
 372 When operating on binary data, it may be necessary to preserve the
 373 original bytes of a unibyte string when inserting it into a multibyte
 374 buffer; to accomplish this, apply `string-as-multibyte' to the string
 375 and insert the result."
 376   (dolist (o objects)
 377     (insert-move-point (current-buffer) o)))
 378
 379 (defun insert-buffer-substring (buffer start end)
 380   "Insert before point a substring of the contents of buffer.
 381 buffer may be a buffer or a buffer name.
 382 Arguments start and end are character positions specifying the substring.
 383 They default to the values of (point-min) and (point-max) in buffer."
 384   (let* ((buf (get-buffer buffer))
 385          (s (buffer-substring start end)))
 386     (with-current-buffer buf
 387       (insert s))))
 388
 389 (defun preceding-char ()
 390   "Return the character preceding point.
 391 At the beginning of the buffer or accessible region, return #\Nul."
 392   (or (buffer-char-before (current-buffer) (pt))
 393       #\Nul))
 394
 395 (defun following-char ()
 396   "Return the character following point, as a number.
 397 At the end of the buffer or accessible region, return #\Nul."
 398   (if (>= (pt) (zv))
 399       #\Nul ; XXX return nil?
 400       (buffer-fetch-char (buffer-char-to-aref (current-buffer) (pt))
 401                          (current-buffer))))
 402
 403 (defun bolp ()
 404   "Return t if point is at the beginning of a line."
 405   (or (= (pt) (begv))
 406       (char= (buffer-char-before (current-buffer) (pt)) #\Newline)))
 407
 408 (defun eolp ()
 409   "Return t if point is at the end of a line.
 410 `End of a line' includes point being at the end of the buffer."
 411   (or (= (pt) (zv))
 412       (char= (buffer-char-after (current-buffer) (pt)) #\Newline)))
 413
 414 (defun bobp (&optional (buffer (current-buffer)))
 415   "Return T when the point is at the beginning of the buffer."
 416   (= (begv buffer) (pt)))
 417
 418 (defun eobp (&optional (buffer (current-buffer)))
 419   "Return T when the point is at the end of the buffer."
 420   (= (zv buffer) (pt)))
 421
 422 (defun delete-and-extract-region (start end)
 423   "Delete the text between start and end and return it."
 424   (multiple-value-setq (start end) (validate-region start end))
 425   (if (= start end)
 426       ""
 427     (prog1
 428         (make-buffer-string start end t)
 429       (delete-region start end))))
 430
 431 (defun insert-char (character count &optional inherit)
 432   "Insert COUNT copies of CHARACTER.
 433 Point, and before-insertion markers, are relocated as in the function `insert'.
 434 **The optional third arg INHERIT, if non-nil, says to inherit text properties
 435 **from adjoining text, if those properties are sticky."
 436   (declare (ignore inherit))
 437   (check-type character character)
 438   (check-type count number)
 439   (unless (< count 0)
 440     (dotimes (i count)
 441       (insert character))))
 442
 443 (defun line-beginning-position (n)
 444   "Return the character position of the first character on the current line.
 445 With argument N not nil or 1, move forward N - 1 lines first.
 446 If scan reaches end of buffer, return that position.
 447
 448 This function constrains the returned position to the current field
 449 unless that would be on a different line than the original,
 450 unconstrained result.  If N is nil or 1, and a front-sticky field
 451 starts at point, the scan stops as soon as it starts.  To ignore field
 452 boundaries bind `inhibit-field-text-motion' to t.
 453
 454 This function does not move point."
 455   ;; FIXME: inhibit-point-motion-hooks
 456   (let ((pt (save-excursion
 457               (forward-line (if n (1- n) 0))
 458               (pt))))
 459     (constrain-to-field pt (pt) (not (eql n 1)) t nil)))
 460
 461 (defun line-end-position (&optional (n 1))
 462   "Return the character position of the last character on the current line.
 463 With argument N not nil or 1, move forward N - 1 lines first.
 464 If scan reaches end of buffer, return that position.
 465
 466 This function constrains the returned position to the current field
 467 unless that would be on a different line than the original,
 468 unconstrained result.  If N is nil or 1, and a rear-sticky field ends
 469 at point, the scan stops as soon as it starts.  To ignore field
 470 boundaries bind `inhibit-field-text-motion' to t.
 471
 472 This function does not move point."
 473   (check-type n integer)
 474   (setf n (- n (if (<= n 0) 1 0)))
 475   (let* ((orig (pt))
 476          (end-pos (find-before-next-newline orig nil n)))
 477     (constrain-to-field end-pos orig nil t nil)))
 478
 479 (defun clip-to-bounds (lower num upper)
 480   (max (min num upper) lower))
 481
 482 (defun string-to-char (string)
 483   "Convert arg string to a character, the first character of that string.
 484 A multibyte character is handled correctly."
 485   (char string 0))
 486
 487 (defun char-to-string ()
 488   (error "Unimplemented"))
 489
 490 (defun buffer-string ()
 491   (error "Unimplemented"))
 492
 493 (defun field-string-no-properties ()
 494   (error "Unimplemented"))
 495
 496 (defun delete-field ()
 497   (error "Unimplemented"))
 498
 499 (defmacro save-current-buffer ()
 500   (error "Unimplemented"))
 501
 502 (defun bufsize ()
 503   (error "Unimplemented"))
 504
 505 (defun point-min-marker ()
 506   (error "Unimplemented"))
 507
 508 (defun point-max-marker ()
 509   (error "Unimplemented"))
 510
 511 (defun gap-position ()
 512   (error "Unimplemented"))
 513
 514 (defun gap-size ()
 515   (error "Unimplemented"))
 516
 517 (defun position-bytes ()
 518   (error "Unimplemented"))
 519
 520 (defun byte-to-position ()
 521   (error "Unimplemented"))
 522
 523 (defun previous-char ()
 524   (error "Unimplemented"))
 525
 526 (defun insert-before-markers ()
 527   (error "Unimplemented"))
 528
 529 (defun insert-and-inherit ()
 530   (error "Unimplemented"))
 531
 532 (defun insert-and-inherit-before-markers ()
 533   (error "Unimplemented"))
 534
 535 (defun user-login-name ()
 536   (error "Unimplemented"))
 537
 538 (defun user-real-login-name ()
 539   (error "Unimplemented"))
 540
 541 (defun user-uid ()
 542   (error "Unimplemented"))
 543
 544 (defun user-real-uid ()
 545   (error "Unimplemented"))
 546
 547 (defun user-full-name ()
 548   (error "Unimplemented"))
 549
 550 (defun emacs-pid ()
 551   (error "Unimplemented"))
 552
 553 (defun current-time ()
 554   (error "Unimplemented"))
 555
 556 (defun format-time-string ()
 557   (error "Unimplemented"))
 558
 559 (defun float-time ()
 560   (error "Unimplemented"))
 561
 562 (defun decode-time ()
 563   (error "Unimplemented"))
 564
 565 (defun encode-time ()
 566   (error "Unimplemented"))
 567
 568 (defun current-time-string ()
 569   (error "Unimplemented"))
 570
 571 (defun current-time-zone ()
 572   (error "Unimplemented"))
 573
 574 (defun set-time-zone-rule ()
 575   (error "Unimplemented"))
 576
 577 (defun system-name ()
 578   (error "Unimplemented"))
 579
 580 (defun message-box ()
 581   (error "Unimplemented"))
 582
 583 (defun message-or-box ()
 584   (error "Unimplemented"))
 585
 586 (defun current-message ()
 587   (error "Unimplemented"))
 588
 589 (defun compare-buffer-substrings ()
 590   (error "Unimplemented"))
 591
 592 (defun subst-char-in-region ()
 593   (error "Unimplemented"))
 594
 595 (defun translate-region-internal ()
 596   (error "Unimplemented"))
 597
 598 (defun widen ()
 599   (error "Unimplemented"))
 600
 601 (defun narrow-to-region ()
 602   (error "Unimplemented"))
 603
 604 (defun save-restriction ()
 605   (error "Unimplemented"))
 606
 607 (defun transpose-regions ()
 608   (error "Unimplemented"))
 609
 610 (defun goto-char (position &aux (buffer (current-buffer)))
 611   "Set point to POSITION, a number."
 612   (check-number-coerce-marker position)
 613   (when (and (>= position (begv buffer))
 614              (<= position (zv buffer)))
 615     (set-point position buffer)))
 616
 617 (defun char-after (&optional (pos (pt)))
 618   "Return character in current buffer at position POS.
 619 ***POS is an integer or a marker.
 620 ***If POS is out of range, the value is nil."
 621   (check-number-coerce-marker pos)
 622   (buffer-char-after (current-buffer) pos))
 623
 624 (defun char-before (&optional (pos (pt)))
 625   "Return character in current buffer preceding position POS.
 626 ***POS is an integer or a marker.
 627 ***If POS is out of range, the value is nil."
 628   (check-number-coerce-marker pos)
 629   (buffer-char-after (current-buffer) (1- pos)))
 630
 631 (provide :lice-0.1/editfns)