Artifact fcfe4c6f8752628e7e7b791e42666feb4e1fd241e6e39d2393c51046e0c5dfaa:
- File
psl-1983/3-1/nmode/text-commands.sl
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 30831) [annotate] [blame] [check-ins using] [more...]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % TEXT-COMMANDS.SL - NMODE Sentence, Paragraph, Filling, and Formatting % % Author: Jeff Soreff % Hewlett-Packard/CRC % Date: 8 December 1982 % Revised: 1 February 1983 % Revised: 2 March 1983 % % 2-Mar-83 Jeff Soreff % Mark-paragraph-command was altered to push the current position % onto the ring of marks before marking the paragraph. % 15-Feb-83 Jeff Soreff % Bugs were removed from fill-comment-command and from next-char-list. % A test for arriving at a line end was added to fill-comment-command % in the while loop which locates the fill prefix to be used. It fixed an % infinite loop in this while which occurred when one did a % fill-comment-command while on the last line in the buffer, if the % prefix-finding loop got to the buffer's end. An at-line-end? test was used % instead of an at-buffer-end? test since the fill prefix found should never % go over a line. % In next-char-list the initialization of final-char-pos was changed % from 0 to char-count. This removed a bug that led to setting the point % at the start of a prefixed line after a fill which moved point to the first % availible position on that new line. Point should have been left AFTER the % prefix. Changing the initialization of final-char-position allows % next-char-list to accurately account for the spaces taken up by the prefix, % since this count is passed to its char-count argument. % 1-Feb-83 Alan Snyder % Changed literal ^L in source to #\FF. % 30-Dec-82 Alan Snyder % Extended C-X = to set the current line number if a command number is % given. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (CompileTime (load extended-char fast-strings fast-int)) (fluid '(nmode-current-buffer text-mode fill-prefix fill-column nmode-command-argument nmode-command-argument-given nmode-command-number-given nmode-command-killed sentence-terminators sentence-extenders)) (setf sentence-terminators '(#/! #/. #/?)) (setf sentence-extenders '(#/' #/" #/) #/])) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % User/Enhancer option sensitive function: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % The text-justifier function may be altered if one wishes to have the % same flexibility as EMACS'S TECO search strings provide. (de text-justifier-command? () % This function checks to see if the rest of the line is a text % justifier command. It returns a boolean and leaves point alone. (= (next-character) #/.)) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Start of Sentence Functions and Associated Support Functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (de valid-sentence-end? () % This function checks that a sentence is followed by two blanks, a % newline or a blank and a newline. It advances point one space. % It returns a boolean value. (if (at-line-end?) t (move-forward) (and (= (previous-character) #\blank) (or (at-line-end?)(= (next-character) #\blank))))) (de move-to-end-of-last-sentence () % This function moves point to the end of the preceding sentence, % after extenders. This function does not return a useful value (while (not (or (at-buffer-start?) (when % This when returns true if it hits a valid sentence end. (member (previous-character) sentence-terminators) (let ((scan-place (buffer-get-position))) (while (member (next-character) sentence-extenders) (move-forward)) (let* ((tentative-sentence-end (buffer-get-position)) (true-end (valid-sentence-end?))) (buffer-set-position (if true-end tentative-sentence-end scan-place)) true-end))))) (move-backward))) (de start-of-last-sentence () % This function restores point to its former place. It returns the % location of the start of the preceding sentence. (let ((place (buffer-get-position))(start nil)(end nil)) (move-to-end-of-last-sentence) (setf end (buffer-get-position)) (skip-forward-blanks) % possibly past starting position this time (setf start (buffer-get-position)) (when (buffer-position-lessp place start) (buffer-set-position end) % end of last sentence, after extenders (while % push back past extenders (member (previous-character) sentence-extenders) (move-backward)) (move-backward) % push back past sentence terminator character (move-to-end-of-last-sentence) (skip-forward-blanks) (setf start (buffer-get-position))) (buffer-set-position place) start)) (de end-of-next-sentence () % This function restores point to its former place. It returns the % location of the end of the next sentence. (let ((place (buffer-get-position))) (while (not % the next sexp detects sentence ends and moves point to them (or (at-buffer-end?) (when % note that this returns (valid-sentence-end?)'s value (member (next-character) sentence-terminators) (move-forward) (while (member (next-character) sentence-extenders) (move-forward)) (let ((tentative-sentence-end (buffer-get-position))) (if (valid-sentence-end?) (buffer-set-position tentative-sentence-end)))))) (move-forward)) (prog1 (buffer-get-position) (buffer-set-position place)))) (de forward-one-sentence () % This function moves point to the end of the next sentence or % paragraph, whichever one is closer, and does not return a useful % value. (let ((sentence-end (end-of-next-sentence))) (if (at-line-end?)(move-forward)) % kludge to get around xtra newline (forward-one-paragraph) (if (at-line-start?)(move-backward)) % kludge to get around xtra newline (let ((paragraph-end (buffer-get-position))) (buffer-set-position (if (buffer-position-lessp sentence-end paragraph-end) % "closer" is "earlier" or "before", in this case sentence-end paragraph-end))))) (de backward-one-sentence () % This function moves point to the start of the preceding sentence % or paragraph, whichever one is closer. It does not return a useful % value (let ((sentence-start (start-of-last-sentence))) (skip-backward-blanks) (backward-one-paragraph) (skip-forward-blanks) (let ((paragraph-start (buffer-get-position))) (buffer-set-position (if (buffer-position-lessp sentence-start paragraph-start) % "closer" is "later" or "after", in this case paragraph-start sentence-start))))) (de forward-sentence-command () % If nmode-command-argument is positive this function moves point % forward by nmode-command-argument sentences , leaving it at the % end of a sentence. If nmode-command-argument is negative it moves % backwards by abs(nmode-command-argument) sentences, leaving it at % the start of a sentence. This function does not return a useful % value. (if (minusp nmode-command-argument) (for (from i 1 (- nmode-command-argument) 1) (do (backward-one-sentence))) (for (from i 1 nmode-command-argument 1) (do (forward-one-sentence))))) (de backward-sentence-command () % If nmode-command-argument is positive this function moves point % backward by nmode-command-argument sentences , leaving it at the % start of a sentence. If nmode-command-argument is negative it % moves forwards by abs(nmode-command-argument) sentences, leaving % it at the end of a sentence. This function does not return a % useful value. (if (minusp nmode-command-argument) (for (from i 1 (- nmode-command-argument) 1) (do (forward-one-sentence))) (for (from i 1 nmode-command-argument 1) (do (backward-one-sentence))))) (de kill-sentence-command () % This function kills whatever forward-sentence-command jumps over. % It leaves point after the killed text. This function is sensitive % to the nmode command argument through forward-sentence-command. (let ((place (buffer-get-position))) (forward-sentence-command) (update-kill-buffer (extract-region t place (buffer-get-position))) (setf nmode-command-killed t))) (de backward-kill-sentence-command () % This function kills whatever backward-sentence-command jumps over. % It leaves point after the killed text. This function is sensitive % to the nmode command argument through forward-sentence-command. (let ((place (buffer-get-position))) (backward-sentence-command) (update-kill-buffer (extract-region t place (buffer-get-position))) (setf nmode-command-killed t))) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Start of Paragraph Functions and Associated Support Functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (de rest-of-current-line-blank? () % This function detects if the rest of the line is blank. It % returns a boolean value. It restores point. (let ((last-position (buffer-get-position))) (while (and (not (at-line-end?)) (char-blank? (next-character))) (move-forward)) (prog1 (at-line-end?) (buffer-get-position last-position)))) (de mismatched-prefix? () % This function checks to see if there is a fill prefix which % doesn't match the start of the current line. It leaves point at % the start of the current line if there is a mismatch, or just % after the prefix if matched. It returns t if there is a fill % prefix which does NOT match the line's start. (move-to-start-of-line) (when fill-prefix (let ((start-line (buffer-get-position))) (move-over-characters (string-length % count of characters in fill-prefix (getv fill-prefix 0))) (when (not (text-equal (extract-text nil start-line (buffer-get-position)) fill-prefix)) (buffer-set-position start-line) t)))) (de pseudo-blank-line? () % This function tests to see if the current line should be kept out % of paragraphs. It tests for: lines which don't match an existing % fill prefix, blank lines, lines with only the fill prefix present, % text justifier commands, and properly prefixed text justifier % commands. It only checks for the text justifier commands in text % mode. It leaves point at the start of the current line and % returns a boolean value. (or (mismatched-prefix?) (prog1 (or (and (text-justifier-command?) (eq text-mode (=> nmode-current-buffer mode))) (rest-of-current-line-blank?)) (move-to-start-of-line)))) (de pseudo-indented-line? () % This function looks for page break characters or (in text mode) % indentation (after a fill prefix, if present) which signal the % start of a real paragraph. It always leaves point at the start of % the current line and returns a boolean. (prog1 (or (= #\FF (next-character)) % page break character (progn (mismatched-prefix?) (and (char-blank? (next-character)) (eq text-mode (=> nmode-current-buffer mode))))) (move-to-start-of-line))) (de start-line-paragraph? () % This function tests the current line to see if it is the first % line (not counting an empty line) in a paragraph. It leaves point % at the start of line and returns a boolean value. (and (not (pseudo-blank-line?)) (or (pseudo-indented-line?) % next sexp checks for a previous blank line (if (current-line-is-first?) t (move-to-previous-line) (prog1 (pseudo-blank-line?) (move-to-next-line)))))) (de end-line-paragraph? () % This function tests the current line to see if it is the last line % in a paragraph. It leaves point at the start of line and returns % a boolean value. (and (not (pseudo-blank-line?)) % The next sexp checks for the two things on the next line of % text that can end a paragraph: a blank line or an indented % line which would start a new paragraph. (if (current-line-is-last?) t (move-to-next-line) (prog1 (or (pseudo-indented-line?) (pseudo-blank-line?)) (move-to-previous-line))))) (de forward-one-paragraph () % This function moves point to the end of the next or current % paragraph, as EMACS defines it. This is either start of the line % after the last line with any characters or, if the paragraph % extends to the end of the buffer, then the end of the last line % with characters. This function returns a boolean which is true if % the function was stopped by a real paragraph end, rather than by % the buffer's end. (let ((true-end nil)) (while (not (or (setf true-end (end-line-paragraph?)) (current-line-is-last?))) (move-to-next-line)) (move-to-next-line) true-end)) (de forward-paragraph-command () % If nmode-command-argument is positive this function moves point % forward by nmode-command-argument paragraphs , leaving it at the % end of a paragraph. If nmode-command-argument is negative it moves % backwards by abs(nmode-command-argument) paragraphs, leaving it at % the start of a paragraph. This function does not return a useful % value. (if (minusp nmode-command-argument) (for (from i 1 (- nmode-command-argument) 1) (do (backward-one-paragraph))) (for (from i 1 nmode-command-argument 1) (do (forward-one-paragraph))))) (de backward-one-paragraph () % This function moves point backward to the start of the previous % paragraph. It returns a boolean which is true if the function was % stopped by a real paragraph's start, instead of by the buffer's % start. (if (and (at-line-start?) % if past start of start line, don't miss (start-line-paragraph?)) % start of current paragraph (move-to-previous-line)) (let ((real-start nil)) (while (not (or (setf real-start (start-line-paragraph?)) (current-line-is-first?))) (move-to-previous-line)) (unless (current-line-is-first?) % this sexp gets previous empty line on (move-to-previous-line) (unless (current-line-empty?) (move-to-next-line))) real-start)) (de backward-paragraph-command () % If nmode-command-argument is positive this function moves point % backward by nmode-command-argument paragraphs , leaving it at the % start of a paragraph. If nmode-command-argument is negative it % moves forwards by abs(nmode-command-argument) paragraphs, leaving % it at the end of a paragraph. This function does not return a % useful value. (if (minusp nmode-command-argument) (for (from i 1 (- nmode-command-argument) 1) (do (forward-one-paragraph))) (for (from i 1 nmode-command-argument 1) (do (backward-one-paragraph))))) (de paragraph-limits () % This function returns a list of positions marking the next % paragraph. Only real paragraph limits are returned. If there is % only stuff that should be excluded from a paragraph between point % and the end or the start of the buffer, then the appropriate limit % of the paragraph is filled with the current buffer position. This % function restores point. (let* ((temp (buffer-get-position))(top temp)(bottom temp)) (when (forward-one-paragraph) (setf bottom (buffer-get-position))) (when (backward-one-paragraph) (setf top (buffer-get-position))) (buffer-set-position temp) (list top bottom))) (de mark-paragraph-command () % This function sets the mark to the end of the next paragraph, and % moves point to its start. It returns nothing useful. (let ((pair (paragraph-limits))) (set-mark-from-point) (buffer-set-position (first pair)) (set-mark (second pair)))) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Start of Fill Functions and Associated Support Functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (de next-char-list (end char-count init-pos) % This function returns a list, the first element of which is a list % of characters, with their order the reverse of that in the % original text, spaces squeezed to a single space between words, % and with two spaces between sentences. The second element on the % list returned is how far along the new line the position % corresponding to "init-pos" wound up. Point is left after the % last character packed in but before "end" or the next nonblank % character. (let* ((from-end-last-blanks 0) (from-start-last-blanks 0) (final-char-pos char-count) (line-not-full (lessp char-count fill-column)) (first-end (buffer-get-position)) (next-sentence-wont-exhaust-region (not (buffer-position-lessp end first-end))) (new-char (next-character)) (line-list ())) % start of loop for successive sentences (while (and next-sentence-wont-exhaust-region line-not-full) % The next sexp checks to see if the next sentence fits within % the main region (from initial "point" to "end") with a % character to spare for the next sentence iteration. (let* ((next-sentence-end (end-of-next-sentence))) (setf next-sentence-wont-exhaust-region (not (buffer-position-lessp end next-sentence-end))) (setf first-end (if next-sentence-wont-exhaust-region next-sentence-end end))) (skip-forward-blanks) % ignore blanks just before next sentence % start of loop for successive characters (while (and (setf line-not-full (or (lessp char-count fill-column) % next sexp allows oversize words (eq char-count from-end-last-blanks))) (not (buffer-position-lessp first-end (buffer-get-position)))) (setf new-char % character compression sexp (let ((next (next-character))) (if (not (= (skip-forward-blanks) next)) #\blank (move-forward) next))) (setq line-list (cons new-char line-list)) (incr char-count) (when (buffer-position-lessp (buffer-get-position) init-pos) (setf final-char-pos char-count)) (cond ((= new-char #\blank) (setf from-end-last-blanks 0) (setf from-start-last-blanks 1)) (t % normal character (incr from-end-last-blanks) (incr from-start-last-blanks)))) % The next sexp terminates sentences properly. (when (and line-not-full next-sentence-wont-exhaust-region) (setf line-list (append '(#\blank #\blank) line-list)) (incr char-count 2) (setf from-end-last-blanks 0) (setf from-start-last-blanks 2))) % The next sexp trims off the last partial word or extra blank(s). (when (or (char-blank? (car line-list)) % extra blank(s) (not (or line-not-full % last partial word (at-line-end?) (char-blank? (next-character))))) (for (from i 1 from-start-last-blanks 1) (do (setf line-list (cdr line-list)))) (move-over-characters (- from-end-last-blanks))) % guarantee that buffer-position is left at or before end (if (buffer-position-lessp end (buffer-get-position)) (buffer-set-position end)) (list line-list final-char-pos))) (de justify (input desired-length) % This function pads its input with blanks and reverses it. It % leaves point alone. (let* ((input-length (length input)) (output ()) (needed-blanks (- desired-length input-length)) % total number needed to fill out line (input-blanks % count preexisting blanks in input (for (in char input) (with blanks) (count (= char #\blank) blanks) (returns blanks)))) (for (in char input) (with (added-blanks 0) % number of new blanks added so far (handled-blanks 0)) % number of input blanks considered so far (do (setf output (cons char output)) (when (= char #\blank) (incr handled-blanks) % calculate number of new blanks needed here % fraction of original blanks passed=handled-blanks/input-blanks % blanks needed here~fraction*[needed-blanks(for whole line)]-(added-blanks) (let ((new-blanks (- (/ (* needed-blanks handled-blanks) input-blanks) added-blanks))) (when (> new-blanks 0) (for (from new 1 new-blanks 1) (do (setf output (cons #\blank output)))) (incr added-blanks new-blanks)))))) output)) (de position-adjusted-for-prefix (position) % This is a pure function which returns a position, corrected for % the length of the prefix on the position's line. (let ((current-place (buffer-get-position))) (buffer-set-position position) (mismatched-prefix?) (let ((prefix-length-or-zero (current-char-pos))) (buffer-set-position current-place) (let ((adjusted-char-pos (- (buffer-position-column position) prefix-length-or-zero))) (if (< adjusted-char-pos 0)(setf adjusted-char-pos 0)) (buffer-position-create (buffer-position-line position) adjusted-char-pos))))) (de remove-prefix-from-region (start end) % The main effect of this function is to strip the fill prefix off a % region in the buffer. this function does not return a useful value % or move point. (let ((current-place (buffer-get-position))) (buffer-set-position start) (if (current-line-empty?)(move-to-next-line)) (while (not (buffer-position-lessp end (buffer-get-position))) (setf start (buffer-get-position)) (unless (or (mismatched-prefix?) (buffer-position-lessp end (buffer-get-position))) (extract-text t start (buffer-get-position))) (move-to-next-line)) (buffer-set-position current-place))) (de fill-directed-region (start end init-pos) % The main effect of this function is to replace text with filled or % justified text. This function returns a list. The first element % is the increase in the number of lines in the text due to filling. % The second element is the filled position equivalent to "init-pos" % in the original text. The point is left at the end of the new % text (let ((modified-flag (=> nmode-current-buffer modified?)) (old-text (extract-text nil start end)) (final-pos init-pos) (adj-end (position-adjusted-for-prefix end)) (adj-init-pos (position-adjusted-for-prefix init-pos))) (when fill-prefix (remove-prefix-from-region start end)) (setf end adj-end) (buffer-set-position start) (let* ((list-of-new-lines (when % handles first blank line (current-line-empty?) (move-to-next-line) '(""))) (new-packed-line '(nil 0)) (prefix-list (if fill-prefix (string-to-list (getv fill-prefix 0)))) (prefix-column (map-char-to-column (list2string prefix-list) (length prefix-list))) (new-line nil) (place (buffer-get-position)) % handles indentation (junk (skip-forward-blanks)) % handles indentation (start-char-pos (+ (current-display-column) % handles indentation prefix-column)) % and first time switch (indent-list (string-to-list % handles indentation (getv (extract-text nil place (buffer-get-position)) 0)))) (while (let* ((after-line-start (buffer-position-lessp (buffer-get-position) adj-init-pos)) (new-packed-line (next-char-list end start-char-pos adj-init-pos)) (before-line-end (buffer-position-lessp adj-init-pos (buffer-get-position)))) (when (and after-line-start before-line-end) (setf final-pos (buffer-position-create (+ (buffer-position-line start) (length list-of-new-lines)) (second new-packed-line)))) % test that anything is left in the region, as well as getting line (setf new-line (first new-packed-line))) (setf new-line (list2string (append % add in fill prefix and indentation (append prefix-list (unless (= start-char-pos prefix-column) indent-list)) (if (and nmode-command-argument-given % triggers justification (not (or % don't justify the last line in a paragraph (buffer-position-lessp end (buffer-get-position)) (at-buffer-end?)))) (justify new-line (- fill-column start-char-pos)) (reverse new-line))))) (setf list-of-new-lines (cons new-line list-of-new-lines)) % only the first line in a paragraph is indented (setf start-char-pos prefix-column)) (setf list-of-new-lines (cons (list2string nil) list-of-new-lines)) % The last line in the new paragraph is added in last setf. (let ((line-change 0) (new-text (list2vector (reverse list-of-new-lines)))) (when list-of-new-lines (extract-text t start end) (setf line-change (- (size new-text) (size old-text))) (insert-text new-text) (if (and (not modified-flag) (text-equal new-text old-text)) (=> nmode-current-buffer set-modified? nil))) (list line-change final-pos))))) (de clip-region (limits region) % This is a pure function with no side effects. It returns the % "region" position pair, sorted so that first buffer position is % the first element, and clipped so that the region returned is % between the buffer-positions in "limits". (let ((limit-pair (if (buffer-position-lessp (cadr limits) (car limits)) (reverse limits) limits)) (region-pair (copy (if (buffer-position-lessp (cadr region) (car region)) (reverse region) region)))) (if (buffer-position-lessp (car region-pair) (car limit-pair)) (setf (car region-pair) (car limit-pair))) (if (buffer-position-lessp (cadr region-pair) (car limit-pair)) (setf (cadr region-pair) (car limit-pair))) (if (buffer-position-lessp (cadr limit-pair) (car region-pair)) (setf (car region-pair) (cadr limit-pair))) (if (buffer-position-lessp (cadr limit-pair) (cadr region-pair)) (setf (cadr region-pair) (cadr limit-pair))) region-pair)) (de fill-region-command () % This function replaces the text between point and the current mark % with a filled version of the same text. It leaves the % buffer-position at the end of the new text. It does not return % anything useful. (let* ((current-place (buffer-get-position)) (limits (list (current-mark) current-place))) (setf limits (if (buffer-position-lessp (car limits) (cadr limits)) limits (reverse limits))) (buffer-set-position (car limits)) (let ((at-limits nil)(new-region nil)(lines-advance 0)) (while (not at-limits) % paragraph loop (setf new-region (paragraph-limits)) (setf new-region (clip-region limits new-region)) (setf at-limits (= (car new-region) (cadr new-region))) (unless at-limits (setf lines-advance (first (fill-directed-region % expansion-of-text-information used (car new-region) (cadr new-region) current-place))) (setf limits % compensate for expansion of filled text (list (first limits) (let ((bottom (second limits))) (buffer-position-create (+ lines-advance (buffer-position-line bottom)) (buffer-position-column bottom)))))) (setf limits % guarantee that no text is filled twice (list (buffer-get-position)(second limits))))))) (de fill-paragraph-command () % This function replaces the next paragraph with filled version. It % leaves point at the a point bearing the same relation to the % filled text that the old point did to the old text. It does not % return a useful value. (let* ((current-place (buffer-get-position)) (pos-list (paragraph-limits))) (buffer-set-position (second (fill-directed-region (first pos-list) (second pos-list) current-place))))) (de fill-comment-command () % This function creates a temporary fill prefix from the start of % the current line. It replaces the surrounding paragraph % (determined using fill-prefix) with a filled version. It leaves % point at the a position bearing the same relation to the filled % text that the old point did to the old text. It does not return a % useful value. (let ((current-place (buffer-get-position))) (move-to-start-of-line) (let ((place (buffer-get-position))) % get fill prefix ends set up (skip-forward-blanks-in-line) (while (not (or (alphanumericp (next-character)) (at-line-end?) (char-blank? (next-character)))) (move-forward)) (skip-forward-blanks-in-line) (let* ((fill-prefix (extract-text nil place (buffer-get-position))) (pos-list (paragraph-limits))) (if (buffer-position-lessp (first pos-list) current-place) (buffer-set-position (second (fill-directed-region (first pos-list) (second pos-list) current-place))) (buffer-set-position current-place)))))) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Start of Misc Functions and Associated Support Functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (de center-current-line () % This function trims and centers the current line. It does not % return a useful value. It leaves point at a point in the text % equivalent to that before centering. (current-line-strip-indent) (let ((current-place (buffer-get-position))) (move-to-end-of-line) (strip-previous-blanks) (buffer-set-position current-place)) (let ((needed-blanks (/ (- fill-column (current-display-column)) 2))) (unless (minusp needed-blanks) (indent-current-line needed-blanks)))) (de center-line-command () % This function centers a number of lines, depending on the % argument. It leaves point at the end of the last line centered. % It does not return a useful value. (center-current-line) (when (> (abs nmode-command-argument) 1) (if (minusp nmode-command-argument) (for (from i 2 (- nmode-command-argument) 1) (do (move-to-previous-line) (center-current-line))) (for (from i 2 nmode-command-argument 1) (do (move-to-next-line) (center-current-line)))))) (de what-cursor-position-command () % This function tells the user where they are in the buffer or sets % point to the specified line number. It does not return a useful % value. (cond (nmode-command-number-given (set-line-pos nmode-command-argument) ) (t (write-message (if (at-buffer-end?) (bldmsg "X=%w Y=%w line=%w (%w percent of %w lines)" (current-display-column) (- (current-line-pos)(current-window-top-line)) (current-line-pos) (/ (* 100 (current-line-pos)) (current-buffer-visible-size)) (current-buffer-visible-size)) (bldmsg "X=%w Y=%w CH=%w line=%w (%w percent of %w lines)" (current-display-column) (- (current-line-pos)(current-window-top-line)) (next-character) % omitted at end of buffer (current-line-pos) (/ (* 100 (current-line-pos)) (current-buffer-visible-size)) (current-buffer-visible-size)))) )))