diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 123 | ||||
| -rw-r--r-- | lisp/calendar/timeclock.el | 434 | ||||
| -rw-r--r-- | lisp/eshell/em-alias.el | 7 | ||||
| -rw-r--r-- | lisp/eshell/em-dirs.el | 6 | ||||
| -rw-r--r-- | lisp/eshell/em-glob.el | 5 | ||||
| -rw-r--r-- | lisp/eshell/em-ls.el | 74 | ||||
| -rw-r--r-- | lisp/eshell/em-script.el | 3 | ||||
| -rw-r--r-- | lisp/eshell/em-smart.el | 35 | ||||
| -rw-r--r-- | lisp/eshell/em-unix.el | 129 | ||||
| -rw-r--r-- | lisp/eshell/esh-cmd.el | 120 | ||||
| -rw-r--r-- | lisp/eshell/esh-groups.el | 1 | ||||
| -rw-r--r-- | lisp/eshell/esh-maint.el | 68 | ||||
| -rw-r--r-- | lisp/eshell/esh-mode.el | 11 | ||||
| -rw-r--r-- | lisp/eshell/esh-module.el | 6 | ||||
| -rw-r--r-- | lisp/eshell/esh-test.el | 8 | ||||
| -rw-r--r-- | lisp/eshell/esh-util.el | 14 | ||||
| -rw-r--r-- | lisp/textmodes/flyspell.el | 56 |
17 files changed, 809 insertions, 291 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 903612bed0b..706751d315a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,124 @@ +2000-10-28 John Wiegley <johnw@gnu.org> + + * textmodes/flyspell.el (flyspell-maybe-correct-transposition): + Changed this function to operate on a temporary buffer instead of + the main buffer. This not only keeps flyspell from marking a + buffer as changed that wasn't, but it solves the jumpy cursor + problem when attempts are made to edit incorrect words. + (flyspell-maybe-correct-doubling): Same change as for + `flyspell-maybe-correct-transposition'. + + * calendar/timeclock.el (timeclock-log): Doc fix. + (timeclock-last-event): Doc fix. + (timeclock-log): Kill the timelog buffer after appending a new + event. + (timeclock-find-discrep): Use a temp buffer to read in the + timelog, instead of visiting the file. + (timeclock-log-data): A new function, along with a host of helper + functions, for the purpose of making timelog data accessible to + programmers. + + * eshell/esh-mode.el (window-height test): Make certain that + `eshell-stringify-t' is non-nil. + (eshell-password-prompt-regexp): Changed to a much simpler + password regexp. + (eshell-send-input): If `eshell-invoke-directly' returns t, + directly invoke the parsed command using `eval'. This improves + turn-around time on simple commands by a factor of three or + greater, such as cd, ls, pwd, etc. -- which get used very often. + It also conserves thousands of cons cells per call (since + `eshell-do-eval' consumes memory like a Cookie Monster set loose + in the Pacific Cookie Company). + + * eshell/esh-test.el (eshell-test): Whitespace fix. + + * eshell/em-ls.el (eshell-ls-insert-directory): Make + `eshell-ls-initial-args' nil when inserting directory contents. + + * eshell/em-script.el (eshell-script-initialize): Add names to + `eshell-complex-commands, since `source' and `.' are complex. + + * eshell/esh-cmd.el (eshell-rewrite-for-command, + eshell-rewrite-while-command): Use `eshell-protect' instead of + `eshell-copy-handles'. + (eshell-rewrite-if-command): Use `eshell-protect' to wrap the call + bodies. + (eshell-separate-commands): Whitespace fix. + (eshell-complex-commands): Added a new list of names, for + determining whether a given command is as simple as it looks. + (eshell-invoke-directly): New function. Returns t if a command + should be invoked directly (using `eval'), rather than indirectly + using `eshell-do-eval'. + (eshell-do-eval): Whitespace fix. + + * eshell/em-unix.el (eshell-default-target-is-dot): New variable, + which provides an emulation of the DOS shell behavior of assuming + that cp/mv/ln should copy/move/link to the current directory. + (eshell-remove-entries): Added a doc string. + (eshell-shuffle-files): Removed the check for `target' being null. + (eshell-mvcp-template, eshell-mvcpln-template): Renamed + `eshell-mvcp-template' to `eshell-mvcpln-template', and extended + it to do a smarter check of whether a destination was provided. + (eshell/mv, eshell/cp): Enable `:preserve-args'. + (eshell/ln): Enable `:preserve-args', and use + `eshell-mvcpln-template' to implement the body of the function. + (eshell/cat, eshell/make, eshell-poor-mans-grep, eshell-grep, + eshell/du, eshell/diff, eshell/locate): Stringify the argument + list after flattening it. This makes it possible to cat files + with numerical names. + (eshell-unix-initialize): Added several names to + `eshell-complex-commands. + (eshell-unix-command-complex-p): Return t if a given command name + may result in external processes being invoked. + + * eshell/em-glob.el (eshell-glob-show-progress): Make this + variable nil by default, since it slows down glob processing by a + factor of two or more, and increases memory consumption. + + * eshell/em-smart.el: Added a note about how memory consumptive + smart display mode can be (at least this is true in Emacs 21). + (eshell-smart-initialize): Whitespace fix. + (eshell-refresh-windows): Use `if' instead of `when'. + (eshell-smart-scroll-window): Calling `save-current-buffer' was + not necessary. + (eshell-currently-handling-window): Added a missing global + variable. + + * eshell/em-ls.el (eshell-do-ls): Code simplification. + (eshell-ls-sort-entries, eshell-ls-entries, eshell-ls-dir): + Whitespace fix. + (eshell-ls-exclude-hidden): Added this variable in addition to + `eshell-ls-exclude-regexp'. This one prevents files beginning + with . from even being read, which can improve memory consumption + quite a bit. + (eshell-ls-dir): If `eshell-ls-exclude-hidden' is non-nil, do not + read file entries beginning with a dot. In home directories with + lots of hidden files, fully two-thirds of the time spent in ls is + used to read directory entries that are immediately thrown away. + (eshell-ls-initial-args): Added back this configuration variable, + for specifying default initial arguments to every call to ls. + Much faster than using an alias to do the same thing. + (eshell-do-ls): Use `eshell-ls-initial-args', if set. + (eshell-ls-dir): Whitespace change. + + * eshell/em-dirs.el (eshell/pwd): Small code simplification. + + * eshell/esh-util.el: Don't require `ange-ftp' if it's not + available. + (eshell-stringify-t): Added a customization variable, to indicate + whether `t' should be rendered as a string at all. If not, one + can still determine if the result of an expression is true using + "file-exists-p FILE && echo true". + (eshell-stringify): If `eshell-stringify-t' is nil, don't + stringify t! + + * eshell/esh-module.el: Whitespace fix. + + * eshell/em-alias.el (eshell-alias-initialize): Added + `eshell-command-aliased-p' to `eshell-complex-commands'. + (eshell-command-aliased-p): New function that returns t if a + command name names an aliased. + 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu> * viper-cmd.el (viper-preserve-cursor-color): new test that avoids @@ -865,7 +986,7 @@ * align.el, pcomplete.el, calendar/timeclock.el, eshell/esh-module.el, eshell/eshell.el: Removed URL reference. - * calendar/timeclock.el (timeclock-find-discrep): A fix to same + * calendar/timeclock.el (timeclock-find-discrep): A fix to some faulty math, where holiday hours were being computing as seconds. 2000-10-13 John Wiegley <johnw@gnu.org> diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 265406d2e5f..d96250dde1d 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -4,7 +4,7 @@ ;; Author: John Wiegley <johnw@gnu.org> ;; Created: 25 Mar 1999 -;; Version: 2.2 +;; Version: 2.3 ;; Keywords: calendar data ;; This file is part of GNU Emacs. @@ -222,8 +222,7 @@ in the modeline. See the variable `timeclock-modeline-display'." (defvar timeclock-last-event nil "A list containing the last event that was recorded. -The format of this list is (CODE TIME PROJECT). PROJECT will be -non-nil only if CODE is \"o\" or \"O\".") +The format of this list is (CODE TIME PROJECT).") (defvar timeclock-last-event-workday nil "The number of seconds in the workday of `timeclock-last-event'.") @@ -455,7 +454,7 @@ as with time remaining, where negative time really means overtime)." (truncate (/ (abs seconds) 60 60)) (% (truncate (/ (abs seconds) 60)) 60)))) -(defun timeclock-workday-remaining (&optional today-only) +(defsubst timeclock-workday-remaining (&optional today-only) "Return a the number of seconds until the workday is complete. The amount returned is relative to the value of `timeclock-workday'. If TODAY-ONLY is non-nil, the value returned will be relative only to @@ -463,7 +462,7 @@ the time worked today, and not to past time. This argument only makes a difference if `timeclock-relative' is non-nil." (- (timeclock-find-discrep today-only))) -(defun timeclock-currently-in-p () +(defsubst timeclock-currently-in-p () "Return non-nil if the user is currently clocked in." (equal (car timeclock-last-event) "i")) @@ -483,7 +482,7 @@ See `timeclock-relative' for more information about the meaning of (message string) string))) -(defun timeclock-workday-elapsed (&optional relative) +(defsubst timeclock-workday-elapsed (&optional relative) "Return a the number of seconds worked so far today. If RELATIVE is non-nil, the amount returned will be relative to past time worked. The default is to return only the time that has elapsed @@ -505,7 +504,7 @@ non-nil, the amount returned will be relative to past time worked." (message string) string))) -(defun timeclock-when-to-leave (&optional today-only) +(defsubst timeclock-when-to-leave (&optional today-only) "Return a time value representing at when the workday ends today. If TODAY-ONLY is non-nil, the value returned will be relative only to the time worked today, and not to past time. This argument only makes @@ -578,9 +577,8 @@ non-nil." (defun timeclock-log (code &optional project) "Log the event CODE to the timeclock log, at the time of call. If PROJECT is a string, it represents the project which the event is -being logged for. Normally only \"out\" events specify a project." - (save-excursion - (set-buffer (find-file-noselect timeclock-file)) +being logged for. Normally only \"in\" events specify a project." + (with-current-buffer (find-file-noselect timeclock-file) (goto-char (point-max)) (if (not (bolp)) (insert "\n")) @@ -603,42 +601,40 @@ being logged for. Normally only \"out\" events specify a project." timeclock-last-period))) (setq timeclock-last-event (list code now project))) (save-buffer) - (run-hooks 'timeclock-event-hook))) + (run-hooks 'timeclock-event-hook) + (kill-buffer (current-buffer)))) -(defun timeclock-read-moment () +(defvar timeclock-moment-regexp + (concat "\\([bhioO]\\)\\s-+" + "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+" + "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[ \t]*" "\\([^\n]*\\)")) + +(defsubst timeclock-read-moment () "Read the moment under point from the timelog." - (save-excursion - (beginning-of-line) - (let ((eol (save-excursion (end-of-line) (point)))) - (if (re-search-forward - (concat "^\\(.\\)\\s-+" - "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+" - "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\s-*" - "\\(.*\\)") eol t) - (let ((code (match-string 1)) - (year (string-to-number (match-string 2))) - (mon (string-to-number (match-string 3))) - (mday (string-to-number (match-string 4))) - (hour (string-to-number (match-string 5))) - (min (string-to-number (match-string 6))) - (sec (string-to-number (match-string 7))) - (project (match-string 8))) - (list code (encode-time sec min hour mday mon year) - project)))))) - -(defun timeclock-time-to-seconds (time) + (if (looking-at timeclock-moment-regexp) + (let ((code (match-string 1)) + (year (string-to-number (match-string 2))) + (mon (string-to-number (match-string 3))) + (mday (string-to-number (match-string 4))) + (hour (string-to-number (match-string 5))) + (min (string-to-number (match-string 6))) + (sec (string-to-number (match-string 7))) + (project (match-string 8))) + (list code (encode-time sec min hour mday mon year) project)))) + +(defsubst timeclock-time-to-seconds (time) "Convert TIME to a floating point number." (+ (* (car time) 65536.0) (cadr time) (/ (or (car (cdr (cdr time))) 0) 1000000.0))) -(defun timeclock-seconds-to-time (seconds) +(defsubst timeclock-seconds-to-time (seconds) "Convert SECONDS (a floating point number) to an Emacs time structure." (list (floor seconds 65536) (floor (mod seconds 65536)) (floor (* (- seconds (ffloor seconds)) 1000000)))) -(defun timeclock-time-to-date (time) +(defsubst timeclock-time-to-date (time) "Convert the TIME value to a textual date string." (format-time-string "%Y/%m/%d" time)) @@ -655,49 +651,376 @@ This is only provided for coherency when used by (cadr timeclock-last-event))) timeclock-last-period)) +(defsubst timeclock-entry-length (entry) + (- (timeclock-time-to-seconds (cadr entry)) + (timeclock-time-to-seconds (car entry)))) + +(defsubst timeclock-entry-begin (entry) + (car entry)) + +(defsubst timeclock-entry-end (entry) + (cadr entry)) + +(defsubst timeclock-entry-project (entry) + (nth 2 entry)) + +(defsubst timeclock-entry-comment (entry) + (nth 3 entry)) + + +(defsubst timeclock-entry-list-length (entry-list) + (let ((length 0)) + (while entry-list + (setq length (+ length (timeclock-entry-length (car entry-list)))) + (setq entry-list (cdr entry-list))) + length)) + +(defsubst timeclock-entry-list-begin (entry-list) + (timeclock-entry-begin (car entry-list))) + +(defsubst timeclock-entry-list-end (entry-list) + (timeclock-entry-end (car (last entry-list)))) + +(defsubst timeclock-entry-list-span (entry-list) + (- (timeclock-time-to-seconds (timeclock-entry-list-end entry-list)) + (timeclock-time-to-seconds (timeclock-entry-list-begin entry-list)))) + +(defsubst timeclock-entry-list-break (entry-list) + (- (timeclock-entry-list-span entry-list) + (timeclock-entry-list-length entry-list))) + +(defsubst timeclock-entry-list-projects (entry-list) + (let (projects) + (while entry-list + (let ((project (timeclock-entry-project (car entry-list)))) + (if projects + (add-to-list 'projects project) + (setq projects (list project)))) + (setq entry-list (cdr entry-list))) + projects)) + + +(defsubst timeclock-day-required (day) + (car day)) + +(defsubst timeclock-day-length (day) + (timeclock-entry-list-length (cdr day))) + +(defsubst timeclock-day-debt (day) + (- (timeclock-day-required day) + (timeclock-day-length day))) + +(defsubst timeclock-day-begin (day) + (timeclock-entry-list-begin (cdr day))) + +(defsubst timeclock-day-end (day) + (timeclock-entry-list-end (cdr day))) + +(defsubst timeclock-day-span (day) + (timeclock-entry-list-span (cdr day))) + +(defsubst timeclock-day-break (day) + (timeclock-entry-list-break (cdr day))) + +(defsubst timeclock-day-projects (day) + (timeclock-entry-list-projects (cdr day))) + +(defmacro timeclock-day-list-template (func) + `(let ((length 0)) + (while day-list + (setq length (+ length (,(eval func) (car day-list)))) + (setq day-list (cdr day-list))) + length)) + +(defun timeclock-day-list-required (day-list) + (timeclock-day-list-template 'timeclock-day-required)) + +(defun timeclock-day-list-length (day-list) + (timeclock-day-list-template 'timeclock-day-length)) + +(defun timeclock-day-list-debt (day-list) + (timeclock-day-list-template 'timeclock-day-debt)) + +(defsubst timeclock-day-list-begin (day-list) + (timeclock-day-begin (car day-list))) + +(defsubst timeclock-day-list-end (day-list) + (timeclock-day-end (car (last day-list)))) + +(defun timeclock-day-list-span (day-list) + (timeclock-day-list-template 'timeclock-day-span)) + +(defun timeclock-day-list-break (day-list) + (timeclock-day-list-template 'timeclock-day-break)) + +(defun timeclock-day-list-projects (day-list) + (let (projects) + (while day-list + (let ((projs (timeclock-day-projects (car day-list)))) + (while projs + (if projects + (add-to-list 'projects (car projs)) + (setq projects (list (car projs)))) + (setq projs (cdr projs)))) + (setq day-list (cdr day-list))) + projects)) + + +(defsubst timeclock-current-debt (&optional log-data) + (nth 0 (or log-data (timeclock-log-data)))) + +(defsubst timeclock-day-alist (&optional log-data) + (nth 1 (or log-data (timeclock-log-data)))) + +(defun timeclock-day-list (&optional log-data) + (let ((alist (timeclock-day-alist log-data)) + day-list) + (while alist + (setq day-list (cons (cdar alist) day-list) + alist (cdr alist))) + day-list)) + +(defsubst timeclock-project-alist (&optional log-data) + (nth 2 (or log-data (timeclock-log-data)))) + + +(defun timeclock-log-data (&optional recent-only filename) + "Return the contents of the timelog file, in a useful format. +A timelog contains data in the form of a single entry per line. +Each entry has the form: + + CODE YYYY/MM/DD HH:MM:SS [COMMENT] + +CODE is one of: b, h, i, o or O. COMMENT is optional when the code is +i, o or O. The meanings of the codes are: + + b Set the current time balance, or \"time debt\". Useful when + archiving old log data, when a debt must be carried forward. + The COMMENT here is the number of seconds of debt. + + h Set the required working time for the given day. This must + be the first entry for that day. The COMMENT in this case is + the number of hours that must be worked. Floating point + amounts are allowed. + + i Clock in. The COMMENT in this case should be the name of the + project worked on. + + o Clock out. COMMENT is unnecessary, but can be used to provide + a description of how the period went, for example. + + O Final clock out. Whatever project was being worked on, it is + now finished. Useful for creating summary reports. + +When this function is called, it will return a data structure with the +following format: + + (DEBT ENTRIES-BY-DAY ENTRIES-BY-PROJECT) + +DEBT is a floating point number representing the number of seconds +\"owed\" before any work was done. For a new file (one without a 'b' +entry), this is always zero. + +The two entries lists have similar formats. They are both alists, +where the CAR is the index, and the CDR is a list of time entries. +For ENTRIES-BY-DAY, the CAR is a textual date string, of the form +YYYY/MM/DD. For ENTRIES-BY-PROJECT, it is the name of the project +worked on, or t for the default project. + +The CDR for ENTRIES-BY-DAY is slightly different than for +ENTRIES-BY-PROJECT. It has the following form: + + (DAY-LENGTH TIME-ENTRIES...) + +For ENTRIES-BY-PROJECT, there is no DAY-LENGTH member. It is simply a +list of TIME-ENTRIES. Note that if DAY-LENGTH is nil, it means +whatever is the default should be used. + +A TIME-ENTRY is a recorded time interval. It has the following format +\(although generally one does not have to manipulate these entries +directly; see below): + + (BEGIN-TIME END-TIME PROJECT [COMMENT] [FINAL-P]) + +Anyway, suffice it to say there are a lot of structures. Typically +the user is expected to manipulate to the day(s) or project(s) that he +or she wants, at which point the following helper functions may be +used: + + timeclock-day-required + timeclock-day-length + timeclock-day-debt + timeclock-day-begin + timeclock-day-end + timeclock-day-span + timeclock-day-break + timeclock-day-projects + + timeclock-day-list-required + timeclock-day-list-length + timeclock-day-list-debt + timeclock-day-list-begin + timeclock-day-list-end + timeclock-day-list-span + timeclock-day-list-break + timeclock-day-list-projects + + timeclock-entry-length + timeclock-entry-begin + timeclock-entry-end + timeclock-entry-project + timeclock-entry-comment + + timeclock-entry-list-length + timeclock-entry-list-begin + timeclock-entry-list-end + timeclock-entry-list-span + timeclock-entry-list-break + timeclock-entry-list-projects + +A few comments should make the use of the above functions obvious: + + `required' is the amount of time that must be spent during a day, or + sequence of days, in order to have no debt. + + `length' is the actual amount of time that was spent. + + `debt' is the difference between required time and length. A + negative debt signifies overtime. + + `begin' is the earliest moment at which work began. + + `end' is the final moment work was done. + + `span' is the difference between begin and end. + + `break' is the difference between span and length. + + `project' is the project that was worked on, and `projects' is a + list of all the projects that were worked on during a given period. + + `comment', where it applies, could mean anything. + +There are a few more functions available, for locating day and entry +lists: + + timeclock-day-alist LOG-DATA + timeclock-project-alist LOG-DATA + timeclock-current-debt LOG-DATA + +See the documentation for the given function if more info is needed." + (let* ((log-data (list 0.0 nil nil)) + (now (current-time)) + (todays-date (timeclock-time-to-date now)) + last-date-limited last-date-seconds last-date + (line 0) last beg day entry) + (with-temp-buffer + (insert-file-contents (or filename timeclock-file)) + (when recent-only + (goto-char (point-max)) + (unless (re-search-backward "^b\\s-+" nil t) + (goto-char (point-min)))) + (while (or (setq event (timeclock-read-moment)) + (and beg (not last) + (setq last t event (list "o" now)))) + (setq line (1+ line)) + (cond ((equal (car event) "b") + (setcar log-data (string-to-number (nth 2 event)))) + ((equal (car event) "h") + (setq last-date-limited (timeclock-time-to-date (cadr event)) + last-date-seconds (* (string-to-number (nth 2 event)) + 3600.0))) + ((equal (car event) "i") + (if beg + (error "Error in format of timelog file, line %d" line) + (setq beg t)) + (setq entry (list (cadr event) nil + (and (> (length (nth 2 event)) 0) + (nth 2 event)))) + (let ((date (timeclock-time-to-date (cadr event)))) + (if (and last-date + (not (equal date last-date))) + (setcar (cdr log-data) + (cons (cons last-date day) + (cadr log-data))) + (setq day (list (and last-date-limited + last-date-seconds)))) + (setq last-date date + last-date-limited nil))) + ((equal (downcase (car event)) "o") + (if (not beg) + (error "Error in format of timelog file, line %d" line) + (setq beg nil)) + (setcar (cdr entry) (cadr event)) + (let ((desc (and (> (length (nth 2 event)) 0) + (nth 2 event)))) + (if desc + (nconc entry (list (nth 2 event)))) + (if (equal (car event) "O") + (nconc entry (if desc + (list t) + (list nil t)))) + (nconc day (list entry)) + (setq desc (nth 2 entry)) + (let ((proj (assoc desc (nth 2 log-data)))) + (if (not proj) + (setcar (cddr log-data) + (cons (cons desc (list entry)) + (car (cddr log-data)))) + (nconc (cdr proj) (list entry))))))) + (forward-line)) + (if day + (setcar (cdr log-data) + (cons (cons last-date day) + (cadr log-data)))) + log-data))) + (defun timeclock-find-discrep (&optional today-only) "Find overall discrepancy from `timeclock-workday' (in seconds). If TODAY-ONLY is non-nil, the discrepancy will be not be relative, and will correspond only to the amount of time elapsed today. This is identical to what would be return if `timeclock-relative' were nil." - (let* ((now (current-time)) (first t) + ;; This is not implemented in terms of the functions above, because + ;; it's a bit wasteful to read all of that data in, just to throw + ;; away more than 90% of the information afterwards. + (let* ((now (current-time)) (todays-date (timeclock-time-to-date now)) - accum event beg last-date - last-date-limited last-date-seconds avg) + (first t) (accum 0) + event beg last-date avg + last-date-limited last-date-seconds) (unless timeclock-discrepancy (setq timeclock-project-list nil timeclock-last-project nil - timeclock-reason-list nil) - (save-excursion - (set-buffer (find-file-noselect timeclock-file)) - (goto-char (point-min)) - (setq accum 0) - (setq timeclock-elapsed 0) + timeclock-reason-list nil + timeclock-elapsed 0) + (with-temp-buffer + (insert-file-contents timeclock-file) + (goto-char (point-max)) + (unless (re-search-backward "^b\\s-+" nil t) + (goto-char (point-min))) (while (setq event (timeclock-read-moment)) - (cond ((equal (car event) "h") + (cond ((equal (car event) "b") + (setq accum (string-to-number (nth 2 event)))) + ((equal (car event) "h") (setq last-date-limited (timeclock-time-to-date (cadr event)) last-date-seconds - (* (string-to-number (nth 2 event)) 3600))) + (* (string-to-number (nth 2 event)) 3600.0))) ((equal (car event) "i") (when (and (nth 2 event) (> (length (nth 2 event)) 0)) (add-to-list 'timeclock-project-list (nth 2 event)) (setq timeclock-last-project (nth 2 event))) (let ((date (timeclock-time-to-date (cadr event)))) - (if (and last-date - timeclock-relative - (not (equal date last-date))) - (setq accum (- accum - (if last-date-limited - last-date-seconds - timeclock-workday))) - (unless (or last-date (not first)) + (if (and timeclock-relative + (if last-date + (not (equal date last-date)) + first)) (setq first nil accum (- accum (if last-date-limited last-date-seconds - timeclock-workday))))) + timeclock-workday)))) (setq last-date date last-date-limited nil) (if beg @@ -712,8 +1035,7 @@ identical to what would be return if `timeclock-relative' were nil." (if (not beg) (error "Error in format of timelog file!") (setq timeclock-last-period - (- (timeclock-time-to-seconds (cadr event)) - beg) + (- (timeclock-time-to-seconds (cadr event)) beg) accum (+ timeclock-last-period accum) beg nil))) (if (equal last-date todays-date) diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index 85e4e97e692..a407bf5deb8 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -151,7 +151,12 @@ command, which will automatically write them to the file named by (add-hook 'eshell-alternate-command-hook 'eshell-fix-bad-commands t t) (eshell-read-aliases-list) (make-local-hook 'eshell-named-command-hook) - (add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t)) + (add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t) + (make-local-variable 'eshell-complex-commands) + (add-to-list 'eshell-complex-commands 'eshell-command-aliased-p)) + +(defun eshell-command-aliased-p (name) + (member name eshell-command-aliases-list)) (defun eshell/alias (&optional alias &rest definition) "Define an ALIAS in the user's alias list using DEFINITION." diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 02d1eb3076b..0c147f14be6 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -297,7 +297,7 @@ Thus, this does not include the current directory.") (file-name-as-directory (cdr user)))) eshell-user-names))))))) -(defun eshell/pwd (&rest args) ; ignored +(defun eshell/pwd (&rest args) "Change output from `pwd` to be cleaner." (let* ((path default-directory) (len (length path))) @@ -307,8 +307,8 @@ Thus, this does not include the current directory.") (string-match "\\`[A-Za-z]:[\\\\/]\\'" path)))) (setq path (substring path 0 (1- (length path))))) (if eshell-pwd-convert-function - (setq path (funcall eshell-pwd-convert-function path))) - path)) + (funcall eshell-pwd-convert-function path) + path))) (defun eshell-expand-multiple-dots (path) "Convert '...' to '../..', '....' to '../../..', etc.. diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index b281cee4fd7..f4f9ebbe5b6 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -81,8 +81,9 @@ by zsh for filename generation." :type 'boolean :group 'eshell-glob) -(defcustom eshell-glob-show-progress t - "*If non-nil, display progress messages during a recursive glob." +(defcustom eshell-glob-show-progress nil + "*If non-nil, display progress messages during a recursive glob. +This option slows down recursive glob processing by quite a bit." :type 'boolean :group 'eshell-glob) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 2afef625f55..534ea932c3c 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -57,6 +57,12 @@ properties to colorize its output based on the setting of :type 'hook :group 'eshell-ls) +(defcustom eshell-ls-initial-args nil + "*If non-nil, this list of args is included before any call to `ls'. +This is useful for enabling human-readable format (-h), for example." + :type '(repeat :tag "Arguments" string) + :group 'eshell-ls) + (defcustom eshell-ls-use-in-dired nil "*If non-nil, use `eshell-ls' to read directories in dired." :set (lambda (symbol value) @@ -77,11 +83,18 @@ properties to colorize its output based on the setting of :type 'integer :group 'eshell-ls) -(defcustom eshell-ls-exclude-regexp "\\`\\." +(defcustom eshell-ls-exclude-regexp nil "*Unless -a is specified, files matching this regexp will not be shown." :type 'regexp :group 'eshell-ls) +(defcustom eshell-ls-exclude-hidden t + "*Unless -a is specified, files beginning with . will not be shown. +Using this boolean, instead of `eshell-ls-exclude-regexp', is both +faster and conserves more memory." + :type 'boolean + :group 'eshell-ls) + (defcustom eshell-ls-use-colors t "*If non-nil, use colors in file listings." :type 'boolean @@ -196,13 +209,13 @@ This is really just for efficiency, to avoid having to stat the file yet again." `(if (numberp (nth 2 ,attrs)) (if (= (user-uid) (nth 2 ,attrs)) - (not (eq (aref (nth 8 ,attrs) ,index) ?-)) - (,(eval func) ,file)) + (not (eq (aref (nth 8 ,attrs) ,index) ?-)) + (,(eval func) ,file)) (not (eq (aref (nth 8 ,attrs) - (+ ,index (if (member (nth 2 ,attrs) - (eshell-current-ange-uids)) - 0 6))) - ?-)))) + (+ ,index (if (member (nth 2 ,attrs) + (eshell-current-ange-uids)) + 0 6))) + ?-)))) (defcustom eshell-ls-highlight-alist nil "*This alist correlates test functions to color. @@ -248,7 +261,8 @@ instead." (symbol-value 'font-lock-buffers))))) (let ((insert-func 'insert) (error-func 'insert) - (flush-func 'ignore)) + (flush-func 'ignore) + eshell-ls-initial-args) (eshell-do-ls (append switches (list file)))))))) (defsubst eshell/ls (&rest args) @@ -281,7 +295,9 @@ instead." (funcall flush-func -1) ;; process the command arguments, and begin listing files (eshell-eval-using-options - "ls" args + "ls" (if eshell-ls-initial-args + (list eshell-ls-initial-args args) + args) `((?a "all" nil show-all "show all files in directory") (?c nil by-ctime sort-method @@ -343,11 +359,11 @@ Sort entries alphabetically across.") (error (concat "-I option requires that `eshell-glob'" " be a member of `eshell-modules-list'"))) (set-text-properties 0 (length ignore-pattern) nil ignore-pattern) - (if eshell-ls-exclude-regexp - (setq eshell-ls-exclude-regexp + (setq eshell-ls-exclude-regexp + (if eshell-ls-exclude-regexp (concat "\\(" eshell-ls-exclude-regexp "\\|" - (eshell-glob-regexp ignore-pattern) "\\)")) - (setq eshell-ls-exclude-regexp (eshell-glob-regexp ignore-pattern)))) + (eshell-glob-regexp ignore-pattern) "\\)") + (eshell-glob-regexp ignore-pattern)))) ;; list the files! (eshell-ls-entries (mapcar (function @@ -356,7 +372,8 @@ Sort entries alphabetically across.") (file-name-absolute-p arg)) (expand-file-name arg) arg) - (eshell-file-attributes arg)))) args) + (eshell-file-attributes arg)))) + args) t (expand-file-name default-directory))) (funcall flush-func))) @@ -491,12 +508,13 @@ relative to that directory." (file-relative-name dir root-dir) (expand-file-name dir))) (cdr dirinfo))) ":\n")) - (let ((entries - (eshell-directory-files-and-attributes dir nil nil t))) - (unless show-all - (while (and entries - (string-match eshell-ls-exclude-regexp - (caar entries))) + (let ((entries (eshell-directory-files-and-attributes + dir nil (and (not show-all) + eshell-ls-exclude-hidden + "\\`[^.]") t))) + (when (and (not show-all) eshell-ls-exclude-regexp) + (while (and entries (string-match eshell-ls-exclude-regexp + (caar entries))) (setq entries (cdr entries))) (let ((e entries)) (while (cdr e) @@ -552,17 +570,13 @@ In Eshell's implementation of ls, ENTRIES is always reversed." (let ((result (cond ((eq sort-method 'by-atime) - (eshell-ls-compare-entries - l r 4 'eshell-time-less-p)) + (eshell-ls-compare-entries l r 4 'eshell-time-less-p)) ((eq sort-method 'by-mtime) - (eshell-ls-compare-entries - l r 5 'eshell-time-less-p)) + (eshell-ls-compare-entries l r 5 'eshell-time-less-p)) ((eq sort-method 'by-ctime) - (eshell-ls-compare-entries - l r 6 'eshell-time-less-p)) + (eshell-ls-compare-entries l r 6 'eshell-time-less-p)) ((eq sort-method 'by-size) - (eshell-ls-compare-entries - l r 7 '<)) + (eshell-ls-compare-entries l r 7 '<)) ((eq sort-method 'by-extension) (let ((lx (file-name-extension (directory-file-name (car l)))) @@ -699,8 +713,8 @@ need to be printed." (if (and need-return (not dir-literal)) (funcall insert-func "\n")) (eshell-ls-dir dir show-names - (unless (file-name-absolute-p (car dir)) - root-dir) size-width) + (unless (file-name-absolute-p (car dir)) root-dir) + size-width) (setq need-return t)))) (defun eshell-ls-find-column-widths (files) diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index d6a8ea54e2f..8967426cadf 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -63,6 +63,9 @@ This includes when running `eshell-command'." (string= (file-name-nondirectory file) "eshell")) . eshell/source) eshell-interpreter-alist)) + (make-local-variable 'eshell-complex-commands) + (setq eshell-complex-commands + (append '("source" ".") eshell-complex-commands)) ;; these two variables are changed through usage, but we don't want ;; to ruin it for other modules (let (eshell-inside-quote-regexp diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index cc02f2fedc3..9bef8b10d20 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -77,6 +77,11 @@ it to get a real sense of how it works." ;; scroll, etc. ;; ;; @ Like I said, it's not really comprehensible until you try it! ;) +;; +;; One disadvantage of this module is that it increases Eshell's +;; memory consumption by a factor of two or more. With small commands +;; (such as pwd), where the screen is mostly full, consumption can +;; increase by orders of magnitude. ;;; User Variables: @@ -154,6 +159,7 @@ The options are `begin', `after' or `end'." (defvar eshell-smart-displayed nil) (defvar eshell-smart-command-done nil) +(defvar eshell-currently-handling-window nil) ;;; Functions: @@ -175,19 +181,17 @@ The options are `begin', `after' or `end'." (make-local-hook 'pre-command-hook) (make-local-hook 'after-change-functions) - (add-hook 'after-change-functions - 'eshell-disable-after-change nil t) + (add-hook 'after-change-functions 'eshell-disable-after-change nil t) (make-local-hook 'eshell-input-filter-functions) - (add-hook 'eshell-input-filter-functions - 'eshell-smart-display-setup nil t) + (add-hook 'eshell-input-filter-functions 'eshell-smart-display-setup nil t) (make-local-variable 'eshell-smart-command-done) (make-local-hook 'eshell-post-command-hook) - (add-hook 'eshell-post-command-hook - (function - (lambda () - (setq eshell-smart-command-done t))) t t) + (add-hook 'eshell-post-command-hook + (function + (lambda () + (setq eshell-smart-command-done t))) t t) (unless (eq eshell-review-quick-commands t) (add-hook 'eshell-post-command-hook @@ -198,10 +202,9 @@ The options are `begin', `after' or `end'." (unless eshell-currently-handling-window (let ((inhibit-point-motion-hooks t) (eshell-currently-handling-window t)) - (save-current-buffer - (save-selected-window - (select-window wind) - (eshell-smart-redisplay)))))) + (save-selected-window + (select-window wind) + (eshell-smart-redisplay))))) (defun eshell-refresh-windows (&optional frame) "Refresh all visible Eshell buffers." @@ -210,10 +213,10 @@ The options are `begin', `after' or `end'." (function (lambda (wind) (with-current-buffer (window-buffer wind) - (when eshell-mode - (let (window-scroll-functions) - (eshell-smart-scroll-window wind (window-start)) - (setq affected t)))))) + (if eshell-mode + (let (window-scroll-functions) + (eshell-smart-scroll-window wind (window-start)) + (setq affected t)))))) 0 frame) (if affected (let (window-scroll-functions) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 7f0414ef056..c9b3d418b83 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -124,6 +124,11 @@ Otherwise, `rmdir' is required." :type 'boolean :group 'eshell-unix) +(defcustom eshell-default-target-is-dot nil + "*If non-nil, the default destination for cp, mv or ln is `.'." + :type 'boolean + :group 'eshell-unix) + (defcustom eshell-du-prefer-over-ange nil "*Use Eshell's du in ange-ftp remote directories. Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." @@ -140,7 +145,12 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." (when (eshell-using-module 'eshell-cmpl) (make-local-hook 'pcomplete-try-first-hook) (add-hook 'pcomplete-try-first-hook - 'eshell-complete-host-reference nil t))) + 'eshell-complete-host-reference nil t)) + (make-local-variable 'eshell-complex-commands) + (setq eshell-complex-commands + (append '("grep" "egrep" "fgrep" "agrep" "glimpse" "locate" + "cat" "time" "cp" "mv" "make" "du" "diff") + eshell-complex-commands))) (defalias 'eshell/date 'current-time-string) (defalias 'eshell/basename 'file-name-nondirectory) @@ -157,6 +167,7 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." (funcall 'man (apply 'eshell-flatten-and-stringify args))) (defun eshell-remove-entries (path files &optional top-level) + "From PATH, remove all of the given FILES, perhaps interactively." (while files (if (string-match "\\`\\.\\.?\\'" (file-name-nondirectory (car files))) @@ -302,8 +313,6 @@ Remove the DIRECTORY(ies), if they are empty.") (defun eshell-shuffle-files (command action files target func deep &rest args) "Shuffle around some filesystem entries, using FUNC to do the work." - (if (null target) - (error "%s: missing destination file" command)) (let ((attr-target (eshell-file-attributes target)) (is-dir (or (file-directory-p target) (and preview (not eshell-warn-dot-directories)))) @@ -417,30 +426,35 @@ Remove the DIRECTORY(ies), if they are empty.") (format "tar %s %s" tar-args archive) args)))) ;; this is to avoid duplicating code... -(defmacro eshell-mvcp-template - (command action func query-var force-var &optional preserve) - `(if (and (string-match eshell-tar-regexp (car (last args))) - (or (> (length args) 2) - (and (file-directory-p (car args)) - (or (not no-dereference) - (not (file-symlink-p (car args))))))) - (eshell-shorthand-tar-command ,command args) - (let (target ange-cache) - (if (> (length args) 1) - (progn - (setq target (car (last args))) - (setcdr (last args 2) nil)) - (setq args nil)) - (eshell-shuffle-files - ,command ,action args target ,func nil - ,@(append - `((if (and (or interactive - ,query-var) - (not force)) - 1 (or force ,force-var))) - (if preserve - (list preserve))))) - nil)) +(defmacro eshell-mvcpln-template (command action func query-var + force-var &optional preserve) + `(let ((len (length args))) + (if (or (= len 0) + (and (= len 1) (null eshell-default-target-is-dot))) + (error "%s: missing destination file or directory" ,command)) + (if (= len 1) + (nconc args '("."))) + (setq args (eshell-stringify-list (eshell-flatten-list args))) + (if (and ,(not (equal command "ln")) + (string-match eshell-tar-regexp (car (last args))) + (or (> (length args) 2) + (and (file-directory-p (car args)) + (or (not no-dereference) + (not (file-symlink-p (car args))))))) + (eshell-shorthand-tar-command ,command args) + (let ((target (car (last args))) + ange-cache) + (setcdr (last args 2) nil) + (eshell-shuffle-files + ,command ,action args target ,func nil + ,@(append + `((if (and (or interactive + ,query-var) + (not force)) + 1 (or force ,force-var))) + (if preserve + (list preserve))))) + nil))) (defun eshell/mv (&rest args) "Implementation of mv in Lisp." @@ -455,6 +469,7 @@ Remove the DIRECTORY(ies), if they are empty.") (?v "verbose" nil verbose "explain what is being done") (nil "help" nil nil "show this usage screen") + :preserve-args :external "mv" :show-usage :usage "[OPTION]... SOURCE DEST @@ -462,9 +477,9 @@ Remove the DIRECTORY(ies), if they are empty.") Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. \[OPTION] DIRECTORY...") (let ((no-dereference t)) - (eshell-mvcp-template "mv" "moving" 'rename-file - eshell-mv-interactive-query - eshell-mv-overwrite-files)))) + (eshell-mvcpln-template "mv" "moving" 'rename-file + eshell-mv-interactive-query + eshell-mv-overwrite-files)))) (defun eshell/cp (&rest args) "Implementation of cp in Lisp." @@ -487,6 +502,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. (?v "verbose" nil verbose "explain what is being done") (nil "help" nil nil "show this usage screen") + :preserve-args :external "cp" :show-usage :usage "[OPTION]... SOURCE DEST @@ -494,9 +510,9 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") (if archive (setq preserve t no-dereference t recursive t)) - (eshell-mvcp-template "cp" "copying" 'copy-file - eshell-cp-interactive-query - eshell-cp-overwrite-files preserve))) + (eshell-mvcpln-template "cp" "copying" 'copy-file + eshell-cp-interactive-query + eshell-cp-overwrite-files preserve))) (defun eshell/ln (&rest args) "Implementation of ln in Lisp." @@ -505,11 +521,13 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") '((?h "help" nil nil "show this usage screen") (?s "symbolic" nil symbolic "make symbolic links instead of hard links") - (?i "interactive" nil interactive "request confirmation if target already exists") + (?i "interactive" nil interactive + "request confirmation if target already exists") (?f "force" nil force "remove existing destinations, never prompt") (?n "preview" nil preview "don't change anything on disk") (?v "verbose" nil verbose "explain what is being done") + :preserve-args :external "ln" :show-usage :usage "[OPTION]... TARGET [LINK_NAME] @@ -518,27 +536,19 @@ Create a link to the specified TARGET with optional LINK_NAME. If there is more than one TARGET, the last argument must be a directory; create links in DIRECTORY to each TARGET. Create hard links by default, symbolic links with '--symbolic'. When creating hard links, each TARGET must exist.") - (let (target no-dereference ange-cache) - (if (> (length args) 1) - (progn - (setq target (car (last args))) - (setcdr (last args 2) nil)) - (setq args nil)) - (eshell-shuffle-files "ln" "linking" args target - (if symbolic - 'make-symbolic-link - 'add-name-to-file) nil - (if (and (or interactive - eshell-ln-interactive-query) - (not force)) - 1 (or force eshell-ln-overwrite-files)))) - nil)) + (let ((no-dereference t)) + (eshell-mvcpln-template "ln" "linking" + (if symbolic + 'make-symbolic-link + 'add-name-to-file) + eshell-ln-interactive-query + eshell-ln-overwrite-files)))) (defun eshell/cat (&rest args) "Implementation of cat in Lisp. If in a pipeline, or the file is not a regular file, directory or symlink, then revert to the system's definition of cat." - (setq args (eshell-flatten-list args)) + (setq args (eshell-stringify-list (eshell-flatten-list args))) (if (or eshell-in-pipeline-p (catch 'special (eshell-for arg args @@ -593,7 +603,8 @@ Concatenate FILE(s), or standard input, to standard output.") (list 'quote (eshell-copy-environment)))))) (compile (concat "make " (eshell-flatten-and-stringify args)))) (throw 'eshell-replace-command - (eshell-parse-command "*make" (eshell-flatten-list args))))) + (eshell-parse-command "*make" (eshell-stringify-list + (eshell-flatten-list args)))))) (defun eshell-occur-mode-goto-occurrence () "Go to the occurrence the current line describes." @@ -627,7 +638,8 @@ available..." (default-directory default-dir)) (erase-buffer) (occur-mode) - (let ((files (eshell-flatten-list (cdr args))) + (let ((files (eshell-stringify-list + (eshell-flatten-list (cdr args)))) (inhibit-redisplay t) string) (when (car args) @@ -670,14 +682,16 @@ external command." (not eshell-in-subcommand-p)))) (throw 'eshell-replace-command (eshell-parse-command (concat "*" command) - (eshell-flatten-list args))) + (eshell-stringify-list + (eshell-flatten-list args)))) (let* ((compilation-process-setup-function (list 'lambda nil (list 'setq 'process-environment (list 'quote (eshell-copy-environment))))) (args (mapconcat 'identity (mapcar 'shell-quote-argument - (eshell-flatten-list args)) + (eshell-stringify-list + (eshell-flatten-list args))) " ")) (cmd (progn (set-text-properties 0 (length args) @@ -797,7 +811,7 @@ external command." (defun eshell/du (&rest args) "Implementation of \"du\" in Lisp, passing ARGS." (setq args (if args - (eshell-flatten-list args) + (eshell-stringify-list (eshell-flatten-list args)) '("."))) (let ((ext-du (eshell-search-path "du"))) (if (and ext-du @@ -909,7 +923,7 @@ Show wall-clock time elapsed during execution of COMMAND.") (defun eshell/diff (&rest args) "Alias \"diff\" to call Emacs `diff' function." - (let ((orig-args (eshell-flatten-list args))) + (let ((orig-args (eshell-stringify-list (eshell-flatten-list args)))) (if (or eshell-plain-diff-behavior (not (and (eshell-interactive-output-p) (not eshell-in-pipeline-p) @@ -951,7 +965,8 @@ Show wall-clock time elapsed during execution of COMMAND.") (and (stringp (car args)) (string-match "^-" (car args)))) (throw 'eshell-replace-command - (eshell-parse-command "*locate" (eshell-flatten-list args))) + (eshell-parse-command "*locate" (eshell-stringify-list + (eshell-flatten-list args)))) (save-selected-window (let ((locate-history-list (list (car args)))) (locate-with-filter (car args) (cadr args)))))) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 6d2ede0a72c..7d5a53625f5 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -203,6 +203,21 @@ which may be modified directly. Any return value is ignored." :type 'hook :group 'eshell-cmd) +(defcustom eshell-complex-commands nil + "*A list of commands names or functions, that determine complexity. +That is, if a command is defined by a function named eshell/NAME, +and NAME is part of this list, it is invoked as a complex command. +Complex commands are always correct, but run much slower. If a +command works fine without being part of this list, then it doesn't +need to be. + +If an entry is a function, it will be called with the name, and should +return non-nil if the command is complex." + :type '(repeat :tag "Commands" + (choice (string :tag "Name") + (function :tag "Predicate"))) + :group 'eshell-cmd) + ;;; Code: (require 'esh-util) @@ -518,8 +533,8 @@ implemented via rewriting, rather than as a function." (list 'car (list 'symbol-value (list 'quote 'for-items))))) - (list 'eshell-copy-handles - (eshell-invokify-arg body t))) + (list 'eshell-protect + (eshell-invokify-arg body t))) (list 'setcar 'for-items (list 'cadr (list 'symbol-value @@ -583,7 +598,7 @@ must be implemented via rewriting, rather than as a function." (eshell-structure-basic-command 'while '("while" "until") (car terms) (eshell-invokify-arg (cadr terms) nil t) - (list 'eshell-copy-handles + (list 'eshell-protect (eshell-invokify-arg (car (last terms)) t))))) (defun eshell-rewrite-if-command (terms) @@ -596,13 +611,15 @@ must be implemented via rewriting, rather than as a function." (eshell-structure-basic-command 'if '("if" "unless") (car terms) (eshell-invokify-arg (cadr terms) nil t) - (eshell-invokify-arg - (if (= (length terms) 5) - (car (last terms 3)) - (car (last terms))) t) - (eshell-invokify-arg - (if (= (length terms) 5) - (car (last terms))) t)))) + (list 'eshell-protect + (eshell-invokify-arg + (if (= (length terms) 5) + (car (last terms 3)) + (car (last terms))) t)) + (if (= (length terms) 5) + (list 'eshell-protect + (eshell-invokify-arg + (car (last terms)))) t)))) (defun eshell-exit-success-p () "Return non-nil if the last command was \"successful\". @@ -651,8 +668,8 @@ For an external command, it means an exit code of 0." (assert (car sep-terms)) (setq final (eshell-structure-basic-command 'if (string= (car sep-terms) "&&") "if" - (list 'eshell-commands (car results)) - final + (list 'eshell-protect (car results)) + (list 'eshell-protect final) nil t) results (cdr results) sep-terms (cdr sep-terms))) @@ -690,8 +707,8 @@ For an external command, it means an exit code of 0." (list 'eshell-lisp-command (list 'quote obj))) (ignore (goto-char here)))))) -(defun eshell-separate-commands - (terms separator &optional reversed last-terms-sym) +(defun eshell-separate-commands (terms separator &optional + reversed last-terms-sym) "Separate TERMS using SEPARATOR. If REVERSED is non-nil, the list of separated term groups will be returned in reverse order. If LAST-TERMS-SYM is a symbol, it's value @@ -772,21 +789,6 @@ this grossness will be made to disappear by using `call/cc'..." (eshell-errorn (error-message-string err)) (eshell-close-handles 1))))) -;; (defun eshell-copy-or-protect-handles () -;; (if (eshell-processp (car (aref eshell-current-handles -;; eshell-output-handle))) -;; (eshell-protect-handles eshell-current-handles) -;; (eshell-create-handles -;; (car (aref eshell-current-handles -;; eshell-output-handle)) nil -;; (car (aref eshell-current-handles -;; eshell-error-handle)) nil))) - -;; (defmacro eshell-copy-handles (object) -;; "Duplicate current I/O handles, so OBJECT works with its own copy." -;; `(let ((eshell-current-handles (eshell-copy-or-protect-handles))) -;; ,object)) - (defmacro eshell-copy-handles (object) "Duplicate current I/O handles, so OBJECT works with its own copy." `(let ((eshell-current-handles @@ -965,6 +967,22 @@ at the moment are: (if subform (concat "\n\n" (eshell-stringify subform)) "")))))) +(defun eshell-invoke-directly (command input) + (let ((base (cadr (nth 2 (nth 2 (cadr command))))) name) + (if (and (eq (car base) 'eshell-trap-errors) + (eq (car (cadr base)) 'eshell-named-command)) + (setq name (cadr (cadr base)))) + (and name (stringp name) + (not (member name eshell-complex-commands)) + (catch 'simple + (progn + (eshell-for pred eshell-complex-commands + (if (and (functionp pred) + (funcall pred name)) + (throw 'simple nil))) + t)) + (fboundp (intern-soft (concat "eshell/" name)))))) + (defun eshell-eval-command (command &optional input) "Evaluate the given COMMAND iteratively." (if eshell-current-command @@ -1163,29 +1181,29 @@ be finished later after the completion of an asynchronous subprocess." ((eq (car form) 'prog1) (cadr form)) (t + ;; If a command desire to replace its execution form with + ;; another command form, all it needs to do is throw the new + ;; form using the exception tag `eshell-replace-command'. + ;; For example, let's say that the form currently being + ;; eval'd is: + ;; + ;; (eshell-named-command "hello") + ;; + ;; Now, let's assume the 'hello' command is an Eshell alias, + ;; the definition of which yields the command: + ;; + ;; (eshell-named-command "echo" (list "Hello" "world")) + ;; + ;; What the alias code would like to do is simply substitute + ;; the alias form for the original form. To accomplish + ;; this, all it needs to do is to throw the substitution + ;; form with the `eshell-replace-command' tag, and the form + ;; will be replaced within the current command, and + ;; execution will then resume (iteratively) as before. + ;; Thus, aliases can even contain references to asynchronous + ;; sub-commands, and things will still work out as they + ;; should. (let (result new-form) - ;; If a command desire to replace its execution form with - ;; another command form, all it needs to do is throw the - ;; new form using the exception tag - ;; `eshell-replace-command'. For example, let's say that - ;; the form currently being eval'd is: - ;; - ;; (eshell-named-command \"hello\") - ;; - ;; Now, let's assume the 'hello' command is an Eshell - ;; alias, the definition of which yields the command: - ;; - ;; (eshell-named-command \"echo\" (list \"Hello\" \"world\")) - ;; - ;; What the alias code would like to do is simply - ;; substitute the alias form for the original form. To - ;; accomplish this, all it needs to do is to throw the - ;; substitution form with the `eshell-replace-command' - ;; tag, and the form will be replaced within the current - ;; command, and execution will then resume (iteratively) - ;; as before. Thus, aliases can even contain references - ;; to asynchronous sub-commands, and things will still - ;; work out as they should. (if (setq new-form (catch 'eshell-replace-command (ignore diff --git a/lisp/eshell/esh-groups.el b/lisp/eshell/esh-groups.el index 218bd2a2e52..d82cdff4ffd 100644 --- a/lisp/eshell/esh-groups.el +++ b/lisp/eshell/esh-groups.el @@ -132,4 +132,3 @@ functions, or as aliases which make some of Emacs' behavior more naturally accessible within Emacs." :tag "Extra alias functions" :group 'eshell-module) - diff --git a/lisp/eshell/esh-maint.el b/lisp/eshell/esh-maint.el index 13b3597b4ce..89e50401c67 100644 --- a/lisp/eshell/esh-maint.el +++ b/lisp/eshell/esh-maint.el @@ -48,7 +48,7 @@ ;; (interactive) ;; (require 'autoload) ;; (setq generated-autoload-file -;; (expand-file-name (car command-line-args-left))) +;; (expand-file-name (car command-line-args-left))) ;; (setq command-line-args-left (cdr command-line-args-left)) ;; (batch-update-autoloads)) @@ -65,23 +65,23 @@ ;; Core Functionality\n") ;; (eshell-for module ;; (sort (eshell-subgroups 'eshell) -;; (function -;; (lambda (a b) -;; (string-lessp (symbol-name a) -;; (symbol-name b))))) +;; (function +;; (lambda (a b) +;; (string-lessp (symbol-name a) +;; (symbol-name b))))) ;; (insert (format "* %-34s" -;; (concat (get module 'custom-tag) "::")) -;; (symbol-name module) ".\n")) +;; (concat (get module 'custom-tag) "::")) +;; (symbol-name module) ".\n")) ;; (insert "\nOptional Functionality\n") ;; (eshell-for module ;; (sort (eshell-subgroups 'eshell-module) -;; (function -;; (lambda (a b) -;; (string-lessp (symbol-name a) -;; (symbol-name b))))) +;; (function +;; (lambda (a b) +;; (string-lessp (symbol-name a) +;; (symbol-name b))))) ;; (insert (format "* %-34s" -;; (concat (get module 'custom-tag) "::")) -;; (symbol-name module) ".\n")) +;; (concat (get module 'custom-tag) "::")) +;; (symbol-name module) ".\n")) ;; (insert "@end menu\n")) ;; (defun eshell-make-texi () @@ -91,27 +91,27 @@ ;; (require 'texidoc) ;; (require 'pcomplete) ;; (apply 'texidoc-files 'eshell-generate-main-menu "eshell.doci" -;; (append -;; (list "eshell.el") -;; (sort (mapcar -;; (function -;; (lambda (sym) -;; (let ((name (symbol-name sym))) -;; (if (string-match "\\`eshell-\\(.*\\)" name) -;; (setq name (concat "esh-" (match-string 1 name)))) -;; (concat name ".el")))) -;; (eshell-subgroups 'eshell)) -;; 'string-lessp) -;; (sort (mapcar -;; (function -;; (lambda (sym) -;; (let ((name (symbol-name sym))) -;; (if (string-match "\\`eshell-\\(.*\\)" name) -;; (setq name (concat "em-" (match-string 1 name)))) -;; (concat name ".el")))) -;; (eshell-subgroups 'eshell-module)) -;; 'string-lessp) -;; (list "eshell.texi")))) +;; (append +;; (list "eshell.el") +;; (sort (mapcar +;; (function +;; (lambda (sym) +;; (let ((name (symbol-name sym))) +;; (if (string-match "\\`eshell-\\(.*\\)" name) +;; (setq name (concat "esh-" (match-string 1 name)))) +;; (concat name ".el")))) +;; (eshell-subgroups 'eshell)) +;; 'string-lessp) +;; (sort (mapcar +;; (function +;; (lambda (sym) +;; (let ((name (symbol-name sym))) +;; (if (string-match "\\`eshell-\\(.*\\)" name) +;; (setq name (concat "em-" (match-string 1 name)))) +;; (concat name ".el")))) +;; (eshell-subgroups 'eshell-module)) +;; 'string-lessp) +;; (list "eshell.texi")))) ;; (defun eshell-make-readme () ;; "Make the README file from eshell.el." diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index ad513c47a0b..5da511626c5 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -180,9 +180,7 @@ inserted. They return the string as it should be inserted." :group 'eshell-mode) (defcustom eshell-password-prompt-regexp - "\\(\\([Oo]ld \\|[Nn]ew \\|Kerberos \\|CVS \\|'s \\|login \\|^\\)\ -[Pp]assword\\|pass phrase\\|\\(Enter\\|Repeat\\) passphrase\\)\ -\\( for [^@ \t\n]+@[^@ \t\n]+\\)?:\\s *\\'" + "[Pp]ass\\(word\\|phrase\\).*:\\s *\\'" "*Regexp matching prompts for passwords in the inferior process. This is used by `eshell-watch-for-password-prompt'." :type 'regexp @@ -462,7 +460,8 @@ sessions, such as when using `eshell-command'.") (eshell-deftest var window-height "LINES equals window height" - (eshell-command-result-p "= $LINES (window-height)" "t\n")) + (let ((eshell-stringify-t t)) + (eshell-command-result-p "= $LINES (window-height)" "t\n"))) (defun eshell-command-started () "Indicate in the modeline that a command has started." @@ -736,7 +735,9 @@ newline." (run-hooks 'eshell-input-filter-functions) (and (catch 'eshell-terminal (ignore - (eshell-eval-command cmd input))) + (if (eshell-invoke-directly cmd input) + (eval cmd) + (eshell-eval-command cmd input)))) (eshell-life-is-too-much))))) (quit (eshell-reset t) diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el index 3eab199201e..f09f1ac7b24 100644 --- a/lisp/eshell/esh-module.el +++ b/lisp/eshell/esh-module.el @@ -24,7 +24,9 @@ (provide 'esh-module) -(eval-when-compile (require 'esh-maint) (require 'cl)) +(eval-when-compile + (require 'esh-maint) + (require 'cl)) (defgroup eshell-module nil "The `eshell-module' group is for Eshell extension modules, which @@ -85,7 +87,7 @@ customizing the variable `eshell-modules-list'." (equal (file-name-nondirectory byte-compile-current-file) "esh-modu.el")))) (let* ((directory (file-name-directory byte-compile-current-file)) - (elc-file (expand-file-name "esh-groups.elc" directory))) + (elc-file (expand-file-name "esh-groups.elc" directory))) (eshell-load-defgroups directory) (if (file-exists-p elc-file) (delete-file elc-file))))) diff --git a/lisp/eshell/esh-test.el b/lisp/eshell/esh-test.el index 6a14541ab39..acfb409da57 100644 --- a/lisp/eshell/esh-test.el +++ b/lisp/eshell/esh-test.el @@ -173,12 +173,12 @@ system-configuration (cond ((featurep 'motif) ", Motif") ((featurep 'x-toolkit) ", X toolkit") - (t ""))) "\n") + (t "")))) (switch-to-buffer test-buffer) (delete-other-windows)) - (eshell-for funcname - (sort (all-completions "eshell-test--" obarray 'functionp) - 'string-lessp) + (eshell-for funcname (sort (all-completions "eshell-test--" + obarray 'functionp) + 'string-lessp) (with-current-buffer test-buffer (insert "\n")) (funcall (intern-soft funcname))) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 01c0ff2c76e..3d8dedc6bae 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -36,6 +36,14 @@ ;;; User Variables: +(defcustom eshell-stringify-t t + "*If non-nil, the string representation of t is 't'. +If nil, t will be represented only in the exit code of the function, +and not printed as a string. This causes Lisp functions to behave +similarly to external commands, as far as successful result output." + :type 'boolean + :group 'eshell-util) + (defcustom eshell-group-file "/etc/group" "*If non-nil, the name of the group file on your system." :type '(choice (const :tag "No group file" nil) file) @@ -305,7 +313,9 @@ If N or M is nil, it means the end of the list." ((numberp object) (number-to-string object)) (t - (pp-to-string object)))) + (unless (and (eq object t) + (not eshell-stringify-t)) + (pp-to-string object))))) (defsubst eshell-stringify-list (args) "Convert each element of ARGS into a string value." @@ -611,7 +621,7 @@ Unless optional argument INPLACE is non-nil, return a new string." (autoload 'parse-time-string "parse-time")) (eval-when-compile - (require 'ange-ftp)) + (load "ange-ftp" t)) (defun eshell-parse-ange-ls (dir) (let (entry) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index fe95b3faa59..74c07f19602 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1986,7 +1986,7 @@ The word checked is the word at the mouse position." menu)))) ;*---------------------------------------------------------------------*/ -;* Some example functions for real autocrrecting */ +;* Some example functions for real autocrrecting xb */ ;*---------------------------------------------------------------------*/ (defun flyspell-maybe-correct-transposition (beg end poss) "Apply 'transpose-chars' to all points in the region BEG to END and @@ -1994,17 +1994,24 @@ return t if any those result in a possible replacement suggested by ispell in POSS. Otherwise the change is undone. This function is meant to be added to 'flyspell-incorrect-hook'." - (when (consp poss) + (when (consp poss) (catch 'done - (save-excursion - (goto-char (1+ beg)) - (while (< (point) end) - (transpose-chars 1) - (when (member (buffer-substring beg end) (nth 2 poss)) - (throw 'done t)) - (transpose-chars -1) - (forward-char)) - nil)))) + (let ((str (buffer-substring beg end)) + (i 0) (len (- end beg)) tmp) + (while (< (1+ i) len) + (setq tmp (aref str i)) + (aset str i (aref str (1+ i))) + (aset str (1+ i) tmp) + (when (member str (nth 2 poss)) + (save-excursion + (goto-char (+ beg i 1)) + (transpose-chars 1)) + (throw 'done t)) + (setq tmp (aref str i)) + (aset str i (aref str (1+ i))) + (aset str (1+ i) tmp) + (setq i (1+ i)))) + nil))) (defun flyspell-maybe-correct-doubling (beg end poss) "For each doubled charachter in the region BEG to END, remove one and @@ -2014,21 +2021,18 @@ in POSS. Otherwise the change is undone. This function is meant to be added to 'flyspell-incorrect-hook'." (when (consp poss) (catch 'done - (save-excursion - (let ((last (char-after beg)) - this) - (goto-char (1+ beg)) - (while (< (point) end) - (setq this (char-after)) - (if (not (char-equal this last)) - (forward-char) - (delete-char 1) - (when (member (buffer-substring beg (1- end)) (nth 2 poss)) - (throw 'done t)) - ;; undo - (insert-char this 1)) - (setq last this)) - nil))))) + (let ((str (buffer-substring beg end)) + (i 0) (len (- end beg))) + (while (< (1+ i) len) + (when (and (= (aref str i) (aref str (1+ i))) + (member (concat (substring str 0 (1+ i)) + (substring str (+ i 2))) + (nth 2 poss))) + (goto-char (+ beg i)) + (delete-char 1) + (throw 'done t)) + (setq i (1+ i)))) + nil))) ;*---------------------------------------------------------------------*/ ;* flyspell-already-abbrevp ... */ |
