← Back to branch summary

~ubuntu-branches/ubuntu/edgy/ess/edgy

« back to all changes in this revision

Viewing changes to lisp/ess-utils.el

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2005-03-22 13:48:07 UTC
  • mfrom: (1.2.1 upstream) (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050322134807-9mpmbb799jugf248
Tags: 5.2.6-1
* New upstream release
* chmod -R u+w on orig source

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/ess-utils.el
1
1
;;; ess-utils.el --- General Emacs utility functions used by ESS
2
2
 
3
 
;; Copyright (C) 1998--2000 D. Bates, K. Hornik, R.M. Heiberger,
4
 
;; M. Maechler, and A.J. Rossini.
 
3
;; Copyright (C) 1998--2005 A.J. Rossini, Rich M. Heiberger, Martin
 
4
;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
5
5
 
6
 
;; Author: Martin Maechler <maechler@stat.math.ethz.ch>
7
 
;; Maintainer: Martin Maechler <maechler@stat.math.ethz.ch>
 
6
;; Original Author: Martin Maechler <maechler@stat.math.ethz.ch>
8
7
;; Created: 9 Sept 1998
9
 
;; Modified: $Date: 2002/01/28 08:36:05 $
10
 
;; Version: $Revision: 5.10 $
11
 
;; RCS: $Id: ess-utils.el,v 5.10 2002/01/28 08:36:05 maechler Exp $
 
8
;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
12
9
 
13
10
;; This file is part of ESS (Emacs Speaks Statistics).
14
11
 
28
25
 
29
26
;;;-- Emacs Utilities --- Generally useful --- used by (but not requiring) ESS
30
27
 
31
 
(defun inside-string/comment-p (pos)
32
 
  "Return non-nil if POSition [defaults to (point) is inside string or comment
 
28
(defun ess-inside-string-or-comment-p (pos)
 
29
  "Return non-nil if POSition [defaults to (point)] is inside string or comment
33
30
 (according to syntax). NOT OKAY for multi-line comments!!"
34
31
  ;;FIXME (defun S-calculate-indent ..) in ./essl-s.el can do that ...
35
32
  (interactive "d");point by default
39
36
                pos))))
40
37
    (or (nth 3 pps) (nth 4 pps)))); 3: string,  4: comment
41
38
 
 
39
(defsubst ess-inside-string-p ()
 
40
  "Return non-nil if point is inside string (according to syntax)."
 
41
  (interactive)
 
42
  (save-excursion
 
43
    (nth 3 (parse-partial-sexp (line-beginning-position) (point)))))
 
44
 
42
45
;; simple alternative to ess-read-object-name-default of ./ess-inf.el :
43
46
(defun ess-extract-word-name ()
44
47
  "Get the word you're on."
55
58
                               (not fixedcase))); t  <==> ignore case in search
56
59
        (pl) (p))
