Mercurial > emacs
comparison lisp/mh-e/mh-utils.el @ 68199:5012e59a73c7
* mh-comp.el (mh-pgp-support-flag): Move here from mh-utils.el; needed
to help remove dependency on mh-utils.
* mh-exec.el: New file. Move process support routines here from
mh-utils.el.
* mh-init.el (mh-utils): Remove require.
(mh-exec): Add require.
(mh-profile-component, mh-profile-component-value): Move here from
mh-utils.el.
* mh-utils.el (mh-pgp-support-flag): Move to mh-comp.el to reduce
dependencies on mh-utils.el.
(mh-profile-component, mh-profile-component-value): Move to mh-init.el
since that's the only place that uses them. (Other than mh-alias.el;
I'm thinking that mh-find-path can set variable from the Aliasfile
component like it does the other components).
(mh-index-max-cmdline-args, mh-xargs, mh-quote-for-shell)
(mh-exec-cmd, mh-exec-cmd-error, mh-exec-cmd-daemon)
(mh-exec-cmd-env-daemon, mh-process-daemon, mh-exec-cmd-quiet)
(defvar, mh-exec-cmd-output)
(mh-exchange-point-and-mark-preserving-active-mark)
(mh-exec-lib-cmd-output, mh-handle-process-error): Move to new file
mh-exec.el so that mh-init.el doesn't have to depend on mh-utils.el,
breaking circular dependency.
* mh-alias.el: mh-customize.el: mh-e.el: mh-funcs.el: mh-gnus.el:
* mh-identity.el: mh-inc.el: mh-junk.el: mh-mime.el: mh-print.el:
* mh-search.el: mh-seq.el: mh-speed.el: Added debugging statements
(commented out) around requires to help find dependency loops. Will
remove them when issues are resolved.
author | Bill Wohler <wohler@newt.com> |
---|---|
date | Sun, 15 Jan 2006 08:17:56 +0000 |
parents | dcf226991252 |
children | 1052cc7b7d7f 7beb78bc1f8e |
comparison
equal
deleted
inserted
replaced
68198:f00134dbd2a6 | 68199:5012e59a73c7 |
---|---|
31 | 31 |
32 ;;; Change Log: | 32 ;;; Change Log: |
33 | 33 |
34 ;;; Code: | 34 ;;; Code: |
35 | 35 |
36 ;;(message "> mh-utils") | |
36 (eval-and-compile | 37 (eval-and-compile |
37 (defvar recursive-load-depth-limit) | 38 (defvar recursive-load-depth-limit) |
38 (if (and (boundp 'recursive-load-depth-limit) | 39 (if (and (boundp 'recursive-load-depth-limit) |
39 (integerp recursive-load-depth-limit) | 40 (integerp recursive-load-depth-limit) |
40 (< recursive-load-depth-limit 50)) | 41 (< recursive-load-depth-limit 50)) |
48 (require 'mh-buffers) | 49 (require 'mh-buffers) |
49 (require 'mh-customize) | 50 (require 'mh-customize) |
50 (require 'mh-inc) | 51 (require 'mh-inc) |
51 (require 'mouse) | 52 (require 'mouse) |
52 (require 'sendmail) | 53 (require 'sendmail) |
54 ;;(message "< mh-utils") | |
53 | 55 |
54 ;; Non-fatal dependencies | 56 ;; Non-fatal dependencies |
55 (load "hl-line" t t) | 57 (load "hl-line" t t) |
56 (load "mm-decode" t t) | 58 (load "mm-decode" t t) |
57 (load "mm-view" t t) | 59 (load "mm-view" t t) |
194 "Convenience macro to get the MIME data structures of the current buffer." | 196 "Convenience macro to get the MIME data structures of the current buffer." |
195 `(gethash (current-buffer) mh-globals-hash)) | 197 `(gethash (current-buffer) mh-globals-hash)) |
196 | 198 |
197 (defvar mh-globals-hash (make-hash-table) | 199 (defvar mh-globals-hash (make-hash-table) |
198 "Keeps track of MIME data on a per buffer basis.") | 200 "Keeps track of MIME data on a per buffer basis.") |
199 | |
200 (defvar mh-pgp-support-flag (not (not (locate-library "mml2015"))) | |
201 "Non-nil means PGP support is available.") | |
202 | 201 |
203 (defvar mh-mm-inline-media-tests | 202 (defvar mh-mm-inline-media-tests |
204 `(("image/jpeg" | 203 `(("image/jpeg" |
205 mm-inline-image | 204 mm-inline-image |
206 (lambda (handle) | 205 (lambda (handle) |
1952 (setq return-value nil)) | 1951 (setq return-value nil)) |
1953 (beginning-of-line) | 1952 (beginning-of-line) |
1954 (or dont-show (not return-value) (mh-maybe-show number)) | 1953 (or dont-show (not return-value) (mh-maybe-show number)) |
1955 return-value)) | 1954 return-value)) |
1956 | 1955 |
1957 (defun mh-profile-component (component) | |
1958 "Return COMPONENT value from mhparam, or nil if unset." | |
1959 (save-excursion | |
1960 (mh-exec-cmd-quiet nil "mhparam" "-components" component) | |
1961 (mh-profile-component-value component))) | |
1962 | |
1963 (defun mh-profile-component-value (component) | |
1964 "Find and return the value of COMPONENT in the current buffer. | |
1965 Returns nil if the component is not in the buffer." | |
1966 (let ((case-fold-search t)) | |
1967 (goto-char (point-min)) | |
1968 (cond ((not (re-search-forward (format "^%s:" component) nil t)) nil) | |
1969 ((looking-at "[\t ]*$") nil) | |
1970 (t | |
1971 (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) | |
1972 (let ((start (match-beginning 1))) | |
1973 (end-of-line) | |
1974 (buffer-substring start (point))))))) | |
1975 | |
1976 (defun mh-set-folder-modified-p (flag) | 1956 (defun mh-set-folder-modified-p (flag) |
1977 "Mark current folder as modified or unmodified according to FLAG." | 1957 "Mark current folder as modified or unmodified according to FLAG." |
1978 (set-buffer-modified-p flag)) | 1958 (set-buffer-modified-p flag)) |
1979 | 1959 |
1980 (defun mh-find-seq (name) | 1960 (defun mh-find-seq (name) |
2426 (mh-expand-file-name folder-name))))) | 2406 (mh-expand-file-name folder-name))))) |
2427 folder-name)) | 2407 folder-name)) |
2428 | 2408 |
2429 | 2409 |
2430 | 2410 |
2431 ;;; Issue shell and MH commands. | |
2432 | |
2433 (defvar mh-index-max-cmdline-args 500 | |
2434 "Maximum number of command line args.") | |
2435 | |
2436 (defun mh-xargs (cmd &rest args) | |
2437 "Partial imitation of xargs. | |
2438 The current buffer contains a list of strings, one on each line. | |
2439 The function will execute CMD with ARGS and pass the first | |
2440 `mh-index-max-cmdline-args' strings to it. This is repeated till | |
2441 all the strings have been used." | |
2442 (goto-char (point-min)) | |
2443 (let ((current-buffer (current-buffer))) | |
2444 (with-temp-buffer | |
2445 (let ((out (current-buffer))) | |
2446 (set-buffer current-buffer) | |
2447 (while (not (eobp)) | |
2448 (let ((arg-list (reverse args)) | |
2449 (count 0)) | |
2450 (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) | |
2451 (push (buffer-substring-no-properties (point) (line-end-position)) | |
2452 arg-list) | |
2453 (incf count) | |
2454 (forward-line)) | |
2455 (apply #'call-process cmd nil (list out nil) nil | |
2456 (nreverse arg-list)))) | |
2457 (erase-buffer) | |
2458 (insert-buffer-substring out))))) | |
2459 | |
2460 ;; XXX This should be applied anywhere MH-E calls out to /bin/sh. | |
2461 (defun mh-quote-for-shell (string) | |
2462 "Quote STRING for /bin/sh. | |
2463 Adds double-quotes around entire string and quotes the characters | |
2464 \\, `, and $ with a backslash." | |
2465 (concat "\"" | |
2466 (loop for x across string | |
2467 concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) | |
2468 "\"")) | |
2469 | |
2470 (defun mh-exec-cmd (command &rest args) | |
2471 "Execute mh-command COMMAND with ARGS. | |
2472 The side effects are what is desired. Any output is assumed to be | |
2473 an error and is shown to the user. The output is not read or | |
2474 parsed by MH-E." | |
2475 (save-excursion | |
2476 (set-buffer (get-buffer-create mh-log-buffer)) | |
2477 (let* ((initial-size (mh-truncate-log-buffer)) | |
2478 (start (point)) | |
2479 (args (mh-list-to-string args))) | |
2480 (apply 'call-process (expand-file-name command mh-progs) nil t nil args) | |
2481 (when (> (buffer-size) initial-size) | |
2482 (save-excursion | |
2483 (goto-char start) | |
2484 (insert "Errors when executing: " command) | |
2485 (loop for arg in args do (insert " " arg)) | |
2486 (insert "\n")) | |
2487 (save-window-excursion | |
2488 (switch-to-buffer-other-window mh-log-buffer) | |
2489 (sit-for 5)))))) | |
2490 | |
2491 (defun mh-exec-cmd-error (env command &rest args) | |
2492 "In environment ENV, execute mh-command COMMAND with ARGS. | |
2493 ENV is nil or a string of space-separated \"var=value\" elements. | |
2494 Signals an error if process does not complete successfully." | |
2495 (save-excursion | |
2496 (set-buffer (get-buffer-create mh-temp-buffer)) | |
2497 (erase-buffer) | |
2498 (let ((process-environment process-environment)) | |
2499 ;; XXX: We should purge the list that split-string returns of empty | |
2500 ;; strings. This can happen in XEmacs if leading or trailing spaces | |
2501 ;; are present. | |
2502 (dolist (elem (if (stringp env) (split-string env " ") ())) | |
2503 (push elem process-environment)) | |
2504 (mh-handle-process-error | |
2505 command (apply #'call-process (expand-file-name command mh-progs) | |
2506 nil t nil (mh-list-to-string args)))))) | |
2507 | |
2508 (defun mh-exec-cmd-daemon (command filter &rest args) | |
2509 "Execute MH command COMMAND in the background. | |
2510 | |
2511 If FILTER is non-nil then it is used to process the output | |
2512 otherwise the default filter `mh-process-daemon' is used. See | |
2513 `set-process-filter' for more details of FILTER. | |
2514 | |
2515 ARGS are passed to COMMAND as command line arguments." | |
2516 (save-excursion | |
2517 (set-buffer (get-buffer-create mh-log-buffer)) | |
2518 (mh-truncate-log-buffer)) | |
2519 (let* ((process-connection-type nil) | |
2520 (process (apply 'start-process | |
2521 command nil | |
2522 (expand-file-name command mh-progs) | |
2523 (mh-list-to-string args)))) | |
2524 (set-process-filter process (or filter 'mh-process-daemon)) | |
2525 process)) | |
2526 | |
2527 (defun mh-exec-cmd-env-daemon (env command filter &rest args) | |
2528 "In ennvironment ENV, execute mh-command COMMAND in the background. | |
2529 | |
2530 ENV is nil or a string of space-separated \"var=value\" elements. | |
2531 Signals an error if process does not complete successfully. | |
2532 | |
2533 If FILTER is non-nil then it is used to process the output | |
2534 otherwise the default filter `mh-process-daemon' is used. See | |
2535 `set-process-filter' for more details of FILTER. | |
2536 | |
2537 ARGS are passed to COMMAND as command line arguments." | |
2538 (let ((process-environment process-environment)) | |
2539 (dolist (elem (if (stringp env) (split-string env " ") ())) | |
2540 (push elem process-environment)) | |
2541 (apply #'mh-exec-cmd-daemon command filter args))) | |
2542 | |
2543 (defun mh-process-daemon (process output) | |
2544 "PROCESS daemon that puts OUTPUT into a temporary buffer. | |
2545 Any output from the process is displayed in an asynchronous | |
2546 pop-up window." | |
2547 (with-current-buffer (get-buffer-create mh-log-buffer) | |
2548 (insert-before-markers output) | |
2549 (display-buffer mh-log-buffer))) | |
2550 | |
2551 (defun mh-exec-cmd-quiet (raise-error command &rest args) | |
2552 "Signal RAISE-ERROR if COMMAND with ARGS fails. | |
2553 Execute MH command COMMAND with ARGS. ARGS is a list of strings. | |
2554 Return at start of mh-temp buffer, where output can be parsed and | |
2555 used. | |
2556 Returns value of `call-process', which is 0 for success, unless | |
2557 RAISE-ERROR is non-nil, in which case an error is signaled if | |
2558 `call-process' returns non-0." | |
2559 (set-buffer (get-buffer-create mh-temp-buffer)) | |
2560 (erase-buffer) | |
2561 (let ((value | |
2562 (apply 'call-process | |
2563 (expand-file-name command mh-progs) nil t nil | |
2564 args))) | |
2565 (goto-char (point-min)) | |
2566 (if raise-error | |
2567 (mh-handle-process-error command value) | |
2568 value))) | |
2569 | |
2570 ;; Shush compiler. | |
2571 (eval-when-compile (defvar mark-active)) | |
2572 | |
2573 (defun mh-exec-cmd-output (command display &rest args) | |
2574 "Execute MH command COMMAND with DISPLAY flag and ARGS. | |
2575 Put the output into buffer after point. | |
2576 Set mark after inserted text. | |
2577 Output is expected to be shown to user, not parsed by MH-E." | |
2578 (push-mark (point) t) | |
2579 (apply 'call-process | |
2580 (expand-file-name command mh-progs) nil t display | |
2581 (mh-list-to-string args)) | |
2582 | |
2583 ;; The following is used instead of 'exchange-point-and-mark because the | |
2584 ;; latter activates the current region (between point and mark), which | |
2585 ;; turns on highlighting. So prior to this bug fix, doing "inc" would | |
2586 ;; highlight a region containing the new messages, which is undesirable. | |
2587 ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4. | |
2588 (mh-exchange-point-and-mark-preserving-active-mark)) | |
2589 | |
2590 (defun mh-exchange-point-and-mark-preserving-active-mark () | |
2591 "Put the mark where point is now, and point where the mark is now. | |
2592 This command works even when the mark is not active, and | |
2593 preserves whether the mark is active or not." | |
2594 (interactive nil) | |
2595 (let ((is-active (and (boundp 'mark-active) mark-active))) | |
2596 (let ((omark (mark t))) | |
2597 (if (null omark) | |
2598 (error "No mark set in this buffer")) | |
2599 (set-mark (point)) | |
2600 (goto-char omark) | |
2601 (if (boundp 'mark-active) | |
2602 (setq mark-active is-active)) | |
2603 nil))) | |
2604 | |
2605 (defun mh-exec-lib-cmd-output (command &rest args) | |
2606 "Execute MH library command COMMAND with ARGS. | |
2607 Put the output into buffer after point. | |
2608 Set mark after inserted text." | |
2609 (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args)) | |
2610 | |
2611 (defun mh-handle-process-error (command status) | |
2612 "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS." | |
2613 (if (equal status 0) | |
2614 status | |
2615 (goto-char (point-min)) | |
2616 (insert (if (integerp status) | |
2617 (format "%s: exit code %d\n" command status) | |
2618 (format "%s: %s\n" command status))) | |
2619 (save-excursion | |
2620 (let ((error-message (buffer-substring (point-min) (point-max)))) | |
2621 (set-buffer (get-buffer-create mh-log-buffer)) | |
2622 (mh-truncate-log-buffer) | |
2623 (insert error-message))) | |
2624 (error "%s failed, check buffer %s for error message" | |
2625 command mh-log-buffer))) | |
2626 | |
2627 | |
2628 | |
2629 ;;; List and string manipulation | 2411 ;;; List and string manipulation |
2630 | 2412 |
2631 (defun mh-list-to-string (l) | 2413 (defun mh-list-to-string (l) |
2632 "Flatten the list L and make every element of the new list into a string." | 2414 "Flatten the list L and make every element of the new list into a string." |
2633 (nreverse (mh-list-to-string-1 l))) | 2415 (nreverse (mh-list-to-string-1 l))) |