From d96192792d3c2b9a58dd50a40c2c3129e366d342 Mon Sep 17 00:00:00 2001 From: tailor Date: Sun, 6 May 2007 18:37:47 +0000 Subject: [PATCH] [lice @ get doctor working. fix line-end-position. fix move-to-left-margin.] --- buffer.lisp | 64 +++++++++++++++++++++++++ doctor.lisp | 26 ++++++---- editfns.lisp | 6 ++- global.lisp | 15 ++++++ indent.lisp | 7 +++ input.lisp | 15 +++--- keymap.lisp | 2 + lisp-indent.lisp | 3 +- lisp-mode.lisp | 19 ++++---- paragraphs.lisp | 45 +++++++++--------- search.lisp | 141 ++++++++++++++++++++++++++++++++++++------------------- simple.lisp | 38 +++++++++++++-- 12 files changed, 276 insertions(+), 105 deletions(-) diff --git a/buffer.lisp b/buffer.lisp index 40704aa..b6e7611 100644 --- a/buffer.lisp +++ b/buffer.lisp @@ -787,6 +787,70 @@ before the text." ;; debugging (fill-gap buf)) +(defun scan-buffer (buffer target start end count) +"Search for COUNT instances of the character TARGET between START and END. + +If COUNT is positive, search forwards; END must be >= START. +If COUNT is negative, search backwards for the -COUNTth instance; + END must be <= START. +If COUNT is zero, do anything you please; run rogue, for all I care. + +If END is NIL, use BEGV or ZV instead, as appropriate for the +direction indicated by COUNT. + +If we find COUNT instances, return the +position past the COUNTth match and 0. Note that for reverse motion +this is not the same as the usual convention for Emacs motion commands. + +If we don't find COUNT instances before reaching END, return END +and the number of TARGETs left unfound." + (let ((shortage (abs count)) + last) + (if (> count 0) + (setf end (or end (zv buffer))) + (setf end (or end (begv buffer)))) + (setf start (buffer-char-to-aref buffer start) + end (buffer-char-to-aref buffer end)) + (loop while (and (> count 0) + (/= start end)) do + (setf start + (if (< start (buffer-gap-start buffer)) + (or (position target (buffer-data buffer) :start start :end (min end (buffer-gap-start buffer))) + (and (> end (gap-end buffer)) + (position target (buffer-data buffer) :start (gap-end buffer) :end end))) + (position target (buffer-data buffer) :start start :end end))) + (if start + (setf start (1+ start) + last start + count (1- count) + shortage (1- shortage)) + (setf start end))) + (loop while (and (< count 0) + (/= start end)) do + (setf start + (if (> start (buffer-gap-start buffer)) + (or (position target (buffer-data buffer) :start (max end (gap-end buffer)) :end start :from-end t) + (and (< end (buffer-gap-start buffer)) + (position target (buffer-data buffer) :start end :end (buffer-gap-start buffer) :from-end t))) + (position target (buffer-data buffer) :start end :end start :from-end t))) + (if start + (setf last (+ start 1) ; match emacs functionality + count (1+ count) + shortage (1- shortage)) + (setf start end))) + (if (zerop count) + (values (and last (buffer-aref-to-char buffer last)) 0) + (values (buffer-aref-to-char buffer end) shortage)))) + +(defun find-before-next-newline (from to cnt) + "Like find_next_newline, but returns position before the newline, +not after, and only search up to TO. This isn't just +find_next_newline (...)-1, because you might hit TO." + (multiple-value-bind (pos shortage) (scan-buffer (current-buffer) #\Newline from to cnt) + (when (zerop shortage) + (decf pos)) + pos)) + (defun buffer-scan-newline (buf start limit count) "Search BUF for COUNT newlines with a limiting point at LIMIT, starting at START. Returns the point of the last newline or limit and diff --git a/doctor.lisp b/doctor.lisp index a68f30c..4738ed1 100644 --- a/doctor.lisp +++ b/doctor.lisp @@ -104,6 +104,7 @@ (define-key map (kbd "C-j") 'doctor-read-print) (define-key map (make-key :char #\Return) 'doctor-ret-or-read) (define-key map (kbd "RET") 'doctor-ret-or-read) + (define-key map (kbd "C-m") 'doctor-ret-or-read) map)) (defvar *doctor-mode* @@ -912,15 +913,19 @@ Otherwise call the Doctor to parse preceding sentence." (defun doctor-read-token () "read one word from buffer" - (prog1 (intern (downcase (buffer-substring (point) + (prog1 (intern (upcase (buffer-substring (point) (progn (forward-word 1) - (point))))) - (re-search-forward "\\w*"))) ;;"\\Sw*" + (point)))) + "LICE") + (re-search-forward "\\W*"))) ;;"\\Sw*" ;; Main processing function for sentences that have been read. +(declaim (special sent)) + (defun doctor-doc (sent) + ;; Old emacs programs actually depended on dynamic scope! (cond ((equal sent '(foo)) (doctor-type '(bar! (doc$ please)(doc$ doc-continue) \.))) @@ -983,7 +988,9 @@ Otherwise call the Doctor to parse preceding sentence." (doctor-type '((doc$ whysay) that i shouldn\'t (cddr sent) \?)))) - (doctor-go (doctor-wherego sent)))))))) + (progn + (message "HERE") + (doctor-go (doctor-wherego sent))))))))) ;; Things done to process sentences once read. @@ -1170,12 +1177,12 @@ the subject noun, and return the portion of the sentence following it." (let ((foo (doctor-make-string x))) (cond ((string-equal (substring foo -1) "s") (cond ((string-equal (substring foo -2 -1) "s") - (intern (concat foo "es"))) + (intern (concat foo "es") "LICE")) (t x))) ((string-equal (substring foo -1) "y") (intern (concat (substring foo 0 -1) - "ies"))) - (t (intern (concat foo "s")))))) + "ies") "LICE")) + (t (intern (concat foo "s") "LICE"))))) (defun doctor-setprep (sent key) (let ((val) @@ -1439,7 +1446,8 @@ Hack on previous word, setting global variable OWNER to correct result." ((and (atom str1) (atom str2)) (intern (concat (doctor-make-string str1) - (doctor-make-string str2)))) + (doctor-make-string str2)) + "LICE")) (t nil))) (defun doctor-make-string (obj) @@ -1465,7 +1473,7 @@ Hack on previous word, setting global variable OWNER to correct result." (defun doctor-go (destination) "Call a `doctor-*' function." - (funcall (intern (concat "DOCTOR-" (doctor-make-string destination))))) + (funcall (intern (concat "DOCTOR-" (doctor-make-string destination)) "LICE"))) (defun doctor-desire1 () (doctor-go (doc$ whereoutp))) diff --git a/editfns.lisp b/editfns.lisp index 6788ce6..0683f24 100644 --- a/editfns.lisp +++ b/editfns.lisp @@ -456,8 +456,10 @@ boundaries bind `inhibit-field-text-motion' to t. This function does not move point." (check-type n integer) - (let ((end-pos (buffer-scan-newline (current-buffer) (point) (point-max) (if (<= n 0) (- n 1) n)))) - (constrain-to-field end-pos (point) nil t nil))) + (setf n (- n (if (<= n 0) 1 0))) + (let* ((orig (point)) + (end-pos (find-before-next-newline orig nil n))) + (constrain-to-field end-pos orig nil t nil))) (defun clip-to-bounds (lower num upper) (max (min num upper) lower)) diff --git a/global.lisp b/global.lisp index 3992da3..a016957 100644 --- a/global.lisp +++ b/global.lisp @@ -193,6 +193,10 @@ to may be nil or omitted; then the substring runs to the end of string. from and to start at 0. If either is negative, it counts from the end. This function allows vectors as well as strings." + (when (< from 0) + (setf from (max 0 (+ (length string) from)))) + (when (< to 0) + (setf to (max 0 (+ (length string) to)))) (subseq string from to)) (depricate memq member) @@ -202,5 +206,16 @@ Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT." (member elt list :test 'eq)) +(defun int-to-string (n) + "Return the decimal representation of number as a string. +Uses a minus sign if negative. +number may be an integer or a floating point number." + (check-type n number) + (prin1-to-string n)) + +(defun string-to-char (string) + "Convert arg string to a character, the first character of that string. +A multibyte character is handled correctly." + (char string 0)) (provide :lice-0.1/global) diff --git a/indent.lisp b/indent.lisp index 46f322f..b574afd 100644 --- a/indent.lisp +++ b/indent.lisp @@ -112,6 +112,13 @@ The return value is the current column." (pos (point buffer)) (pos-aref (buffer-char-to-aref buffer pos)) (end (zv buffer))) + ;; If we're starting past the desired column, back up to beginning + ;; of line and scan from there. + (when (> col column) + (setf end pos + pos (buffer-beginning-of-line) + pos-aref (buffer-char-to-aref buffer pos) + col 0)) ;; FIXME: this assumes each character is 1 column (while (and (< col column) (< pos end)) diff --git a/input.lisp b/input.lisp index 7d9c579..e18cdc4 100644 --- a/input.lisp +++ b/input.lisp @@ -140,13 +140,14 @@ events that invoked the current command." ;; let the user break out of this stuff (let ((*waiting-for-input* nil)) (dispatch-processes procs) - (frame-render (selected-frame))))) - ;; FIXME: Yes, I'd love to be able to sleep until there was - ;; activity on one of the streams lice is waiting for input on - ;; but i don't know how to do that. So just sleep for a tiny - ;; bit to pass control over to the operating system and then - ;; check again. - (sleep 0.01)))) + (frame-render (selected-frame)))) + (t + ;; FIXME: Yes, I'd love to be able to sleep until there was + ;; activity on one of the streams lice is waiting for input on + ;; but i don't know how to do that. So just sleep for a tiny + ;; bit to pass control over to the operating system and then + ;; check again. + (sleep 0.01)))))) ;; This is really TTY specific (defun next-event () diff --git a/keymap.lisp b/keymap.lisp index f7d3ca3..56645be 100644 --- a/keymap.lisp +++ b/keymap.lisp @@ -249,6 +249,8 @@ more." (define-key kmap (make-key :char #\e :control t :meta t) 'end-of-defun) (define-key kmap (make-key :char #\_ :control t) 'undo) (define-key kmap (make-key :char #\/ :control t) 'undo) + (define-key kmap (make-key :char #\} :meta t) 'forward-paragraph) + (define-key kmap (make-key :char #\{ :meta t) 'backward-paragraph) (define-key kmap (make-key :char #\x :control t) ctl-x-prefix) (define-key kmap (make-key :char #\c :control t) ctl-c-prefix) (define-key kmap (make-key :char #\h :control t) ctl-h-prefix) diff --git a/lisp-indent.lisp b/lisp-indent.lisp index d7a6a5f..5b636d6 100644 --- a/lisp-indent.lisp +++ b/lisp-indent.lisp @@ -126,6 +126,7 @@ If nil, indent backquoted lists as data, i.e., like quoted lists." (defun common-lisp-indent-function-1 (indent-point state) + (with-match-data (let ((normal-indent (current-column))) ;; Walk up list levels until we see something ;; which does special things with subforms. @@ -278,7 +279,7 @@ If nil, indent backquoted lists as data, i.e., like quoted lists." (progn (backward-up-list 1) (setq depth (1+ depth))) (error () (setq depth lisp-indent-maximum-backtracking)))))) - (or calculated tentative-calculated)))) + (or calculated tentative-calculated))))) (defun common-lisp-indent-call-method (function method path state indent-point diff --git a/lisp-mode.lisp b/lisp-mode.lisp index 7da5a07..ecd0d13 100644 --- a/lisp-mode.lisp +++ b/lisp-mode.lisp @@ -387,16 +387,15 @@ is called as a function to find the defun's beginning." (when (and (< arg 0) (not (eobp))) (forward-char 1)) - (let ((mdata (if *defun-prompt-regexp* - (re-search-backward (concat (if *open-paren-in-column-0-is-defun-start* - "^\\(|" "") - "(?:" *defun-prompt-regexp* ")\\(") - :error 'move :count (or arg 1)) - (search-backward (format nil "~%(") ;; FIXME: doesn't match beginning of buffer - :error 'move :count (or arg 1))))) ;; used to be ^\\( - (when mdata - (goto-char (1- (match-end mdata 0))) - t))))) + (with-match-data + (and (if *defun-prompt-regexp* + (re-search-backward (concat (if *open-paren-in-column-0-is-defun-start* + "^\\(|" "") + "(?:" *defun-prompt-regexp* ")\\(") + :error 'move :count (or arg 1)) + (search-backward (format nil "~%(") ;; FIXME: doesn't match beginning of buffer + :error 'move :count (or arg 1))) ;; used to be ^\\( + (progn (goto-char (1- (match-end 0))) t)))))) (defcommand beginning-of-defun ((&optional (arg 1)) :prefix) diff --git a/paragraphs.lisp b/paragraphs.lisp index 36bcacf..3b23f16 100644 --- a/paragraphs.lisp +++ b/paragraphs.lisp @@ -249,8 +249,8 @@ Returns the count of paragraphs left to move." start found-start) (while (and (< arg 0) (not (bobp))) (if (and (not (looking-at parsep)) - ;;FIXME: (re-search-backward "^\n" :bound (max (1- (point)) (point-min)) :error nil) - (search-backward "\n\n" :bound (max (1- (point)) (point-min)) :error nil) + (re-search-backward "^\n" :bound (max (1- (point)) (point-min)) :error nil) + ;;(search-backward "\n\n" :bound (max (1- (point)) (point-min)) :error nil) (looking-at parsep)) (setq arg (1+ arg)) (progn @@ -340,7 +340,7 @@ Returns the count of paragraphs left to move." (not (looking-at parsep)) (looking-at fill-prefix-regexp)) (forward-line 1)) - (progn + (with-match-data (while (and (re-search-forward sp-parstart :error 1) (progn (setq start (match-beginning 0)) (goto-char start) @@ -456,25 +456,26 @@ With negative argument, move backward repeatedly to `sentence-beginning'. The variable `sentence-end' is a regular expression that matches ends of sentences. Also, every paragraph boundary terminates sentences as well." - (or arg (setq arg 1)) - (let ((opoint (point)) - (sentence-end (sentence-end))) - (while (< arg 0) - (let ((pos (point)) - (par-beg (save-excursion (start-of-paragraph-text) (point)))) - (if (and (re-search-backward sentence-end :bound par-beg :error nil) - (or (< (match-end 0) pos) - (re-search-backward sentence-end :bound par-beg :error nil))) - (goto-char (match-end 0)) - (goto-char par-beg))) - (setq arg (1+ arg))) - (while (> arg 0) - (let ((par-end (save-excursion (end-of-paragraph-text) (point)))) - (if (re-search-forward sentence-end :bound par-end :error nil) - (skip-chars-backward " \t\n") - (goto-char par-end))) - (setq arg (1- arg))) - (constrain-to-field nil opoint t))) + (with-match-data + (or arg (setq arg 1)) + (let ((opoint (point)) + (sentence-end (sentence-end))) + (while (< arg 0) + (let ((pos (point)) + (par-beg (save-excursion (start-of-paragraph-text) (point)))) + (if (and (re-search-backward sentence-end :bound par-beg :error nil) + (or (< (match-end 0) pos) + (re-search-backward sentence-end :bound par-beg :error nil))) + (goto-char (match-end 0)) + (goto-char par-beg))) + (setq arg (1+ arg))) + (while (> arg 0) + (let ((par-end (save-excursion (end-of-paragraph-text) (point)))) + (if (re-search-forward sentence-end :bound par-end :error nil) + (skip-chars-backward " \t\n") + (goto-char par-end))) + (setq arg (1- arg))) + (constrain-to-field nil opoint t)))) (defcommand repunctuate-sentences () "Put two spaces at the end of sentences from point to the end of buffer. diff --git a/search.lisp b/search.lisp index a58c592..f6c86f2 100644 --- a/search.lisp +++ b/search.lisp @@ -6,7 +6,22 @@ (defstruct match-data obj start end reg-starts reg-ends) -(defun match-end (data idx) +(defvar *match-data* nil + "store the match data for searches.") + +(defvar *with-match-data* nil + "Set to true when inside a match-data block. If this is NIL +during one of the searches, a warning is signaled because it's +not thread safe. But, lots of code uses the search functions so +it's useful, at least now to be compatible with gnu emacs, even +if it's not thread safe. Never set this variable directly.") + +(defmacro with-match-data (&body body) + `(let ((*with-match-data* t) + (*match-data* nil)) + ,@body)) + +(defun match-end (idx &optional (data *match-data*)) "Return position of start of text matched by last search. SUBEXP, a number, specifies which parenthesized expression in the last regexp. @@ -17,7 +32,7 @@ Zero means the entire text matched by the whole regexp or whole string." (match-data-end data) (aref (match-data-reg-ends data) (1- idx)))) -(defun match-beginning (data idx) +(defun match-beginning (idx &optional (data *match-data*)) "Return position of start of text matched by last search. SUBEXP, a number, specifies which parenthesized expression in the last regexp. @@ -32,7 +47,16 @@ Zero means the entire text matched by the whole regexp or whole string." (define-condition search-failed (lice-condition) () (:documentation "raised when a search failed to match")) +(define-condition thread-unsafe (style-warning) + () (:documentation "Raised when a search is not threadsafe. See also `*with-match-data*'")) + +(defun check-search-thread-safe () + "Report a warning if the search is unsafe for threads." + (unless *with-match-data* + (signal 'thread-unsafe))) + (defun string-search-command (string bound error count direction) + (check-search-thread-safe) (gap-move-to (current-buffer) (buffer-point-aref (current-buffer))) ;; normalize vars (setf count (* count direction) @@ -66,11 +90,13 @@ Zero means the entire text matched by the whole regexp or whole string." (if (minusp count) (goto-char (+ (buffer-aref-to-char buffer pos) (length string))) (goto-char (buffer-aref-to-char buffer pos))) - (make-match-data :obj buffer - :start (buffer-aref-to-char buffer pos) - :end (+ (buffer-aref-to-char buffer pos) (length string)) - :reg-starts #() - :reg-ends #()))))) + (values (point) + (setf *match-data* + (make-match-data :obj buffer + :start (buffer-aref-to-char buffer pos) + :end (+ (buffer-aref-to-char buffer pos) (length string)) + :reg-starts #() + :reg-ends #()))))))) (defun search-forward (string &key bound (error t) (count 1)) "Search forward from point for string. @@ -103,8 +129,12 @@ Search case-sensitivity is determined by the value of the variable See also the functions `match-beginning', `match-end' and `replace-match'." (string-search-command string bound error count -1)) +;; TODO: create compiler-macros for regex functions so the regexps can +;; be compiled at compile time. + (defun looking-at (regexp &optional (buffer (current-buffer))) "Return the match-data if text after point matches regular expression regexp." + (check-search-thread-safe) ;; get the gap outta the way. It sucks we have to do this. Really we ;; should modify ppcre to generate scanner functions that hop the ;; gap. Meantime... @@ -112,18 +142,22 @@ See also the functions `match-beginning', `match-end' and `replace-match'." (buffer-gap-start buffer)) (gap-move-to-point buffer)) (multiple-value-bind (start end reg-starts reg-ends) - (ppcre:scan regexp (buffer-data buffer) :start (buffer-char-to-aref buffer (point buffer))) + (ppcre:scan (ppcre:create-scanner regexp :multi-line-mode t) (buffer-data buffer) + :start (buffer-char-to-aref buffer (point buffer)) + :real-start-pos 0) (when (and start (= start (buffer-char-to-aref buffer (point buffer)))) - (make-match-data :obj buffer - :start (buffer-aref-to-char buffer start) - :end (buffer-aref-to-char buffer end) - :reg-starts (map 'vector (lambda (n) - (buffer-aref-to-char buffer n)) - reg-starts) - :reg-ends (map 'vector (lambda (n) - (buffer-aref-to-char buffer n)) - reg-ends))))) + (values t + (setf *match-data* + (make-match-data :obj buffer + :start (buffer-aref-to-char buffer start) + :end (buffer-aref-to-char buffer end) + :reg-starts (map 'vector (lambda (n) + (buffer-aref-to-char buffer n)) + reg-starts) + :reg-ends (map 'vector (lambda (n) + (buffer-aref-to-char buffer n)) + reg-ends))))))) (defun re-search-forward (regexp &key (bound (zv)) (error t) count &aux (buffer (current-buffer))) "Search forward from point for regular expression regexp. @@ -136,24 +170,28 @@ COUNT is repeat count--search for successive occurrences. See also the functions `match-beginning', `match-end', `match-string', and `replace-match'." (declare (ignore count)) + (check-search-thread-safe) (when (< (buffer-char-to-aref buffer (point buffer)) (buffer-gap-start buffer)) (gap-move-to-point buffer)) (multiple-value-bind (start end reg-starts reg-ends) - (ppcre:scan regexp (buffer-data buffer) + (ppcre:scan (ppcre:create-scanner regexp :multi-line-mode t) (buffer-data buffer) :start (buffer-char-to-aref buffer (point buffer)) - :end (buffer-char-to-aref buffer bound)) + :end (buffer-char-to-aref buffer bound) + :real-start-pos 0) (cond (start - (goto-char (buffer-aref-to-char buffer start) buffer) - (make-match-data :obj buffer - :start (buffer-aref-to-char buffer start) - :end (buffer-aref-to-char buffer end) - :reg-starts (map 'vector (lambda (n) - (buffer-aref-to-char buffer n)) - reg-starts) - :reg-ends (map 'vector (lambda (n) - (buffer-aref-to-char buffer n)) - reg-ends))) + (goto-char (buffer-aref-to-char buffer end) buffer) + (values (point) + (setf *match-data* + (make-match-data :obj buffer + :start (buffer-aref-to-char buffer start) + :end (buffer-aref-to-char buffer end) + :reg-starts (map 'vector (lambda (n) + (buffer-aref-to-char buffer n)) + reg-starts) + :reg-ends (map 'vector (lambda (n) + (buffer-aref-to-char buffer n)) + reg-ends))))) ((eq error t) (signal 'search-failed)) ((null error) @@ -176,6 +214,7 @@ COUNT is repeat count--search for successive occurrences. See also the functions `match-beginning', `match-end', `match-string', and `replace-match'." (declare (ignore count)) + (check-search-thread-safe) ;;(message "re-search-backward ~s ~d" regexp (point)) (when (> (buffer-gap-start buffer) (buffer-char-to-aref buffer (point buffer))) @@ -184,32 +223,34 @@ and `replace-match'." (let* ((start-aref (buffer-char-to-aref buffer (point buffer))) (pt-aref start-aref) (stop (buffer-char-to-aref buffer bound)) - (scanner (ppcre:create-scanner regexp))) + (scanner (ppcre:create-scanner regexp :multi-line-mode t))) (loop (multiple-value-bind (start end reg-starts reg-ends) - (ppcre:scan scanner (buffer-data buffer) :start start-aref :end pt-aref) + (ppcre:scan scanner (buffer-data buffer) :start start-aref :end pt-aref :real-start-pos 0) (when start (goto-char (buffer-aref-to-char buffer start) buffer) - (return (make-match-data :obj buffer - :start (buffer-aref-to-char buffer start) - :end (buffer-aref-to-char buffer end) - :reg-starts (map 'vector (lambda (n) - (buffer-aref-to-char buffer n)) - reg-starts) - :reg-ends (map 'vector (lambda (n) - (buffer-aref-to-char buffer n)) - reg-ends)))) + (return (values (point) + (setf *match-data* + (make-match-data :obj buffer + :start (buffer-aref-to-char buffer start) + :end (buffer-aref-to-char buffer end) + :reg-starts (map 'vector (lambda (n) + (buffer-aref-to-char buffer n)) + reg-starts) + :reg-ends (map 'vector (lambda (n) + (buffer-aref-to-char buffer n)) + reg-ends)))))) (dec-aref start-aref buffer) (when (< start-aref stop) (cond ((eq error t) ;; FIXME: we need a search condition (signal 'search-failed)) ((null error) - (return-from re-search-backward nil)) + (return nil)) (t (when bound (goto-char bound buffer)) - (return-from re-search-backward nil)))))))) + (return nil)))))))) (defun string-match (regexp string &key (start 0) (end (length string))) "Return index of start of first match for regexp in string and match-data, or nil. @@ -222,15 +263,18 @@ END, end search at that index in string. You can use the function `match-string' to extract the substrings matched by the parenthesis constructions in regexp." + (check-search-thread-safe) (multiple-value-bind (start end reg-starts reg-ends) - (ppcre:scan regexp string :start start :end end) + (ppcre:scan (ppcre:create-scanner regexp :multi-line-mode t) + string :start start :end end) (when start (values start - (make-match-data :obj string - :start start - :end end - :reg-starts reg-starts - :reg-ends reg-ends))))) + (setf *match-data* + (make-match-data :obj string + :start start + :end end + :reg-starts reg-starts + :reg-ends reg-ends)))))) (defun regexp-quote (string) "Return a regexp string which matches exactly STRING and nothing else." @@ -241,4 +285,3 @@ matched by the parenthesis constructions in regexp." collect #\\ collect c) 'string)) - \ No newline at end of file diff --git a/simple.lisp b/simple.lisp index 8686ea8..883f558 100644 --- a/simple.lisp +++ b/simple.lisp @@ -525,12 +525,40 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (/= arg 1) t nil))))) -(defcommand end-of-line ((&optional n) +(defcommand end-of-line ((&optional (n 1)) :prefix) - "Move the point to the end of the line in the current buffer." - ;; FIXME: handle prefix - (declare (ignore n)) - (setf (marker-position (buffer-point (current-buffer))) (buffer-end-of-line))) +"Move point to end of current line. +With argument N not nil or 1, move forward N - 1 lines first. +If point reaches the beginning or end of buffer, it stops there. +To ignore intangibility, bind `inhibit-point-motion-hooks' to t. + +This function constrains point to the current field unless this moves +point to a different line than the original, unconstrained result. If +N is nil or 1, and a rear-sticky field ends at point, the point does +not move. To ignore field boundaries bind `inhibit-field-text-motion' +to t." + (let (newpos) + (loop + (setf newpos (line-end-position n)) + (set-point newpos) + (cond + ((and (> (point) newpos) + (char= (buffer-fetch-char (1- (point)) (current-buffer)) + #\Newline)) + ;; If we skipped over a newline that follows an invisible + ;; intangible run, move back to the last tangible position + ;; within the line. + (set-point (1- (point))) + (return)) + ((and (> (point) newpos) + (< (point) (zv)) + (char/= (buffer-fetch-char (point) (current-buffer)) + #\Newline)) + ;; If we skipped something intangible and now we're not + ;; really at eol, keep going. + (setf n 1)) + (t (return)))) + nil)) (defcommand erase-buffer ((&optional (buffer (current-buffer)))) "Erase the contents of the current buffer." -- 2.11.4.GIT