ESS[SAS]: somebody forgot about the SUM statement (probably me)
[ess.git] / lisp / ess-utils.el
blobfbf75a9ea88558b133502e4e49578029e8388f1f
1 ;;; ess-utils.el --- General Emacs utility functions used by ESS
3 ;; Copyright (C) 1998--2005 A.J. Rossini, Rich M. Heiberger, Martin
4 ;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
6 ;; Original Author: Martin Maechler <maechler@stat.math.ethz.ch>
7 ;; Created: 9 Sept 1998
8 ;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
10 ;; This file is part of ESS (Emacs Speaks Statistics).
12 ;; This file is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
17 ;; This file is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;;;-- Emacs Utilities --- Generally useful --- used by (but not requiring) ESS
28 (defun ess-inside-string-or-comment-p (pos)
29 "Return non-nil if POSition [defaults to (point)] is inside string or comment
30 (according to syntax). NOT OKAY for multi-line comments!!"
31 ;;FIXME (defun S-calculate-indent ..) in ./essl-s.el can do that ...
32 (interactive "d");point by default
33 (let ((pps (save-excursion
34 (parse-partial-sexp
35 (save-excursion (beginning-of-line) (point))
36 pos))))
37 (or (nth 3 pps) (nth 4 pps)))); 3: string, 4: comment
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)))))
45 ;; simple alternative to ess-read-object-name-default of ./ess-inf.el :
46 ;; is "wrongly" returning "p1" for word "p1.part2" :
47 (defun ess-extract-word-name ()
48 "Get the word you're on (cheap algorithm). Use `ess-read-object-name-default'
49 for a better but slower version."
50 (save-excursion
51 (re-search-forward "\\<\\w+\\>" nil t)
52 (buffer-substring (match-beginning 0) (match-end 0))))
54 (defun ess-rep-regexp (regexp to-string &optional fixedcase literal verbose)
55 "Instead of (replace-regexp..) -- do NOT replace in strings or comments.
56 If FIXEDCASE is non-nil, do *not* alter case of replacement text.
57 If LITERAL is non-nil, do *not* treat `\\' as special.
58 If VERBOSE is non-nil, (message ..) about replacements."
59 (let ((case-fold-search (and case-fold-search
60 (not fixedcase))); t <==> ignore case in search
61 (pl) (p))
62 (while (setq p (re-search-forward regexp nil t))
63 (cond ((not (ess-inside-string-or-comment-p (1- p)))
64 (if verbose
65 (let ((beg (match-beginning 0)))
66 (message "(beg,p)= (%d,%d) = %s"
67 beg p (buffer-substring beg p) )))
68 (replace-match to-string fixedcase literal)
69 ;;or (if verbose (setq pl (append pl (list p))))
70 )))
71 ;;or (if (and verbose pl)
72 ;;or (message "s/%s/%s/ at %s" regexp to-string pl))
73 ) )
75 (defun ess-replace-regexp-dump-to-src
76 (regexp to-string &optional dont-query verbose ensure-mode)
77 "Depending on dont-query, call `ess-rep-regexp' or `query-replace-regexp'
78 from the beginning of the buffer."
79 (save-excursion
80 (if (and ensure-mode
81 (not (equal major-mode 'ess-mode)))
82 (ess-mode))
83 (goto-char (point-min))
84 (if dont-query
85 (ess-rep-regexp regexp to-string nil nil verbose)
86 (query-replace-regexp regexp to-string nil))))
89 (defun ess-revert-wisely ()
90 "Revert from disk if file and buffer last modification times are different."
91 (interactive)
93 ; vc-revert-buffer acting strangely in Emacs 21.1; no longer used
95 ; Long-winded Explanation
97 ; Maybe I am being a little hard on 21.1, but it behaves differently.
98 ; Basically, revert means roll-back. But, for SAS purposes, you never
99 ; really want to roll-back. You want to refresh the buffer with the
100 ; disk file which is being modified in the background. So, we only
101 ; roll-back when the date/time stamp of the file is newer than the buffer
102 ; (technically, this is roll-ahead).
104 ; However, I was supporting a version control system (RCS) when I originally
105 ; wrote this function. I added functionality so that the roll-back was
106 ; performed by vc. This worked fine until 21.1. In 21.1 when you call this
107 ; function with vc/CVS, it actually rolls-back to the prior version of the
108 ; file rather than refreshing. Apparently, it ignores the file on disk.
109 ; This change actually makes some sense, but it isn't what we want.
111 ; Long-winded Explanation Ends (no longer interesting, will remove soon)
113 ; whether or not a revert is needed, force load local variables
114 ; for example, suppose that you change the local variables and then
115 ; save the file, a revert is unneeded, but a force load is
116 (hack-local-variables)
118 (if (not (verify-visited-file-modtime (current-buffer))) (progn
119 (revert-buffer t t)
121 nil))
123 ;; (cond ((and (fboundp 'vc-backend-deduce)
124 ;; (vc-backend-deduce (buffer-file-name))) (vc-revert-buffer))
125 ;; ((and (fboundp 'vc-backend)
126 ;; (vc-backend (buffer-file-name))) (vc-revert-buffer))
127 ;; (t (revert-buffer t t)))))
129 (defun ess-space-around (word &optional from verbose)
130 "Replace-regexp .. ensuring space around all occurences of WORD,
131 starting from FROM {defaults to (point)}."
132 (interactive "d\nP"); Defaults: point and prefix (C-u)
133 (save-excursion
134 (goto-char from)
135 (ess-rep-regexp (concat "\\([^ \t\n]\\)\\(\\<" word "\\>\\)")
136 "\\1 \\2" nil nil verbose)
137 (goto-char from)
138 (ess-rep-regexp (concat "\\(\\<" word "\\>\\)\\([^ \t\n]\\)")
139 "\\1 \\2" nil nil verbose)
143 (defun ess-time-string (&optional clock)
144 "Returns a string for use as a timestamp. + hr:min if CLOCK is non-nil,
145 like \"13 Mar 1992\". Redefine to taste."
146 (format-time-string (concat "%e %b %Y" (if clock ", %H:%M"))))
149 ;;- From: friedman@gnu.ai.mit.edu (Noah Friedman)
150 ;;- Date: 12 Feb 1995 21:30:56 -0500
151 ;;- Newsgroups: gnu.emacs.sources
152 ;;- Subject: nuke-trailing-whitespace
154 ;;- This is too trivial to make into a big todo with comments and copyright
155 ;;- notices whose length exceed the size of the actual code, so consider it
156 ;;- public domain. Its purpose is along similar lines to that of
157 ;;- `require-final-newline', which is built in. I hope the names make it
158 ;;- obvious.
160 ;; (add-hook 'write-file-hooks 'nuke-trailing-whitespace)
161 ;;or at least
162 ;; (add-hook 'ess-mode-hook
163 ;; '(lambda ()
164 ;; (add-hook 'local-write-file-hooks 'nuke-trailing-whitespace)))
166 (defvar ess-nuke-trailing-whitespace-p nil;disabled by default 'ask
167 "*[Dis]activates (ess-nuke-trailing-whitespace).
168 Disabled if `nil'; if `t', it works unconditionally, otherwise,
169 the user is queried.
170 Note that setting the default to `t' may not be a good idea when you edit
171 binary files!")
173 ;;; MM: Newer Emacsen now have delete-trailing-whitespace
174 ;;; -- but no customization like nuke-trailing-whitespace-p ..
175 (defun ess-nuke-trailing-whitespace ()
176 "Nuke all trailing whitespace in the buffer.
177 Whitespace in this case is just spaces or tabs.
178 This is a useful function to put on write-file-hooks.
180 If the variable `ess-nuke-trailing-whitespace-p' is `nil', this function is
181 disabled. If `t', unreservedly strip trailing whitespace.
182 If not `nil' and not `t', query for each instance."
183 (interactive)
184 (let ((bname (buffer-name)))
185 (cond ((or
186 (string= major-mode "rmail-mode")
187 (string= bname "RMAIL")
188 nil)); do nothing..
191 (and (not buffer-read-only)
192 ess-nuke-trailing-whitespace-p
193 (save-match-data
194 (save-excursion
195 (save-restriction
196 (widen)
197 (goto-char (point-min))
198 (cond ((eq ess-nuke-trailing-whitespace-p t)
199 (while (re-search-forward "[ \t]+$" (point-max) t)
200 (delete-region (match-beginning 0)
201 (match-end 0))))
203 (query-replace-regexp "[ \t]+$" "")))))))))
204 ;; always return nil, in case this is on write-file-hooks.
205 nil))
207 (defun ess-kermit-get (&optional ess-file-arg ess-dir-arg)
208 "Get a file with Kermit. WARNING: Experimental! From your *shell*
209 buffer, start kermit and then log in to the remote machine. Open
210 a file that starts with `ess-kermit-prefix'. From that buffer,
211 execute this command. It will retrieve a file from the remote
212 directory that you specify with the same name, but without the
213 `ess-kermit-prefix'."
215 (interactive)
217 ;; (save-match-data
218 (let ((ess-temp-file (if ess-file-arg ess-file-arg (buffer-name)))
219 (ess-temp-file-remote-directory ess-dir-arg))
221 (if (string-equal ess-kermit-prefix (substring ess-temp-file 0 1))
222 (progn
223 ;; I think there is a bug in the buffer-local variable handling in GNU Emacs 21.3
224 ;; Setting ess-kermit-remote-directory every time is somehow resetting it to the
225 ;; default on the second pass. So, here's a temporary work-around. It will fail
226 ;; if you change the default, so maybe this variable should not be customizable.
227 ;; In any case, there is also trouble with local variables in XEmacs 21.4.9 and
228 ;; 21.4.10. XEmacs 21.4.8 is fine.
229 (if ess-temp-file-remote-directory
230 (setq ess-kermit-remote-directory ess-temp-file-remote-directory)
232 (if (string-equal "." ess-kermit-remote-directory)
233 (setq ess-kermit-remote-directory (read-string "Remote directory to transfer file from: "
234 ess-kermit-remote-directory))))
236 (setq ess-temp-file-remote-directory ess-kermit-remote-directory)
237 ;; (setq ess-temp-file (substring ess-temp-file (match-end 0)))
238 (ess-sas-goto-shell)
239 (insert "cd " ess-temp-file-remote-directory "; " ess-kermit-command " -s "
240 (substring ess-temp-file 1) " -a " ess-temp-file)
241 (comint-send-input)
242 ;; (insert (read-string "Press Return to connect to Kermit: " nil nil "\C-\\c"))
243 ;; (comint-send-input)
244 ;; (insert (read-string "Press Return when Kermit is ready to recieve: " nil nil
245 ;; (concat "receive ]" ess-sas-temp-file)))
246 ;; (comint-send-input)
247 ;; (insert (read-string "Press Return when transfer is complete: " nil nil "c"))
248 ;; (comint-send-input)
249 (insert (read-string "Press Return when shell is ready: "))
250 (comint-send-input)
251 (switch-to-buffer (find-buffer-visiting ess-temp-file))
252 (ess-revert-wisely)
253 ))))
255 (defun ess-kermit-send ()
256 "Send a file with Kermit. WARNING: Experimental! From
257 a file that starts with `ess-kermit-prefix',
258 execute this command. It will transfer this file to the remote
259 directory with the same name, but without the `ess-kermit-prefix'."
261 (interactive)
263 ;; (save-match-data
264 (let ((ess-temp-file (expand-file-name (buffer-name)))
265 (ess-temp-file-remote-directory nil))
267 (if (string-equal ess-kermit-prefix (substring (file-name-nondirectory ess-temp-file) 0 1))
268 (progn
269 ;; I think there is a bug in the buffer-local variable handling in GNU Emacs 21.3
270 ;; Setting ess-kermit-remote-directory every time is somehow resetting it to the
271 ;; default on the second pass. Here's a temporary work-around. It will fail
272 ;; if you change the default, so maybe this variable should not be customizable.
273 ;; In any case, there is also trouble with local variables in XEmacs 21.4.9 and
274 ;; 21.4.10. XEmacs 21.4.8 is fine.
275 (if (string-equal "." ess-kermit-remote-directory)
276 (setq ess-kermit-remote-directory (read-string "Remote directory to transfer file to: "
277 ess-kermit-remote-directory)))
279 (setq ess-temp-file-remote-directory ess-kermit-remote-directory)
281 ;; (setq ess-temp-file (substring ess-temp-file (match-end 0)))
282 (ess-sas-goto-shell)
283 (insert "cd " ess-temp-file-remote-directory "; " ess-kermit-command " -a "
284 (substring (file-name-nondirectory ess-temp-file) 1) " -g " ess-temp-file)
285 (comint-send-input)
286 ;; (insert (read-string "Press Return to connect to Kermit: " nil nil "\C-\\c"))
287 ;; (comint-send-input)
288 ;; (insert (read-string "Press Return when Kermit is ready to recieve: " nil nil
289 ;; (concat "receive ]" ess-sas-temp-file)))
290 ;; (comint-send-input)
291 ;; (insert (read-string "Press Return when transfer is complete: " nil nil "c"))
292 ;; (comint-send-input)
293 (insert (read-string "Press Return when shell is ready: "))
294 (comint-send-input)
295 (switch-to-buffer (find-buffer-visiting ess-temp-file))
296 (ess-revert-wisely)
297 ))))
299 (defun ess-search-except (regexp &optional except backward)
300 "Search for a regexp, store as match 1, optionally ignore
301 strings that match exceptions."
302 (interactive)
304 (let ((continue t) (exit nil))
306 (while continue
307 (if (or (and backward (search-backward-regexp regexp nil t))
308 (and (not backward) (search-forward-regexp regexp nil t)))
309 (progn
310 (setq exit (match-string 1))
311 (setq continue (and except (string-match except exit)))
312 (if continue (setq exit nil)))
313 ;;else
314 (setq continue nil))
317 exit))
319 (defun ess-save-and-set-local-variables ()
320 "If buffer was modified, save file and set Local Variables if defined.
321 Return t if buffer was modified, nil otherwise."
322 (interactive)
324 (let ((ess-temp-point (point))
325 (ess-temp-return-value (buffer-modified-p)))
326 ;; if buffer has changed, save buffer now (before potential revert)
327 (if ess-temp-return-value (save-buffer))
329 ;; If Local Variables are defined, update them now
330 ;; since they may have changed since the last revert
331 ;; (save-excursion
332 (beginning-of-line -1)
333 (save-match-data
334 (if (search-forward "End:" nil t) (revert-buffer t t)))
335 ;; save-excursion doesn't save point in the presence of a revert
336 ;; so you need to do it yourself
337 (goto-char ess-temp-point)
339 ess-temp-return-value))
341 (defun ess-get-file-or-buffer (file-or-buffer)
342 "Return file-or-buffer if it is a buffer; otherwise return the buffer
343 associated with the file which must be qualified by it's path; if the
344 buffer does not exist, return nil."
345 (interactive)
347 (if file-or-buffer
348 (if (bufferp file-or-buffer) file-or-buffer
349 (find-buffer-visiting file-or-buffer))))
351 (defun ess-set-local-variables (alist &optional file-or-buffer)
352 "Set local variables from ALIST in current buffer; if file-or-buffer
353 is specified, perform action in that buffer."
354 (interactive)
355 (if file-or-buffer (set-buffer (ess-get-file-or-buffer file-or-buffer)))
357 (mapcar (lambda (pair)
358 (make-local-variable (car pair))
359 (set (car pair) (eval (cdr pair))))
360 alist))
362 (defun ess-clone-local-variables (from-file-or-buffer
363 &optional to-file-or-buffer)
364 "Clone local variables from one buffer to another buffer."
365 (interactive)
366 (ess-set-local-variables
367 (ess-sas-create-local-variables-alist from-file-or-buffer)
368 to-file-or-buffer))
370 (defun ess-return-list (ess-arg)
371 "Given an item, if it is a list return it, else return item in a list."
372 (if (listp ess-arg) ess-arg (list ess-arg)))
374 (defun ess-find-exec (ess-root-arg ess-root-dir)
375 "Given a root directory and the root of an executable file name,
376 find it's full name and path, if it exists, anywhere in the sub-tree."
377 (let* ((ess-tmp-dirs (directory-files ess-root-dir t "^[^.]"))
378 (ess-tmp-return (ess-find-exec-completions ess-root-arg ess-root-dir))
379 (ess-tmp-dir nil))
381 (while ess-tmp-dirs
382 (setq ess-tmp-dir (car ess-tmp-dirs)
383 ess-tmp-dirs (cdr ess-tmp-dirs))
384 (if (file-accessible-directory-p ess-tmp-dir)
385 (setq ess-tmp-return
386 (nconc ess-tmp-return
387 (ess-find-exec ess-root-arg ess-tmp-dir)))))
388 ess-tmp-return))
390 (defun ess-find-exec-completions (ess-root-arg &optional ess-exec-dir)
391 "Given the root of an executable file name, find all possible completions.
392 Search for the executables in ESS-EXEC-DIR (which defaults to
393 `exec-path' if no value is given)."
394 (let* ((ess-exec-path
395 (if ess-exec-dir (ess-return-list ess-exec-dir) exec-path))
396 (ess-tmp-exec nil)
397 (ess-tmp-path-count (length ess-exec-path))
398 (ess-tmp-dir nil)
399 (ess-tmp-files nil)
400 (ess-tmp-file nil))
402 (while ess-exec-path
403 (setq ess-tmp-dir (car ess-exec-path)
404 ess-exec-path (cdr ess-exec-path))
405 (when
406 (and (> (length ess-tmp-dir) 0)
407 (file-accessible-directory-p ess-tmp-dir))
408 ;; the first test above excludes "" from exec-path, which can be
409 ;; problematic with Tramp.
410 (setq ess-tmp-files
411 (file-name-all-completions ess-root-arg ess-tmp-dir))
413 (while ess-tmp-files
414 (setq ess-tmp-file
415 (concat (file-name-as-directory ess-tmp-dir)
416 (car ess-tmp-files))
417 ess-tmp-files (cdr ess-tmp-files))
418 (if (and (file-executable-p ess-tmp-file)
419 (not (file-directory-p ess-tmp-file)))
420 ;; we have found a possible executable, so keep it.
421 (setq ess-tmp-exec
422 (nconc ess-tmp-exec (list ess-tmp-file)))))))
423 ess-tmp-exec))
425 ;; Copyright (C) 1994 Simon Marshall.
426 ;; Author: Simon Marshall <Simon.Marshall@mail.esrin.esa.it>
427 ;; LCD Archive Entry:
428 ;; unique|Simon Marshall|Simon.Marshall@mail.esrin.esa.it|
429 ;; Functions and commands to uniquify lists or buffer text (cf. sort).
430 ;; 23-Apr-1994|1.00|~/packages/unique.el.Z|
432 ;; MM: renamed from 'unique' to
433 (defun ess-unique (list predicate)
434 "Uniquify LIST, stably, deleting elements using PREDICATE.
435 Return the list with subsequent duplicate items removed by side effects.
436 PREDICATE is called with an element of LIST and a list of elements from LIST,
437 and should return the list of elements with occurrences of the element removed.
438 This function will work even if LIST is unsorted. See also `uniq'."
439 (let ((list list))
440 (while list
441 (setq list (setcdr list (funcall predicate (car list) (cdr list))))))
442 list)
444 (defun ess-uniq-list (items)
445 "Delete all duplicate entries in ITEMS list, calling `ess-unique'."
446 (ess-unique items 'delete))
448 (defun ess-drop-non-directories (file-strings)
449 "Drop all entries that do not \"look like\" directories."
450 (ess-flatten-list (mapcar 'file-name-directory file-strings)))
452 (defun ess-chop1 (string)
453 "chop last character; typically to remove trailing \"/\"."
454 (substring string 0 -1))
457 (defun ess-flatten-list (&rest list)
458 "Take the arguments and flatten them into one long list.
459 Drops 'nil' entries."
460 ;; Taken from lpr.el
461 ;; `lpr-flatten-list' is defined here (copied from "message.el" and
462 ;; enhanced to handle dotted pairs as well) until we can get some
463 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
465 ;; (ess-flatten-list '((a . b) c (d . e) (f g h) i . j))
466 ;; => (a b c d e f g h i j)
467 (ess-flatten-list-1 list))
469 (defun ess-flatten-list-1 (list)
470 (cond
471 ((null list) (list))
472 ((consp list)
473 (append (ess-flatten-list-1 (car list))
474 (ess-flatten-list-1 (cdr list))))
475 (t (list list))))
477 (defun ess-delete-blank-lines ()
478 "Convert 2 or more lines of white space into one."
479 (interactive)
480 (save-excursion
481 (goto-char (point-min))
482 (save-match-data
483 (while (search-forward-regexp "^[ \t]*\n[ \t]*\n" nil t)
484 ;;(goto-char (match-beginning 0))
485 (delete-blank-lines)))))
487 (defun ess-do-auto-fill ()
488 "This is the same as \\[do-auto-fill] in GNU emacs 21.3, with one major
489 difference: if we could not find a suitable place to break the line,
490 we simply do not break it (instead of breaking after the first word)."
491 (let (fc justify bol give-up
492 (fill-prefix fill-prefix))
493 (if (or (not (setq justify (current-justification)))
494 (null (setq fc (current-fill-column)))
495 (and (eq justify 'left)
496 (<= (current-column) fc))
497 (save-excursion (beginning-of-line)
498 (setq bol (point))
499 (and auto-fill-inhibit-regexp
500 (looking-at auto-fill-inhibit-regexp))))
501 nil ;; Auto-filling not required
502 (if (memq justify '(full center right))
503 (save-excursion (unjustify-current-line)))
505 ;; Choose a fill-prefix automatically.
506 (if (and adaptive-fill-mode
507 (or (null fill-prefix) (string= fill-prefix "")))
508 (let ((prefix
509 (fill-context-prefix
510 (save-excursion (backward-paragraph 1) (point))
511 (save-excursion (forward-paragraph 1) (point)))))
512 (and prefix (not (equal prefix ""))
513 (setq fill-prefix prefix))))
515 (while (and (not give-up) (> (current-column) fc))
516 ;; Determine where to split the line.
517 (let* (after-prefix
518 (fill-point
519 (let ((opoint (point))
520 bounce
521 (first t))
522 (save-excursion
523 (beginning-of-line)
524 (setq after-prefix (point))
525 (and fill-prefix
526 (looking-at (regexp-quote fill-prefix))
527 (setq after-prefix (match-end 0)))
528 (move-to-column (1+ fc))
529 ;; Move back to the point where we can break the line.
530 ;; We break the line between word or
531 ;; after/before the character which has character
532 ;; category `|'. We search space, \c| followed by
533 ;; a character, or \c| following a character. If
534 ;; not found, place the point at beginning of line.
535 (while (or first
536 ;; If this is after period and a single space,
537 ;; move back once more--we don't want to break
538 ;; the line there and make it look like a
539 ;; sentence end.
540 (and (not (bobp))
541 (not bounce)
542 sentence-end-double-space
543 (save-excursion (forward-char -1)
544 (and (looking-at "\\. ")
545 (not (looking-at "\\. ")))))
546 (and (not (bobp))
547 (not bounce)
548 fill-nobreak-predicate
549 (funcall fill-nobreak-predicate)))
550 (setq first nil)
551 (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
552 ;; If we find nowhere on the line to break it,
553 ;; do not break it. Set bounce to t
554 ;; so we will not keep going in this while loop.
555 (if (<= (point) after-prefix)
556 (setq bounce t)
557 (if (looking-at "[ \t]")
558 ;; Break the line at word boundary.
559 (skip-chars-backward " \t")
560 ;; Break the line after/before \c|.
561 (forward-char 1))))
562 (if enable-multibyte-characters
563 ;; If we are going to break the line after or
564 ;; before a non-ascii character, we may have
565 ;; to run a special function for the charset
566 ;; of the character to find the correct break
567 ;; point.
568 (if (not (and (eq (charset-after (1- (point))) 'ascii)
569 (eq (charset-after (point)) 'ascii)))
570 (fill-find-break-point after-prefix)))
572 ;; Let fill-point be set to the place where we end up.
573 ;; But move back before any whitespace here.
574 (skip-chars-backward " \t")
575 (point)))))
577 ;; See whether the place we found is any good.
578 (if (save-excursion
579 (goto-char fill-point)
580 (and (not (bolp))
581 ;; There is no use breaking at end of line.
582 (not (save-excursion (skip-chars-forward " ") (eolp)))
583 ;; It is futile to split at the end of the prefix
584 ;; since we would just insert the prefix again.
585 (not (and after-prefix (<= (point) after-prefix)))
586 ;; Don't split right after a comment starter
587 ;; since we would just make another comment starter.
588 (not (and comment-start-skip
589 (let ((limit (point)))
590 (beginning-of-line)
591 (and (re-search-forward comment-start-skip
592 limit t)
593 (eq (point) limit)))))))
594 ;; Ok, we have a useful place to break the line. Do it.
595 (let ((prev-column (current-column)))
596 ;; If point is at the fill-point, do not `save-excursion'.
597 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
598 ;; point will end up before it rather than after it.
599 (if (save-excursion
600 (skip-chars-backward " \t")
601 (= (point) fill-point))
602 (funcall comment-line-break-function t)
603 (save-excursion
604 (goto-char fill-point)
605 (funcall comment-line-break-function t)))
606 ;; Now do justification, if required
607 (if (not (eq justify 'left))
608 (save-excursion
609 (end-of-line 0)
610 (justify-current-line justify nil t)))
611 ;; If making the new line didn't reduce the hpos of
612 ;; the end of the line, then give up now;
613 ;; trying again will not help.
614 (if (>= (current-column) prev-column)
615 (setq give-up t)))
616 ;; No good place to break => stop trying.
617 (setq give-up t))))
618 ;; Justify last line.
619 (justify-current-line justify t t)
620 t)))
622 (defun ess-select-frame-set-input-focus (frame)
623 "Select FRAME, raise it, and set input focus, if possible.
624 Copied almost verbatim from gnus-utils.el (but with test for mac added)."
625 (cond ((featurep 'xemacs)
626 (raise-frame frame)
627 (select-frame frame)
628 (focus-frame frame))
629 ;; The function `select-frame-set-input-focus' won't set
630 ;; the input focus under Emacs 21.2 and X window system.
631 ;;((fboundp 'select-frame-set-input-focus)
632 ;; (defalias 'gnus-select-frame-set-input-focus
633 ;; 'select-frame-set-input-focus)
634 ;; (select-frame-set-input-focus frame))
636 (raise-frame frame)
637 (select-frame frame)
638 (cond ((and
639 (memq window-system '(x mac))
640 (fboundp 'x-focus-frame))
641 (x-focus-frame frame))
642 ((eq window-system 'w32)
643 (w32-focus-frame frame)))
644 (when focus-follows-mouse
645 (set-mouse-position frame (1- (frame-width frame)) 0)))))
647 (defun ess-sci-to-dec ()
648 "For BUGS/S family: Express +/-0.000E+/-0 or +/-0.0e+/-00 as a decimal."
649 (interactive)
650 (setq buffer-read-only nil)
651 (save-excursion (goto-char 0)
652 (save-match-data (let ((ess-temp-replacement-string nil)
653 (ess-temp-replacement-9 0)
654 (ess-temp-replacement-diff 0))
655 (while (search-forward-regexp "-?[0-9][.][0-9][0-9]?[0-9]?[Ee][+-][0-9][0-9]?" nil t)
656 (setq ess-temp-replacement-string
657 (int-to-string (string-to-number (match-string 0))))
658 (setq ess-temp-replacement-diff (- (match-end 0) (match-beginning 0)))
659 (save-match-data
660 (setq ess-temp-replacement-9
661 (string-match "99999999999$" ess-temp-replacement-string))
663 (if (not ess-temp-replacement-9)
664 (setq ess-temp-replacement-9
665 (string-match "000000000001$" ess-temp-replacement-string))))
667 (if ess-temp-replacement-9
668 (setq ess-temp-replacement-string
669 (substring ess-temp-replacement-string 0 ess-temp-replacement-9)))
671 (setq ess-temp-replacement-diff
672 (- ess-temp-replacement-diff (string-width ess-temp-replacement-string)))
674 (while (> ess-temp-replacement-diff 0)
675 (setq ess-temp-replacement-string (concat ess-temp-replacement-string " "))
676 (setq ess-temp-replacement-diff (- ess-temp-replacement-diff 1)))
678 (replace-match ess-temp-replacement-string))))))
680 (provide 'ess-utils)