57
60
    (while (setq p (re-search-forward regexp nil t))
58
 
      (cond ((not (inside-string/comment-p (1- p)))
 
61
      (cond ((not (ess-inside-string-or-comment-p (1- p)))
59
62
             (if verbose
60
63
                 (let ((beg (match-beginning 0)))
61
64
                   (message "(beg,p)= (%d,%d) = %s"
67
70
    ;;or  (message "s/%s/%s/ at %s" regexp to-string pl))
68
71
    ) )
69
72
 
 
73
(defun ess-replace-regexp-dump-to-src
 
74
  (regexp to-string &optional dont-query verbose ensure-mode)
 
75
  "Depending on dont-query, call `ess-rep-regexp' or `query-replace-regexp'
 
76
from the beginning of the buffer."
 
77
  (save-excursion
 
78
    (if (and ensure-mode
 
79
             (not (equal major-mode 'ess-mode)))
 
80
        (ess-mode))
 
81
    (goto-char (point-min))
 
82
    (if dont-query
 
83
        (ess-rep-regexp     regexp to-string nil nil verbose)
 
84
      (query-replace-regexp regexp to-string nil))))
 
85
 
 
86
 
70
87
(defun ess-revert-wisely ()
71
88
  "Revert from disk if file and buffer last modification times are different."
72
89
  (interactive)
73
 
; vc-revert-buffer acting strangely in Emacs 21.1
74
 
; commented out until a solution can be found
75
 
  (if (not (verify-visited-file-modtime (current-buffer)))
76
 
      (revert-buffer t t)))
 
90
 
 
91
; vc-revert-buffer acting strangely in Emacs 21.1; no longer used
 
92
 
 
93
; Long-winded Explanation
 
94
 
 
95
; Maybe I am being a little hard on 21.1, but it behaves differently.
 
96
; Basically, revert means roll-back.  But, for SAS purposes, you never
 
97
; really want to roll-back.  You want to refresh the buffer with the
 
98
; disk file which is being modified in the background.  So, we only
 
99
; roll-back when the date/time stamp of the file is newer than the buffer
 
100
; (technically, this is roll-ahead).
 
101
 
 
102
; However, I was supporting a version control system (RCS) when I originally
 
103
; wrote this function.  I added functionality so that the roll-back was
 
104
; performed by vc.  This worked fine until 21.1.  In 21.1 when you call this
 
105
; function with vc/CVS, it actually rolls-back to the prior version of the
 
106
; file rather than refreshing.  Apparently, it ignores the file on disk.
 
107
; This change actually makes some sense, but it isn't what we want.
 
108
 
 
109
  (if (not (verify-visited-file-modtime (current-buffer))) (progn
 
110
      (revert-buffer t t)
 
111
      t)
 
112
  nil))
77
113
 
78
114
;;      (cond ((and (fboundp 'vc-backend-deduce)
79
115
;;                (vc-backend-deduce (buffer-file-name))) (vc-revert-buffer))
118
154
;;        '(lambda ()
119
155
;;           (add-hook 'local-write-file-hooks 'nuke-trailing-whitespace)))
120
156
 
121
 
(defvar nuke-trailing-whitespace-p nil;disabled by default  'ask
122
 
  "*[Dis]activates (nuke-trailing-whitespace).
 
157
(defvar ess-nuke-trailing-whitespace-p nil;disabled by default  'ask
 
158
  "*[Dis]activates (ess-nuke-trailing-whitespace).
123
159
 Disabled if `nil'; if `t', it works unconditionally, otherwise,
124
160
 the user is queried.
125
161
 Note that setting the default to `t' may not be a good idea when you edit
126
162
 binary files!")
127
163
 
128
 
(defun nuke-trailing-whitespace ()
 
164
;;; MM: Newer Emacsen now have  delete-trailing-whitespace
 
165
;;; --  but no customization like  nuke-trailing-whitespace-p ..
 
166
(defun ess-nuke-trailing-whitespace ()
129
167
  "Nuke all trailing whitespace in the buffer.
130
168
Whitespace in this case is just spaces or tabs.
131
169
This is a useful function to put on write-file-hooks.
132
170
 
133
 
If the variable `nuke-trailing-whitespace-p' is `nil', this function is
 
171
If the variable `ess-nuke-trailing-whitespace-p' is `nil', this function is
134
172
disabled.  If `t', unreservedly strip trailing whitespace.
135
173
If not `nil' and not `t', query for each instance."
136
174
  (interactive)
142
180
 
143
181
          (t
144
182
           (and (not buffer-read-only)
145
 
                nuke-trailing-whitespace-p
 
183
                ess-nuke-trailing-whitespace-p
146
184
                (save-match-data
147
185
                  (save-excursion
148
186
                    (save-restriction
149
187
                      (widen)
150
188
                      (goto-char (point-min))
151
 
                      (cond ((eq nuke-trailing-whitespace-p t)
 
189
                      (cond ((eq ess-nuke-trailing-whitespace-p t)
152
190
                             (while (re-search-forward "[ \t]+$" (point-max) t)
153
191
                               (delete-region (match-beginning 0)
154
192
                                              (match-end 0))))
157
195
    ;; always return nil, in case this is on write-file-hooks.
158
196
    nil))
159
197
 
 
198
(defun ess-kermit-get (&optional ess-file-arg ess-dir-arg)
 
199
"Get a file with Kermit.  WARNING:  Experimental!  From your *shell*
 
200
buffer, start kermit and then log in to the remote machine.  Open
 
201
a file that starts with `ess-kermit-prefix'.  From that buffer,
 
202
execute this command.  It will retrieve a file from the remote
 
203
directory that you specify with the same name, but without the
 
204
`ess-kermit-prefix'."
 
205
 
 
206
    (interactive)
 
207
 
 
208
;;     (save-match-data
 
209
       (let ((ess-temp-file (if ess-file-arg ess-file-arg (buffer-name)))
 
210
             (ess-temp-file-remote-directory ess-dir-arg))
 
211
 
 
212
        (if (string-equal ess-kermit-prefix (substring ess-temp-file 0 1))
 
213
          (progn
 
214
;; I think there is a bug in the buffer-local variable handling in GNU Emacs 21.3
 
215
;; Setting ess-kermit-remote-directory every time is somehow resetting it to the
 
216
;; default on the second pass.  So, here's a temporary work-around.  It will fail
 
217
;; if you change the default, so maybe this variable should not be customizable.
 
218
;; In any case, there is also trouble with local variables in XEmacs 21.4.9 and
 
219
;; 21.4.10.  XEmacs 21.4.8 is fine.
 
220
            (if ess-temp-file-remote-directory
 
221
                (setq ess-kermit-remote-directory ess-temp-file-remote-directory)
 
222
 
 
223
                (if (string-equal "." ess-kermit-remote-directory)
 
224
                    (setq ess-kermit-remote-directory (read-string "Remote directory to transfer file from: "
 
225
                    ess-kermit-remote-directory))))
 
226
 
 
227
          (setq ess-temp-file-remote-directory ess-kermit-remote-directory)
 
228
;;        (setq ess-temp-file (substring ess-temp-file (match-end 0)))
 
229
          (ess-sas-goto-shell)
 
230
          (insert "cd " ess-temp-file-remote-directory "; " ess-kermit-command " -s "
 
231
            (substring ess-temp-file 1) " -a " ess-temp-file)
 
232
          (comint-send-input)
 
233
;;          (insert (read-string "Press Return to connect to Kermit: " nil nil "\C-\\c"))
 
234
;;        (comint-send-input)
 
235
;;        (insert (read-string "Press Return when Kermit is ready to recieve: " nil nil
 
236
;;                (concat "receive ]" ess-sas-temp-file)))
 
237
;;        (comint-send-input)
 
238
;;        (insert (read-string "Press Return when transfer is complete: " nil nil "c"))
 
239
;;        (comint-send-input)
 
240
          (insert (read-string "Press Return when shell is ready: "))
 
241
          (comint-send-input)
 
242
          (switch-to-buffer (find-buffer-visiting ess-temp-file))
 
243
          (ess-revert-wisely)
 
244
))))
 
245
 
 
246
(defun ess-kermit-send ()
 
247
"Send a file with Kermit.  WARNING:  Experimental!  From
 
248
a file that starts with `ess-kermit-prefix',
 
249
execute this command.  It will transfer this file to the remote
 
250
directory with the same name, but without the `ess-kermit-prefix'."
 
251
 
 
252
    (interactive)
 
253
 
 
254
;;     (save-match-data
 
255
       (let ((ess-temp-file (expand-file-name (buffer-name)))
 
256
             (ess-temp-file-remote-directory nil))
 
257
 
 
258
        (if (string-equal ess-kermit-prefix (substring (file-name-nondirectory ess-temp-file) 0 1))
 
259
          (progn
 
260
;; I think there is a bug in the buffer-local variable handling in GNU Emacs 21.3
 
261
;; Setting ess-kermit-remote-directory every time is somehow resetting it to the
 
262
;; default on the second pass.  Here's a temporary work-around.  It will fail
 
263
;; if you change the default, so maybe this variable should not be customizable.
 
264
;; In any case, there is also trouble with local variables in XEmacs 21.4.9 and
 
265
;; 21.4.10.  XEmacs 21.4.8 is fine.
 
266
            (if (string-equal "." ess-kermit-remote-directory)
 
267
                (setq ess-kermit-remote-directory (read-string "Remote directory to transfer file to: "
 
268
                    ess-kermit-remote-directory)))
 
269
 
 
270
          (setq ess-temp-file-remote-directory ess-kermit-remote-directory)
 
271
 
 
272
;;        (setq ess-temp-file (substring ess-temp-file (match-end 0)))
 
273
          (ess-sas-goto-shell)
 
274
          (insert "cd " ess-temp-file-remote-directory "; " ess-kermit-command " -a "
 
275
            (substring (file-name-nondirectory ess-temp-file) 1) " -g "  ess-temp-file)
 
276
          (comint-send-input)
 
277
;;          (insert (read-string "Press Return to connect to Kermit: " nil nil "\C-\\c"))
 
278
;;        (comint-send-input)
 
279
;;        (insert (read-string "Press Return when Kermit is ready to recieve: " nil nil
 
280
;;                (concat "receive ]" ess-sas-temp-file)))
 
281
;;        (comint-send-input)
 
282
;;        (insert (read-string "Press Return when transfer is complete: " nil nil "c"))
 
283
;;        (comint-send-input)
 
284
          (insert (read-string "Press Return when shell is ready: "))
 
285
          (comint-send-input)
 
286
          (switch-to-buffer (find-buffer-visiting ess-temp-file))
 
287
          (ess-revert-wisely)
 
288
))))
 
289
 
 
290
(defun ess-search-except (regexp &optional except backward)
 
291
  "Search for a regexp, store as match 1, optionally ignore
 
292
strings that match exceptions."
 
293
  (interactive)
 
294
 
 
295
  (let ((continue t) (exit nil))
 
296
 
 
297
    (while continue
 
298
      (if (or (and backward (search-backward-regexp regexp nil t))
 
299
              (and (not backward) (search-forward-regexp regexp nil t)))
 
300
          (progn
 
301
            (setq exit (match-string 1))
 
302
            (setq continue (and except (string-match except exit)))
 
303
            (if continue (setq exit nil)))
 
304
        ;;else
 
305
        (setq continue nil))
 
306
      )
 
307
 
 
308
    exit))
 
309
 
 
310
(defun ess-save-and-set-local-variables ()
 
311
  "If buffer was modified, save file and set Local Variables if defined.
 
312
Return t if buffer was modified, nil otherwise."
 
313
  (interactive)
 
314
 
 
315
  (let ((ess-temp-point (point))
 
316
        (ess-temp-return-value (buffer-modified-p)))
 
317
    ;; if buffer has changed, save buffer now (before potential revert)
 
318
    (if ess-temp-return-value (save-buffer))
 
319
 
 
320
    ;; If Local Variables are defined, update them now
 
321
    ;; since they may have changed since the last revert
 
322
    ;;  (save-excursion
 
323
    (beginning-of-line -1)
 
324
    (save-match-data
 
325
      (if (search-forward "End:" nil t) (revert-buffer t t)))
 
326
    ;; save-excursion doesn't save point in the presence of a revert
 
327
    ;; so you need to do it yourself
 
328
    (goto-char ess-temp-point)
 
329
 
 
330
    ess-temp-return-value))
 
331
 
 
332
(defun ess-get-file-or-buffer (file-or-buffer)
 
333
  "Return file-or-buffer if it is a buffer; otherwise return the buffer
 
334
associated with the file which must be qualified by it's path; if the
 
335
buffer does not exist, return nil."
 
336
  (interactive)
 
337
 
 
338
  (if file-or-buffer
 
339
      (if (bufferp file-or-buffer) file-or-buffer
 
340
        (find-buffer-visiting file-or-buffer))))
 
341
 
 
342
(defun ess-set-local-variables (alist &optional file-or-buffer)
 
343
"Set local variables from ALIST in current buffer; if file-or-buffer
 
344
is specified, perform action in that buffer."
 
345
(interactive)
 
346
 
 
347
  (if file-or-buffer (set-buffer (ess-get-file-or-buffer file-or-buffer)))
 
348
 
 
349
  (mapcar (lambda (pair)
 
350
            (make-local-variable (car pair))
 
351
            (set (car pair) (eval (cdr pair))))
 
352
          alist))
 
353
 
 
354
(defun ess-clone-local-variables (from-file-or-buffer &optional to-file-or-buffer)
 
355
"Clone local variables from one buffer to another buffer, current buffer if nil."
 
356
    (interactive)
 
357
 
 
358
    (ess-set-local-variables
 
359
        (ess-sas-create-local-variables-alist from-file-or-buffer)
 
360
            to-file-or-buffer))
 
361
 
 
362
(defun ess-directory-sep (ess-dir-arg)
 
363
"Deprecated.  Use file-name-as-directory instead.
 
364
Given a directory, pad with directory-separator character, if necessary."
 
365
(let ((ess-tmp-dir-last-char (substring ess-dir-arg -1)))
 
366
    (if (or (equal ess-tmp-dir-last-char "/")
 
367
        (and ess-microsoft-p (equal ess-tmp-dir-last-char "\\")))
 
368
    ess-dir-arg
 
369
    (concat ess-dir-arg (if ess-microsoft-p "\\" "/")))))
 
370
 
 
371
(defun ess-return-list (ess-arg)
 
372
"Given an item, if it is a list return it, otherwise return item in a list."
 
373
(if (listp ess-arg) ess-arg (list ess-arg)))
 
374
 
 
375
(defun ess-find-exec (ess-root-arg ess-root-dir)
 
376
"Given a root directory and the root of an executable file name, find it's full
 
377
name and path, if it exists, anywhere in the sub-tree."
 
378
  (let* ((ess-tmp-dirs (directory-files ess-root-dir t "^[^.]"))
 
379
         (ess-tmp-return (ess-find-exec-completions ess-root-arg ess-root-dir))
 
380
         (ess-tmp-dirs-n (length ess-tmp-dirs))
 
381
         (ess-tmp-dir nil)
 
382
         (i 0))
 
383
 
 
384
        (while (< i ess-tmp-dirs-n)
 
385
            (setq ess-tmp-dir (nth i ess-tmp-dirs))
 
386
            (setq i (+ i 1))
 
387
            (if (file-directory-p ess-tmp-dir)
 
388
                (setq ess-tmp-return (nconc ess-tmp-return
 
389
                    (ess-find-exec ess-root-arg ess-tmp-dir)))))
 
390
    ess-tmp-return))
 
391
 
 
392
(defun ess-find-exec-completions (ess-root-arg &optional ess-exec-dir)
 
393
"Given the root of an executable file name, find all possible completions,
 
394
if any exist, in PATH."
 
395
  (let* ((ess-exec-path
 
396
         (if ess-exec-dir (ess-return-list ess-exec-dir) exec-path))
 
397
        (ess-tmp-exec nil)
 
398
        (ess-tmp-path-count (length ess-exec-path))
 
399
        (ess-tmp-dir nil)
 
400
        (ess-tmp-files nil)
 
401
        (ess-tmp-file nil)
 
402
        (i 0) (j 0) (k 0))
 
403
 
 
404
        (while (< i ess-tmp-path-count)
 
405
            (setq ess-tmp-dir (nth i ess-exec-path))
 
406
            (if (file-exists-p ess-tmp-dir) (progn
 
407
                (setq ess-tmp-files (file-name-all-completions ess-root-arg ess-tmp-dir))
 
408
                (setq j 0)
 
409
                (setq k (length ess-tmp-files))
 
410
                (while (< j k)
 
411
                    (setq ess-tmp-file (concat (file-name-as-directory ess-tmp-dir)
 
412
                        (nth j ess-tmp-files)))
 
413
                    (if (and (file-executable-p ess-tmp-file)
 
414
                             (not (file-directory-p ess-tmp-file)))
 
415
                        (setq ess-tmp-exec (nconc ess-tmp-exec (list ess-tmp-file))))
 
416
                    (setq j (+ j 1)))))
 
417
        (setq i (+ i 1)))
 
418
    ess-tmp-exec))
 
419
 
 
420
;; (defun ess-uniq-list (items)
 
421
;;   "Remove all duplicate strings from the list ITEMS."
 
422
;;   ;; build up a new-list, only adding an item from ITEMS if it is not
 
423
;;   ;; already present in new-list.
 
424
;;   (let (new-list)
 
425
;;     (while items
 
426
;;       (if (not (member (car items) new-list))
 
427
;;        (setq new-list (cons (car items) new-list)))
 
428
;;       (setq items (cdr items)))
 
429
;;     new-list
 
430
;;     ))
 
431
 
 
432
;; Copyright (C) 1994 Simon Marshall.
 
433
;; Author: Simon Marshall <Simon.Marshall@mail.esrin.esa.it>
 
434
;; LCD Archive Entry:
 
435
;; unique|Simon Marshall|Simon.Marshall@mail.esrin.esa.it|
 
436
;; Functions and commands to uniquify lists or buffer text (cf. sort).
 
437
;; 23-Apr-1994|1.00|~/packages/unique.el.Z|
 
438
;;
 
439
;; MM: renamed from 'unique' to
 
440
(defun ess-unique (list predicate)
 
441
  "Uniquify LIST, stably, deleting elements using PREDICATE.
 
442
Return the list with subsequent duplicate items removed by side effects.
 
443
PREDICATE is called with an element of LIST and a list of elements from LIST,
 
444
and should return the list of elements with occurrences of the element removed.
 
445
This function will work even if LIST is unsorted.  See also `uniq'."
 
446
  (let ((list list))
 
447
    (while list
 
448
      (setq list (setcdr list (funcall predicate (car list) (cdr list))))))
 
449
  list)
 
450
(defun ess-uniq-list (items)
 
451
  "Delete all duplicate entries in ITEMS list, calling `ess-unique'."
 
452
  (ess-unique items 'delete))
 
453
 
 
454
 
 
455
(defun ess-flatten-list (&rest list)
 
456
  "Take the arguments and flatten them into one long list."
 
457
  ;; Taken from lpr.el
 
458
  ;; `lpr-flatten-list' is defined here (copied from "message.el" and
 
459
  ;; enhanced to handle dotted pairs as well) until we can get some
 
460
  ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
 
461
 
 
462
  ;; (ess-flatten-list '((a . b) c (d . e) (f g h) i . j))
 
463
  ;; => (a b c d e f g h i j)
 
464
  (ess-flatten-list-1 list))
 
465
 
 
466
(defun ess-flatten-list-1 (list)
 
467
  (cond
 
468
   ((null list) (list))
 
469
   ((consp list)
 
470
    (append (ess-flatten-list-1 (car list))
 
471
            (ess-flatten-list-1 (cdr list))))
 
472
   (t (list list))))
 
473
 
 
474
(defun ess-delete-blank-lines ()
 
475
  "Convert 2 or more lines of white space into one."
 
476
    (interactive)
 
477
    (save-excursion
 
478
        (goto-char (point-min))
 
479
        (save-match-data
 
480
            (while (search-forward-regexp "^[ \t]*\n[ \t]*\n" nil t)
 
481
              ;;(goto-char (match-beginning 0))
 
482
                    (delete-blank-lines)))))
 
483
 
 
484
(defun ess-do-auto-fill ()
 
485
  "This is the same as \\[do-auto-fill] in GNU emacs 21.3, with one major
 
486
difference: if we could not find a suitable place to break the line,
 
487
we simply do not break it (instead of breaking after the first word)."
 
488
  (let (fc justify bol give-up
 
489
           (fill-prefix fill-prefix))
 
490
    (if (or (not (setq justify (current-justification)))
 
491
            (null (setq fc (current-fill-column)))
 
492
            (and (eq justify 'left)
 
493
                 (<= (current-column) fc))
 
494
            (save-excursion (beginning-of-line)
 
495
                            (setq bol (point))
 
496
                            (and auto-fill-inhibit-regexp
 
497
                                 (looking-at auto-fill-inhibit-regexp))))
 
498
        nil ;; Auto-filling not required
 
499
      (if (memq justify '(full center right))
 
500
          (save-excursion (unjustify-current-line)))
 
501
 
 
502
      ;; Choose a fill-prefix automatically.
 
503
      (if (and adaptive-fill-mode
 
504
               (or (null fill-prefix) (string= fill-prefix "")))
 
505
          (let ((prefix
 
506
                 (fill-context-prefix
 
507
                  (save-excursion (backward-paragraph 1) (point))
 
508
                  (save-excursion (forward-paragraph 1) (point)))))
 
509
            (and prefix (not (equal prefix ""))
 
510
                 (setq fill-prefix prefix))))
 
511
 
 
512
      (while (and (not give-up) (> (current-column) fc))
 
513
        ;; Determine where to split the line.
 
514
        (let* (after-prefix
 
515
               (fill-point
 
516
                (let ((opoint (point))
 
517
                      bounce
 
518
                      (first t))
 
519
                  (save-excursion
 
520
                    (beginning-of-line)
 
521
                    (setq after-prefix (point))
 
522
                    (and fill-prefix
 
523
                         (looking-at (regexp-quote fill-prefix))
 
524
                         (setq after-prefix (match-end 0)))
 
525
                    (move-to-column (1+ fc))
 
526
                    ;; Move back to the point where we can break the line.
 
527
                    ;; We break the line between word or
 
528
                    ;; after/before the character which has character
 
529
                    ;; category `|'.  We search space, \c| followed by
 
530
                    ;; a character, or \c| following a character.  If
 
531
                    ;; not found, place the point at beginning of line.
 
532
                    (while (or first
 
533
                               ;; If this is after period and a single space,
 
534
                               ;; move back once more--we don't want to break
 
535
                               ;; the line there and make it look like a
 
536
                               ;; sentence end.
 
537
                               (and (not (bobp))
 
538
                                    (not bounce)
 
539
                                    sentence-end-double-space
 
540
                                    (save-excursion (forward-char -1)
 
541
                                                    (and (looking-at "\\. ")
 
542
                                                         (not (looking-at "\\.  ")))))
 
543
                               (and (not (bobp))
 
544
                                    (not bounce)
 
545
                                    fill-nobreak-predicate
 
546
                                    (funcall fill-nobreak-predicate)))
 
547
                      (setq first nil)
 
548
                      (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
 
549
                      ;; If we find nowhere on the line to break it,
 
550
                      ;; do not break it.  Set bounce to t
 
551
                      ;; so we will not keep going in this while loop.
 
552
                      (if (<= (point) after-prefix)
 
553
                          (setq bounce t)
 
554
                        (if (looking-at "[ \t]")
 
555
                            ;; Break the line at word boundary.
 
556
                            (skip-chars-backward " \t")
 
557
                          ;; Break the line after/before \c|.
 
558
                          (forward-char 1))))
 
559
                    (if enable-multibyte-characters
 
560
                        ;; If we are going to break the line after or
 
561
                        ;; before a non-ascii character, we may have
 
562
                        ;; to run a special function for the charset
 
563
                        ;; of the character to find the correct break
 
564
                        ;; point.
 
565
                        (if (not (and (eq (charset-after (1- (point))) 'ascii)
 
566
                                      (eq (charset-after (point)) 'ascii)))
 
567
                            (fill-find-break-point after-prefix)))
 
568
 
 
569
                    ;; Let fill-point be set to the place where we end up.
 
570
                    ;; But move back before any whitespace here.
 
571
                    (skip-chars-backward " \t")
 
572
                    (point)))))
 
573
 
 
574
          ;; See whether the place we found is any good.
 
575
          (if (save-excursion
 
576
                (goto-char fill-point)
 
577
                (and (not (bolp))
 
578
                     ;; There is no use breaking at end of line.
 
579
                     (not (save-excursion (skip-chars-forward " ") (eolp)))
 
580
                     ;; It is futile to split at the end of the prefix
 
581
                     ;; since we would just insert the prefix again.
 
582
                     (not (and after-prefix (<= (point) after-prefix)))
 
583
                     ;; Don't split right after a comment starter
 
584
                     ;; since we would just make another comment starter.
 
585
                     (not (and comment-start-skip
 
586
                               (let ((limit (point)))
 
587
                                 (beginning-of-line)
 
588
                                 (and (re-search-forward comment-start-skip
 
589
                                                         limit t)
 
590
                                      (eq (point) limit)))))))
 
591
              ;; Ok, we have a useful place to break the line.  Do it.
 
592
              (let ((prev-column (current-column)))
 
593
                ;; If point is at the fill-point, do not `save-excursion'.
 
594
                ;; Otherwise, if a comment prefix or fill-prefix is inserted,
 
595
                ;; point will end up before it rather than after it.
 
596
                (if (save-excursion
 
597
                      (skip-chars-backward " \t")
 
598
                      (= (point) fill-point))
 
599
                    (funcall comment-line-break-function t)
 
600
                  (save-excursion
 
601
                    (goto-char fill-point)
 
602
                    (funcall comment-line-break-function t)))
 
603
                ;; Now do justification, if required
 
604
                (if (not (eq justify 'left))
 
605
                    (save-excursion
 
606
                      (end-of-line 0)
 
607
                      (justify-current-line justify nil t)))
 
608
                ;; If making the new line didn't reduce the hpos of
 
609
                ;; the end of the line, then give up now;
 
610
                ;; trying again will not help.
 
611
                (if (>= (current-column) prev-column)
 
612
                    (setq give-up t)))
 
613
            ;; No good place to break => stop trying.
 
614
            (setq give-up t))))
 
615
      ;; Justify last line.
 
616
      (justify-current-line justify t t)
 
617
      t)))
 
618
 
160
619
(provide 'ess-utils)