diff options
| author | Karoly Lorentey <lorentey@elte.hu> | 2006-02-03 13:58:41 +0000 |
|---|---|---|
| committer | Karoly Lorentey <lorentey@elte.hu> | 2006-02-03 13:58:41 +0000 |
| commit | 0a7114a4e535e70b237b15817988344a03fe7ab1 (patch) | |
| tree | 62203ebf84b3070c638cbea265d25fe542514cc0 /lisp | |
| parent | eb2bfdae0a1b6579908f072ab57aec0d80d6c6ec (diff) | |
| parent | c36f1e67800423383832447c45e6125bf46efc7a (diff) | |
| download | emacs-0a7114a4e535e70b237b15817988344a03fe7ab1.tar.gz | |
Merged from
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-32
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-33
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-34
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-35
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-36
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-37
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-8
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-9
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-10
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-11
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-12
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-13
Merge from emacs--devo--0
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-504
Diffstat (limited to 'lisp')
42 files changed, 1039 insertions, 587 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5a03a2e8502..22798bb24ff 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,85 @@ +2006-02-02 Luc Teirlinck <teirllm@auburn.edu> + + * emulation/cua-base.el (cua-mode): Doc fix. + +2006-02-02 Juanma Barranquero <lekktu@gmail.com> + + * dframe.el (dframe-handle-make-frame-visible) + (dframe-handle-iconify-frame, dframe-get-focus) + (dframe-select-attached-frame, dframe-power-click) + (dframe-frame-mode): Fix typos in docstrings. + + * ezimage.el (ezimage-mail, ezimage-object-out-of-date) + (ezimage-insert-image-button-maybe, ezimage-insert-over-text): + Fix typos in docstrings. + + * hi-lock.el (hi-lock-mode, hi-lock-line-face-buffer) + (hi-lock-face-buffer, hi-lock-font-lock-hook) + (hi-lock-archaic-interface-message-used) + (hi-lock-file-patterns-range): Fix typos in docstrings. + + * savehist.el (savehist-loaded, savehist-load, savehist-install) + (savehist-autosave, savehist-trim-history): Fix typos in + docstrings. + + * mail/mailclient.el (mailclient-place-body-on-clipboard-flag): + Fix typo in docstring. + + * net/rcirc.el (rcirc-debug): Fix docstring. + (rcirc-fill-column, rcirc-receive-message-hooks) + (rcirc-browse-url-map, rcirc-read-only-flag, rcirc-prompt) + (rcirc-mode, rcirc-generate-new-buffer-name) + (rcirc-startup-channels, rcirc-ignore-update-automatic) + (rcirc-cmd-ignore, rcirc-browse-url, rcirc-url-regexp): + Fix typos in docstrings. + (rcirc-print): "?\ " -> "?\s". + +2006-02-01 Mark A. Hershberger <mah@everybody.org> + + * xml.el (xml-parse-region): Move save-excursion and set-buffer up + before narrow-to-region. + +2006-02-01 Richard M. Stallman <rms@gnu.org> + + * simple.el (move-beginning-of-line): Scan properly for invis change. + + * replace.el (multi-occur-in-matching-buffers): Fix prev change. + +2006-02-01 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-convert-file-attributes): Set file's gid + change bit only when id-format is 'integer. Reported by Matt + Hodges <M.P.Hodges@rl.ac.uk>. + +2006-02-01 Juanma Barranquero <lekktu@gmail.com> + + * hilit-chg.el (highlight-changes-initial-state) + (highlight-changes-global-initial-state): Doc fixes. + (highlight-changes-global-modes, global-highlight-changes): + Fix typos in docstrings. + +2006-02-01 Kim F. Storm <storm@cua.dk> + + * emulation/cua-base.el (cua-mode): Mention that CUA enables + transient-mark-mode in doc string. + +2006-01-31 Richard M. Stallman <rms@gnu.org> + + * replace.el (multi-occur): Doc fix. + (multi-occur-in-matching-buffers): Renamed from + multi-occur-by-filename-regexp. Prefix arg says match + buffer names instead of file names. + +2006-01-31 Juanma Barranquero <lekktu@gmail.com> + + * bs.el: Allow non-default values of `bs-header-lines-length'. + (bs--running-in-xemacs): Remove (not needed anymore). + (bs--set-window-height): Simplify by using `fit-window-to-buffer' + instead of `shrink-window', thus avoiding having to compute the + height of the window. + (bs--up): Wrap around even when there's no header. + (bs--down): Use `forward-line' instead of `next-line'. + 2006-01-30 Chong Yidong <cyd@stupidchicken.com> * image-mode.el (image-toggle-display): Use file name if possible, diff --git a/lisp/bs.el b/lisp/bs.el index 464f6086a04..bdeb00f5804 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -180,9 +180,6 @@ return a string representing the column's value." :group 'bs-appearance :type '(repeat sexp)) -(defvar bs--running-in-xemacs (string-match "XEmacs" (emacs-version)) - "Non-nil when running under XEmacs.") - (defun bs--make-header-match-string () "Return a regexp matching the first line of a Buffer Selection Menu buffer." (let ((res "^\\(") @@ -701,12 +698,7 @@ Return nil if there is no such buffer." (defun bs--set-window-height () "Change the height of the selected window to suit the current buffer list." (unless (one-window-p t) - (shrink-window (- (window-height (selected-window)) - ;; window-height in xemacs includes mode-line - (+ (if bs--running-in-xemacs 3 1) - bs-header-lines-length - (min (length bs-current-list) - bs-max-window-height)))))) + (fit-window-to-buffer (selected-window) bs-max-window-height))) (defun bs--current-buffer () "Return buffer on current line. @@ -1011,13 +1003,11 @@ Uses function `vc-toggle-read-only'." "Move cursor vertically up one line. If on top of buffer list go to last line." (interactive "p") - (previous-line 1) - (if (<= (count-lines 1 (point)) (1- bs-header-lines-length)) - (progn - (goto-char (point-max)) - (beginning-of-line) - (recenter -1)) - (beginning-of-line))) + (if (> (count-lines 1 (point)) bs-header-lines-length) + (forward-line -1) + (goto-char (point-max)) + (beginning-of-line) + (recenter -1))) (defun bs-down (arg) "Move cursor vertically down ARG lines in Buffer Selection Menu." @@ -1029,10 +1019,9 @@ If on top of buffer list go to last line." (defun bs--down () "Move cursor vertically down one line. If at end of buffer list go to first line." - (let ((last (line-end-position))) - (if (eq last (point-max)) - (goto-line (1+ bs-header-lines-length)) - (next-line 1)))) + (if (eq (line-end-position) (point-max)) + (goto-line (1+ bs-header-lines-length)) + (forward-line 1))) (defun bs-visits-non-file (buffer) "Return t or nil whether BUFFER visits no file. diff --git a/lisp/dframe.el b/lisp/dframe.el index 56bbdc36c01..e15b57af605 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -1,6 +1,7 @@ ;;; dframe --- dedicate frame support modes -;;; Copyright (C) 1996, 97, 98, 99, 2000, 01, 02, 03, 04, 05 Free Software Foundation +;;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: file, tags, tools @@ -299,7 +300,7 @@ This frame is either resurrected, hidden, killed, etc based on the value. CACHE-VAR is a variable used to cache a cached frame. BUFFER-VAR is a variable used to cache the buffer being used in dframe. -This buffer will have `dframe-mode' run on it. +This buffer will have `dframe-frame-mode' run on it. FRAME-NAME is the name of the frame to create. LOCAL-MODE-FN is the function used to call this one. PARAMETERS are frame parameters to apply to this dframe. @@ -606,7 +607,7 @@ The function must take an EVENT.") (defun dframe-handle-make-frame-visible (e) "Handle a `make-frame-visible' event. -Should enables auto-updating if the last state was also enabled. +Should enable auto-updating if the last state was also enabled. Argument E is the event making the frame visible." (interactive "e") (let ((f last-event-frame)) @@ -617,7 +618,7 @@ Argument E is the event making the frame visible." (defun dframe-handle-iconify-frame (e) "Handle a `iconify-frame' event. -Should disables auto-updating if the last state was also enabled. +Should disable auto-updating if the last state was also enabled. Argument E is the event iconifying the frame." (interactive "e") (let ((f last-event-frame)) @@ -652,7 +653,7 @@ If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR frame is selected. If the FRAME-VAR is active, then select the attached frame. If FRAME-VAR is nil, ACTIVATOR is called to created it. HOOK is an optional argument of hooks to run when -selecting FRAME." +selecting FRAME-VAR." (interactive) (if (eq (selected-frame) (symbol-value frame-var)) (if (frame-live-p dframe-attached-frame) @@ -696,10 +697,10 @@ If optional arg FRAME is nil just return `dframe-attached-frame'." dframe-attached-frame)) (defun dframe-select-attached-frame (&optional frame) - "Switch to the frame the dframe controlled frame FRAME was started from. If -optional arg FRAME is nil assume the attached frame is already selected and -just run the hooks `dframe-after-select-attached-frame-hook'. Return the -attached frame." + "Switch to the frame the dframe controlled frame FRAME was started from. +If optional arg FRAME is nil assume the attached frame is already selected +and just run the hooks `dframe-after-select-attached-frame-hook'. Return +the attached frame." (let ((frame (dframe-attached-frame frame))) (if frame (select-frame frame)) (prog1 frame @@ -957,7 +958,7 @@ This should be bound to mouse event E." (funcall dframe-mouse-position-function))) (defun dframe-power-click (e) - "Activate any `dframe' mouse click as a power click. + "Activate any dframe mouse click as a power click. A power click will dispose of cached data (if available) or bring a buffer up into a different window. This should be bound to mouse event E." diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el index 4b1312d58d7..27e079b1dcd 100644 --- a/lisp/emacs-lisp/unsafep.el +++ b/lisp/emacs-lisp/unsafep.el @@ -79,11 +79,13 @@ ;; passed a circular list to `assoc', Emacs would crash. Historically, ;; problems of this kind have been few and short-lived. +;;; Code: + (provide 'unsafep) (require 'byte-opt) ;Set up the `side-effect-free' properties (defcustom safe-functions nil - "t to disable `unsafep', or a list of assumed-safe functions." + "A list of assumed-safe functions, or t to disable `unsafep'." :group 'lisp :type '(choice (const :tag "No" nil) (const :tag "Yes" t) hook)) @@ -210,7 +212,7 @@ of symbols with local bindings." (defun unsafep-function (fun) - "Return nil if FUN is a safe function + "Return nil iff FUN is a safe function. \(either a safe lambda or a symbol that names a safe function). Otherwise result is a reason code." (cond @@ -233,7 +235,8 @@ for the first unsafe form." (if reason (throw 'unsafep-progn reason)))))) (defun unsafep-let (clause) - "CLAUSE is a let-binding, either SYM or (SYM) or (SYM VAL). Checks VAL + "Check the safety of a let binding. +CLAUSE is a let-binding, either SYM or (SYM) or (SYM VAL). Checks VAL and throws a reason to `unsafep' if unsafe. Returns SYM." (let (reason sym) (if (atom clause) @@ -245,7 +248,7 @@ and throws a reason to `unsafep' if unsafe. Returns SYM." sym)) (defun unsafep-variable (sym global-okay) - "Returns nil if SYM is safe as a let-binding sym + "Return nil if SYM is safe as a let-binding sym \(because it already has a temporary binding or is a non-risky buffer-local variable), otherwise a reason why it is unsafe. Failing to be locally bound is okay if GLOBAL-OKAY is non-nil." @@ -259,5 +262,5 @@ is okay if GLOBAL-OKAY is non-nil." (local-variable-p sym))) `(global-variable ,sym)))) -;;; arch-tag: 6216f98b-eb8f-467a-9c33-7a7644f50658 -;; unsafep.el ends here. +;; arch-tag: 6216f98b-eb8f-467a-9c33-7a7644f50658 +;;; unsafep.el ends here diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 26d94e99e88..a65fe0b636c 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1393,7 +1393,12 @@ options: You can customize `cua-enable-cua-keys' to completely disable the CUA bindings, or `cua-prefix-override-inhibit-delay' to change -the prefix fallback behavior." +the prefix fallback behavior. + +CUA mode manages Transient Mark mode internally. Trying to disable +Transient Mark mode while CUA mode is enabled does not work; if you +only want to highlight the region when it is selected using a +shifted movement key, set `cua-highlight-region-shift-only'." :global t :group 'cua :set-after '(cua-enable-modeline-indications cua-rectangle-modifier-key) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 3089502d114..98022b601e6 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,7 @@ +2006-01-30 Simon Josefsson <jas@extundo.com> + + * erc.el (erc-open-ssl-stream): Use tls.el. + 2006-01-30 Michael Olson <mwolson@gnu.org> * erc-stamp.el (erc-timestamp-right-align-by-pixel): New option diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 9ff3ff51dc5..3c6baf1fdb4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2062,13 +2062,14 @@ Arguments are as to erc-select." "Open an SSL stream to an IRC server. The process will be given the name NAME, its target buffer will be BUFFER. HOST and PORT specify the connection target." - (when (require 'ssl) - (let ((proc (open-ssl-stream name buffer host port))) + (when (require 'tls) + (let ((proc (open-tls-stream name buffer host port))) ;; Ugly hack, but it works for now. Problem is it is ;; very hard to detect when ssl is established, because s_client ;; doesn't give any CONNECTIONESTABLISHED kind of message, and ;; most IRC servers send nothing and wait for you to identify. - (sit-for 5) + ;; Disabled when switching to tls.el -- jas + ;(sit-for 5) proc))) ;;; Debugging the protocol diff --git a/lisp/ezimage.el b/lisp/ezimage.el index a00703d5471..a689adc25cd 100644 --- a/lisp/ezimage.el +++ b/lisp/ezimage.el @@ -78,7 +78,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image." ) (if (not (fboundp 'make-glyph)) - + (defmacro defezimage (variable imagespec docstring) "Don't bother loading up an image... Argument VARIABLE is the variable to define. @@ -194,7 +194,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image." (defezimage ezimage-mail ((:type xpm :file "ezimage/mail.xpm" :ascent center)) - "Image if an envelope.") + "Image of an envelope.") (defezimage ezimage-checkout ((:type xpm :file "ezimage/checkmark.xpm" :ascent center)) @@ -206,7 +206,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image." (defezimage ezimage-object-out-of-date ((:type xpm :file "ezimage/bitsbang.xpm" :ascent center)) - "Image representing bits with a ! in it. (an out of data object file.)") + "Image representing bits with a ! in it. (An out of data object file.)") (defezimage ezimage-label ((:type xpm :file "ezimage/label.xpm" :ascent center)) @@ -264,7 +264,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image." "Insert an image button based on text starting at START for LENGTH chars. If buttontext is unknown, just insert that text. If we have an image associated with it, use that image. -Optional argument STRING is a st ring upon which to add text properties." +Optional argument STRING is a string upon which to add text properties." (when ezimage-use-images (let* ((bt (buffer-substring start (+ length start))) (a (assoc bt ezimage-expand-image-button-alist))) @@ -293,7 +293,7 @@ Return STRING with properties applied." (defun ezimage-insert-over-text (image start end &optional string) "Place IMAGE over the text between START and END. -Assumes the image is part of a gui and can be clicked on. +Assumes the image is part of a GUI and can be clicked on. Optional argument STRING is a string upon which to add text properties." (when ezimage-use-images (if (featurep 'xemacs) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index cd98afa3da5..87a3f1918d6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,8 +1,60 @@ +2006-01-31 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de> + + * nnweb.el (nnweb-group-alist): Use defvar instead of defvoo, + there's only one active file for all servers. + (nnweb-request-scan): Make sure nnweb-articles is initialized on + solid groups. Gnus might have used a FAST request to select the + group. + (nnweb-request-group, nnweb-google-parse-1): Don't keep nnweb-type + and nnweb-search redundantly in the active file. + (nnweb-request-list): Don't list bogus groups. There can only be + one. + (nnweb-request-create-group): Don't use ARGS. + (nnweb-possibly-change-server, nnweb-request-group): Remove some + initialisations. Let nnoo do the work. + +2006-01-31 Romain Francoise <romain@orebokech.com> + + * message.el (message-alternative-emails): Improve docstring. + (message-setup-1): Call `message-use-alternative-email-as-from' + after `message-setup-hook' to give it precedence over posting + styles, etc. + (message-use-alternative-email-as-from): Add docstring. Remove + the original From header if present. + +2006-01-31 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-uu.el (mm-uu-emacs-sources-extract): Say the part has been + decoded. + (mm-uu-diff-extract): Ditto. + +2006-01-31 Kevin Ryde <user42@zip.com.au> + + * mailcap.el (mailcap-viewer-passes-test): Don't put "(nil t)" into + mailcap-viewer-test-cache when there's no 'test clause, since that + will invert the meaning of a "nil" test previously determined by + mailcap-mailcap-entry-passes-test. + +2006-01-30 Reiner Steib <Reiner.Steib@gmx.de> + + * nnweb.el (nnweb-google-parse-1): Clarify some comments. + +2006-01-30 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de> + + * nnweb.el (nnweb-type-definition, nnweb-google-parse-1) + (nnweb-google-create-mapping, nnweb-google-search): Adapt to + current Google Groups. + +2006-01-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * Makefile.in (clean): New rule. + (distclean): Use it. + 2006-01-25 Katsumi Yamaoka <yamaoka@jpl.org> * mm-uu.el (mm-uu-dissect-text-parts): Ignore it if a given part is dissected into a single part of which the type is the same as - the given one. + the given one; decode charset. 2006-01-21 Kevin Ryde <user42@zip.com.au> diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index 80153645819..f0d93f38655 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -1,7 +1,7 @@ ;;; mailcap.el --- MIME media types configuration ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: William M. Perry <wmperry@aventail.com> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -640,30 +640,31 @@ to supply to the test." (viewer (cdr (assoc 'viewer viewer-info))) (default-directory (expand-file-name "~/")) status parsed-test cache result) - (if (setq cache (assoc test mailcap-viewer-test-cache)) - (cadr cache) - (setq - result - (cond - ((not test-info) t) ; No test clause - ((not test) nil) ; Already failed test - ((eq test t) t) ; Already passed test - ((functionp test) ; Lisp function as test - (funcall test type-info)) - ((and (symbolp test) ; Lisp variable as test - (boundp test)) - (symbol-value test)) - ((and (listp test) ; List to be eval'd - (symbolp (car test))) - (eval test)) - (t - (setq test (mailcap-unescape-mime-test test type-info) - test (list shell-file-name nil nil nil - shell-command-switch test) - status (apply 'call-process test)) - (eq 0 status)))) - (push (list otest result) mailcap-viewer-test-cache) - result))) + (cond ((setq cache (assoc test mailcap-viewer-test-cache)) + (cadr cache)) + ((not test-info) t) ; No test clause + (t + (setq + result + (cond + ((not test) nil) ; Already failed test + ((eq test t) t) ; Already passed test + ((functionp test) ; Lisp function as test + (funcall test type-info)) + ((and (symbolp test) ; Lisp variable as test + (boundp test)) + (symbol-value test)) + ((and (listp test) ; List to be eval'd + (symbolp (car test))) + (eval test)) + (t + (setq test (mailcap-unescape-mime-test test type-info) + test (list shell-file-name nil nil nil + shell-command-switch test) + status (apply 'call-process test)) + (eq 0 status)))) + (push (list otest result) mailcap-viewer-test-cache) + result)))) (defun mailcap-add-mailcap-entry (major minor info) (let ((old-major (assoc major mailcap-mime-data))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 797d2233fe5..28325b73e26 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1388,8 +1388,13 @@ should be sent in several parts. If it is nil, the size is unlimited." (integer 1000000))) (defcustom message-alternative-emails nil - "A regexp to match the alternative email addresses. -The first matched address (not primary one) is used in the From field." + "*Regexp matching alternative email addresses. +The first address in the To, Cc or From headers of the original +article matching this variable is used as the From field of +outgoing messages. + +This variable has precedence over posting styles and anything that runs +off `message-setup-hook'." :group 'message-headers :link '(custom-manual "(message)Message Headers") :type '(choice (const :tag "Always use primary" nil) @@ -5546,10 +5551,6 @@ are not included." (when message-default-mail-headers (insert message-default-mail-headers) (or (bolp) (insert ?\n))) - (save-restriction - (message-narrow-to-headers) - (if message-alternative-emails - (message-use-alternative-email-as-from))) (when message-generate-headers-first (message-generate-headers (message-headers-to-generate @@ -5565,6 +5566,12 @@ are not included." (set-buffer-modified-p nil) (setq buffer-undo-list nil) (run-hooks 'message-setup-hook) + ;; Do this last to give it precedence over posting styles, etc. + (when (message-mail-p) + (save-restriction + (message-narrow-to-headers) + (if message-alternative-emails + (message-use-alternative-email-as-from)))) (message-position-point) (undo-boundary)) @@ -6848,6 +6855,9 @@ regexp VARSTR." (read-string prompt initial-contents)))) (defun message-use-alternative-email-as-from () + "Set From field of the outgoing message to the first matching +address in `message-alternative-emails', looking at To, Cc and +From headers in the original article." (require 'mail-utils) (let* ((fields '("To" "Cc")) (emails @@ -6862,6 +6872,7 @@ regexp VARSTR." emails nil)) (pop emails)) (unless (or (not email) (equal email user-mail-address)) + (message-remove-header "From") (goto-char (point-max)) (insert "From: " email "\n")))) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index fa36582af01..eb5afa794f5 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -266,7 +266,7 @@ Return that buffer." (defun mm-uu-emacs-sources-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("application/emacs-lisp") + '("application/emacs-lisp" (charset . gnus-decoded)) nil nil (list mm-dissect-disposition (cons 'filename file-name)))) @@ -282,7 +282,7 @@ Return that buffer." (defun mm-uu-diff-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("text/x-patch"))) + '("text/x-patch" (charset . gnus-decoded)))) (defun mm-uu-diff-test () (and gnus-newsgroup-name @@ -509,31 +509,53 @@ value of `mm-uu-text-plain-type'." (setq result (cons "multipart/mixed" (nreverse result)))) result))) -(defun mm-uu-dissect-text-parts (handle) - "Dissect text parts and put uu handles into HANDLE." +;;;###autoload +(defun mm-uu-dissect-text-parts (handle &optional decoded) + "Dissect text parts and put uu handles into HANDLE. +Assume text has been decoded if DECODED is non-nil." (let ((buffer (mm-handle-buffer handle))) (cond ((stringp buffer) (dolist (elem (cdr handle)) - (mm-uu-dissect-text-parts elem))) + (mm-uu-dissect-text-parts elem decoded))) ((bufferp buffer) (let ((type (mm-handle-media-type handle)) (case-fold-search t) ;; string-match - encoding children) + children charset encoding) (when (and (stringp type) ;; Mutt still uses application/pgp even though ;; it has already been withdrawn. (string-match "\\`text/\\|\\`application/pgp\\'" type) - (setq children - (with-current-buffer buffer - (if (setq encoding (mm-handle-encoding handle)) - ;; Inherit the multibyteness of the `buffer'. - (with-temp-buffer - (insert-buffer-substring buffer) - (mm-decode-content-transfer-encoding - encoding type) - (mm-uu-dissect t (mm-handle-type handle))) - (mm-uu-dissect t (mm-handle-type handle)))))) + (setq + children + (with-current-buffer buffer + (cond + ((or decoded + (eq (setq charset (mail-content-type-get + (mm-handle-type handle) + 'charset)) + 'gnus-decoded)) + (setq decoded t) + (mm-uu-dissect + t (cons type '((charset . gnus-decoded))))) + (charset + (setq decoded t) + (mm-with-multibyte-buffer + (insert (mm-decode-string (mm-get-part handle) + charset)) + (mm-uu-dissect + t (cons type '((charset . gnus-decoded)))))) + ((setq encoding (mm-handle-encoding handle)) + (setq decoded nil) + ;; Inherit the multibyteness of the `buffer'. + (with-temp-buffer + (insert-buffer-substring buffer) + (mm-decode-content-transfer-encoding + encoding type) + (mm-uu-dissect t (list type)))) + (t + (setq decoded nil) + (mm-uu-dissect t (list type))))))) ;; Ignore it if a given part is dissected into a single ;; part of which the type is the same as the given one. (if (and (<= (length children) 2) @@ -544,10 +566,10 @@ value of `mm-uu-text-plain-type'." (setcdr handle (cdr children)) (setcar handle (car children)) ;; "multipart/mixed" (dolist (elem (cdr children)) - (mm-uu-dissect-text-parts elem)))))) + (mm-uu-dissect-text-parts elem decoded)))))) (t (dolist (elem handle) - (mm-uu-dissect-text-parts elem)))))) + (mm-uu-dissect-text-parts elem decoded)))))) (provide 'mm-uu) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index d3737cd66fd..4723a694182 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -1,7 +1,7 @@ ;;; nnweb.el --- retrieving articles via web search engines ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -27,11 +27,8 @@ ;; Note: You need to have `w3' installed for some functions to work. -;; FIXME: Due to changes in the HTML output of Google Groups and Gmane, stuff -;; related to web groups (gnus-group-make-web-group) doesn't work anymore. - -;; Fetching an article by MID (cf. gnus-refer-article-method) over Google -;; Groups should work. +;; FIXME: Due to changes in the HTML output of Gmane, stuff related to Gmane +;; web groups (`gnus-group-make-web-group') doesn't work anymore. ;;; Code: @@ -61,6 +58,7 @@ Valid types include `google', `dejanews', and `gmane'.") (defvar nnweb-type-definition '((google (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") + (result . "http://groups.google.com/group/%s/msg/%s?dmode=source") (article . nnweb-google-wash-article) (reference . identity) (map . nnweb-google-create-mapping) @@ -69,8 +67,9 @@ Valid types include `google', `dejanews', and `gmane'.") (base . "http://groups.google.com") (identifier . nnweb-google-identity)) (dejanews ;; alias of google - (article . ignore) - (id . "http://groups.google.com/groups?selm=%s&output=gplain") + (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source") + (result . "http://groups.google.com/group/%s/msg/%s?dmode=source") + (article . nnweb-google-wash-article) (reference . identity) (map . nnweb-google-create-mapping) (search . nnweb-google-search) @@ -100,7 +99,7 @@ Valid types include `google', `dejanews', and `gmane'.") (defvoo nnweb-articles nil) (defvoo nnweb-buffer nil) -(defvoo nnweb-group-alist nil) +(defvar nnweb-group-alist nil) (defvoo nnweb-group nil) (defvoo nnweb-hashtb nil) @@ -123,25 +122,19 @@ Valid types include `google', `dejanews', and `gmane'.") (deffoo nnweb-request-scan (&optional group server) (nnweb-possibly-change-server group server) (if nnweb-ephemeral-p - (setq nnweb-hashtb (gnus-make-hashtable 4095))) + (setq nnweb-hashtb (gnus-make-hashtable 4095)) + (unless nnweb-articles + (nnweb-read-overview group))) (funcall (nnweb-definition 'map)) (unless nnweb-ephemeral-p (nnweb-write-active) (nnweb-write-overview group))) (deffoo nnweb-request-group (group &optional server dont-check) - (nnweb-possibly-change-server nil server) - (when (and group - (not (equal group nnweb-group)) - (not nnweb-ephemeral-p)) - (setq nnweb-group group - nnweb-articles nil) - (let ((info (assoc group nnweb-group-alist))) - (when info - (setq nnweb-type (nth 2 info)) - (setq nnweb-search (nth 3 info)) - (unless dont-check - (nnweb-read-overview group))))) + (nnweb-possibly-change-server group server) + (unless (or nnweb-ephemeral-p + dont-check) + (nnweb-read-overview group)) (cond ((not nnweb-articles) (nnheader-report 'nnweb "No matching articles")) @@ -205,7 +198,7 @@ Valid types include `google', `dejanews', and `gmane'.") (nnweb-possibly-change-server nil server) (save-excursion (set-buffer nntp-server-buffer) - (nnmail-generate-active nnweb-group-alist) + (nnmail-generate-active (list (assoc server nnweb-group-alist))) t)) (deffoo nnweb-request-update-info (group info &optional server) @@ -217,7 +210,7 @@ Valid types include `google', `dejanews', and `gmane'.") (deffoo nnweb-request-create-group (group &optional server args) (nnweb-possibly-change-server nil server) (nnweb-request-delete-group group) - (push `(,group ,(cons 1 0) ,@args) nnweb-group-alist) + (push `(,group ,(cons 1 0)) nnweb-group-alist) (nnweb-write-active) t) @@ -287,18 +280,16 @@ Valid types include `google', `dejanews', and `gmane'.") def)) (defun nnweb-possibly-change-server (&optional group server) - (nnweb-init server) (when server (unless (nnweb-server-opened server) - (nnweb-open-server server))) + (nnweb-open-server server)) + (nnweb-init server)) (unless nnweb-group-alist (nnweb-read-active)) (unless nnweb-hashtb (setq nnweb-hashtb (gnus-make-hashtable 4095))) (when group - (when (and (not nnweb-ephemeral-p) - (equal group nnweb-group)) - (nnweb-request-group group nil t)))) + (setq nnweb-group group))) (defun nnweb-init (server) "Initialize buffers and such." @@ -337,22 +328,27 @@ Valid types include `google', `dejanews', and `gmane'.") (mm-url-decode-entities)))) (defun nnweb-google-parse-1 (&optional Message-ID) + "Parse search result in current buffer." (let ((i 0) (case-fold-search t) (active (cadr (assoc nnweb-group nnweb-group-alist))) Subject Score Date Newsgroups From map url mid) (unless active - (push (list nnweb-group (setq active (cons 1 0)) - nnweb-type nnweb-search) + (push (list nnweb-group (setq active (cons 1 0))) nnweb-group-alist)) ;; Go through all the article hits on this page. (goto-char (point-min)) - (while (re-search-forward - "a href=/groups\\(\\?[^ \">]*selm=\\([^ &\">]+\\)\\)" nil t) - (setq mid (match-string 2) + (while + (re-search-forward + "a +href=\"/group/\\([^>\"]+\\)/browse_thread/[^>]+#\\([0-9a-f]+\\)" + nil t) + (setq Newsgroups (match-string-no-properties 1) + ;; Note: Starting with Google Groups 2, `mid' is a Google-internal + ;; ID, not a proper Message-ID. + mid (match-string-no-properties 2) url (format - (nnweb-definition 'id) mid)) + (nnweb-definition 'result) Newsgroups mid)) (narrow-to-region (search-forward ">" nil t) (search-forward "</a>" nil t)) (mm-url-remove-markup) @@ -360,25 +356,22 @@ Valid types include `google', `dejanews', and `gmane'.") (setq Subject (buffer-string)) (goto-char (point-max)) (widen) - (forward-line 2) - (when (looking-at "<br><font[^>]+>") - (goto-char (match-end 0))) - (if (not (looking-at "<a[^>]+>")) - (skip-chars-forward " \t") - (narrow-to-region (point) - (search-forward "</a>" nil t)) - (mm-url-remove-markup) - (mm-url-decode-entities) - (setq Newsgroups (buffer-string)) - (goto-char (point-max)) - (widen) - (skip-chars-forward "- \t")) + (narrow-to-region (point) + (search-forward "</td" nil t)) + + (mm-url-remove-markup) + (mm-url-decode-entities) + (search-backward " - ") (when (looking-at - "\\([0-9]+\\)[/ ]\\([A-Za-z]+\\)[/ ]\\([0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a") + " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?, [^\n]+by \\([^<\n]+\\)\n") (setq From (match-string 4) Date (format "%s %s 00:00:00 %s" - (match-string 2) (match-string 1) - (match-string 3)))) + (match-string 1) + (match-string 2) + (or (match-string 3) + (substring (current-time-string) -4))))) + + (widen) (forward-line 1) (incf i) (unless (nnweb-get-hashtb url) @@ -419,7 +412,7 @@ Valid types include `google', `dejanews', and `gmane'.") (goto-char (point-min)) (incf i 100) (if (or (not (re-search-forward - "<td nowrap><a href=\\([^>]+\\).*<span class=b>Next</span>" nil t)) + "<td><a href=\"\n\\([^>\"]+\\)\"><img src=\"/img/nav_next" nil t)) (>= i nnweb-max-hits)) (setq more nil) ;; Yup, there are more articles @@ -443,7 +436,8 @@ Valid types include `google', `dejanews', and `gmane'.") ("hl" . "en") ("lr" . "") ("safe" . "off") - ("sites" . "groups"))))) + ("sites" . "groups") + ("filter" . "0"))))) t) (defun nnweb-google-identity (url) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 956ae3a6798..f028bd1f464 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -91,7 +91,7 @@ (defcustom hi-lock-file-patterns-range 10000 "Limit of search in a buffer for hi-lock patterns. -When a file is visited and hi-lock mode is on patterns starting +When a file is visited and hi-lock mode is on, patterns starting up to this limit are added to font-lock's patterns. See documentation of functions `hi-lock-mode' and `hi-lock-find-patterns'." :type 'integer @@ -200,7 +200,7 @@ calls." (defvar hi-lock-archaic-interface-message-used nil "True if user alerted that `global-hi-lock-mode' is now the global switch. -Earlier versions of hi-lock used `hi-lock-mode' as the global switch, +Earlier versions of hi-lock used `hi-lock-mode' as the global switch; the message is issued if it appears that `hi-lock-mode' is used assuming that older functionality. This variable avoids multiple reminders.") @@ -283,10 +283,10 @@ called interactively, are: Remove highlighting on matches of REGEXP in current buffer. \\[hi-lock-write-interactive-patterns] - Write active REGEXPs into buffer as comments (if possible). They will + Write active REGEXPs into buffer as comments (if possible). They will be read the next time file is loaded or when the \\[hi-lock-find-patterns] command is issued. The inserted regexps are in the form of font lock keywords. - (See `font-lock-keywords') They may be edited and re-loaded with \\[hi-lock-find-patterns], + (See `font-lock-keywords'.) They may be edited and re-loaded with \\[hi-lock-find-patterns], any valid `font-lock-keywords' form is acceptable. \\[hi-lock-find-patterns] @@ -295,12 +295,12 @@ called interactively, are: When hi-lock is started and if the mode is not excluded, the beginning of the buffer is searched for lines of the form: Hi-lock: FOO -where FOO is a list of patterns. These are added to the font lock keywords -already present. The patterns must start before position (number -of characters into buffer) `hi-lock-file-patterns-range'. Patterns -will be read until +where FOO is a list of patterns. These are added to the font lock +keywords already present. The patterns must start before position +\(number of characters into buffer) `hi-lock-file-patterns-range'. +Patterns will be read until Hi-lock: end -is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'." +is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'." :group 'hi-lock :lighter (:eval (if (or hi-lock-interactive-patterns hi-lock-file-patterns) @@ -365,7 +365,7 @@ versions before 22 use the following in your .emacs file: Interactively, prompt for REGEXP then FACE. Buffer-local history list maintained for regexps, global history maintained for faces. \\<minibuffer-local-map>Use \\[next-history-element] and \\[previous-history-element] to retrieve next or previous history item. -\(See info node `Minibuffer History')" +\(See info node `Minibuffer History'.)" (interactive (list (hi-lock-regexp-okay @@ -390,7 +390,7 @@ list maintained for regexps, global history maintained for faces. Interactively, prompt for REGEXP then FACE. Buffer-local history list maintained for regexps, global history maintained for faces. \\<minibuffer-local-map>Use \\[next-history-element] and \\[previous-history-element] to retrieve next or previous history item. -\(See info node `Minibuffer History')" +\(See info node `Minibuffer History'.)" (interactive (list (hi-lock-regexp-okay @@ -595,7 +595,7 @@ not suitable." (message "Hi-lock added %d patterns." (length all-patterns)))))) (defun hi-lock-font-lock-hook () - "Add hi lock patterns to font-lock's." + "Add hi-lock patterns to font-lock's." (if font-lock-mode (progn (font-lock-add-keywords nil hi-lock-file-patterns t) diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 7011ff37dd3..55eafb5c617 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -261,15 +261,15 @@ colors then use this, if you want fancier faces then set ;; active or passive mode? ;; (defcustom highlight-changes-initial-state 'active - "*What state (active or passive) `highlight-changes' should start in. -This is used when `highlight-changes' is called with no argument. + "*What state (active or passive) Highlight Changes mode should start in. +This is used when `highlight-changes-mode' is called with no argument. This variable must be set to one of the symbols `active' or `passive'." :type '(choice (const :tag "Active" active) (const :tag "Passive" passive)) :group 'highlight-changes) (defcustom highlight-changes-global-initial-state 'passive - "*What state `global-highlight-changes' should start in. + "*What state global Highlight Changes mode should start in. This is used if `global-highlight-changes' is called with no argument. This variable must be set to either `active' or `passive'." :type '(choice (const :tag "Active" active) @@ -309,7 +309,7 @@ its name does not begin with ` ' or `*'. A value of nil means no buffers are suitable for `global-highlight-changes' \(effectively disabling the mode). -Examples: +Example: (c-mode c++-mode) means that Highlight Changes mode is turned on for buffers in C and C++ modes only." @@ -366,7 +366,7 @@ remove it from existing buffers." (copy-face 'highlight-changes new-name) (copy-face old-name new-name) )) - (setq new-list (append (list new-name) new-list)) + (setq new-list (append (list new-name) new-list)) (setq n (1- n)) (setq p (cdr p))) (if (equal new-list (widget-value w)) @@ -419,7 +419,7 @@ Otherwise, this list will be constructed when needed from ;;; Functions... -(defun hilit-chg-map-changes (func &optional start-position end-position) +(defun hilit-chg-map-changes (func &optional start-position end-position) "Call function FUNC for each region used by Highlight Changes mode." ;; if start-position is nil, (point-min) is used ;; if end-position is nil, (point-max) is used @@ -1048,7 +1048,7 @@ changes are made, so \\[highlight-changes-next-change] and When called interactively: - if no prefix, toggle global Highlight Changes mode on or off - if called with a positive prefix (or just C-u) turn it on in active mode -- if called with a zero prefix turn it on in passive mode +- if called with a zero prefix turn it on in passive mode - if called with a negative prefix turn it off When called from a program: diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el index eb12d97f576..45afbd782d9 100644 --- a/lisp/mail/mailclient.el +++ b/lisp/mail/mailclient.el @@ -24,21 +24,21 @@ ;;; Commentary: -;; This package allows to hand over a buffer to be sent off -;; via the system's designated e-mail client. +;; This package allows to hand over a buffer to be sent off +;; via the system's designated e-mail client. ;; Note that the e-mail client will display the contents of the buffer ;; again for editing. ;; The e-mail client is taken to be whoever handles a mailto: URL -;; via `browse-url'. +;; via `browse-url'. ;; Mailto: URLs are composed according to RFC2368. ;; MIME bodies are not supported - we rather expect the mail client ;; to encode the body and add, for example, a digital signature. ;; The mailto URL RFC calls for "short text messages that are -;; actually the content of automatic processing." +;; actually the content of automatic processing." ;; So mailclient.el is ideal for situations where an e-mail is -;; generated automatically, and the user can edit it in the -;; mail client (e.g. bug-reports). +;; generated automatically, and the user can edit it in the +;; mail client (e.g. bug-reports). ;; To activate: ;; (setq send-mail-function 'mailclient-send-it) ; if you use `mail' @@ -49,11 +49,11 @@ (require 'sendmail) ;; for mail-sendmail-undelimit-header (require 'mail-utils) ;; for mail-fetch-field -(defcustom mailclient-place-body-on-clipboard-flag +(defcustom mailclient-place-body-on-clipboard-flag (fboundp 'w32-set-clipboard-data) "If non-nil, put the e-mail body on the clipboard in mailclient. -This is useful on systems where only short mailto:// URLs are -supported. Defaults to non-nil on Windows, nil otherwise." +This is useful on systems where only short mailto:// URLs are +supported. Defaults to non-nil on Windows, nil otherwise." :type 'boolean :group 'mail) @@ -64,7 +64,7 @@ supported. Defaults to non-nil on Windows, nil otherwise." (lambda (char) (cond ((eq char ?\x20) "%20") ;; space - ((eq char ?\n) "%0D%0A") ;; newline + ((eq char ?\n) "%0D%0A") ;; newline ((string-match "[-a-zA-Z0-9_:/.@]" (char-to-string char)) (char-to-string char)) ;; printable (t ;; everything else @@ -75,33 +75,33 @@ supported. Defaults to non-nil on Windows, nil otherwise." (defvar mailclient-delim-static "?") (defun mailclient-url-delim () (let ((current mailclient-delim-static)) - (setq mailclient-delim-static "&") + (setq mailclient-delim-static "&") current)) (defun mailclient-gather-addresses (str &optional drop-first-name) (let ((field (mail-fetch-field str nil t))) (if field (save-excursion - (let ((first t) + (let ((first t) (result "")) (mapc (lambda (recp) - (setq result - (concat + (setq result + (concat result (if (and drop-first-name first) "" (concat (mailclient-url-delim) str "=")) - (mailclient-encode-string-as-url + (mailclient-encode-string-as-url recp))) (setq first nil)) - (split-string + (split-string (mail-strip-quoted-names field) "\, *")) result))))) ;;;###autoload -(defun mailclient-send-it () +(defun mailclient-send-it () "Pass current buffer on to the system's mail client. Suitable value for `send-mail-function'. The mail client is taken to be the handler of mailto URLs." @@ -122,19 +122,19 @@ The mail client is taken to be the handler of mailto URLs." (while (and (re-search-forward "\n\n\n*" delimline t) (< (point) delimline)) (replace-match "\n")) - (let ((case-fold-search t)) + (let ((case-fold-search t)) ;; initialize limiter (setq mailclient-delim-static "?") ;; construct and call up mailto URL - (browse-url - (concat + (browse-url + (concat (save-excursion (narrow-to-region (point-min) delimline) - (concat + (concat "mailto:" ;; some of the headers according to RFC822 - (mailclient-gather-addresses "To" - 'drop-first-name) + (mailclient-gather-addresses "To" + 'drop-first-name) (mailclient-gather-addresses "cc" ) (mailclient-gather-addresses "bcc" ) (mailclient-gather-addresses "Resent-To" ) @@ -151,16 +151,16 @@ The mail client is taken to be the handler of mailto URLs." (if subj ;; if non-blank ;; the mail client will deal with ;; warning the user etc. - (concat (mailclient-url-delim) "subject=" + (concat (mailclient-url-delim) "subject=" (mailclient-encode-string-as-url subj)) "")))) ;; body - (concat - (mailclient-url-delim) "body=" + (concat + (mailclient-url-delim) "body=" (mailclient-encode-string-as-url (if mailclient-place-body-on-clipboard-flag (progn - (clipboard-kill-ring-save + (clipboard-kill-ring-save (+ 1 delimline) (point-max)) (concat "*** E-Mail body has been placed on clipboard, " diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index a018b66347e..656630c61ac 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,196 @@ +2006-02-02 Bill Wohler <wohler@newt.com> + + * mh-e.el (Version, mh-version): Add +cvs to version. + +2006-02-02 Bill Wohler <wohler@newt.com> + + Release MH-E version 7.90. + + * mh-e.el (Version, mh-version): Update for release 7.90. + +2006-02-01 Bill Wohler <wohler@newt.com> + + * mh-search.el (which-func-mode): Shush compiler on Emacs 21 too. + + * mh-alias.el (mh-alias-gecos-name): Use + mh-replace-regexp-in-string instead of replace-regexp-in-string. + (crm, multi-prompt): Use mh-require instead of require. + (mh-goto-address-find-address-at-point): Use + mh-line-beginning-position and mh-line-end-position instead of + line-beginning-position and line-end-position. Use + mh-match-string-no-properties instead of + match-string-no-properties. + + * mh-comp.el (mh-modify-header-field): Use + mh-line-beginning-position and mh-line-end-position instead of + line-beginning-position and line-end-position. + + * mh-compat.el (mailabbrev): Use mh-require instead of require. + (mh-assoc-string, mh-display-completion-list, mh-face-foreground) + (mh-face-background): Make docstring consistent. + (mh-require, mh-cancel-timer, mh-display-color-cells) + (mh-line-beginning-position, mh-line-end-position) + (mh-match-string-no-properties, mh-replace-regexp-in-string) + (mh-view-mode-enter): Move definition here from mh-xemacs.el and + add mh- prefix since compatibility functions should have our + package prefix (mh-) by Emacs convention and to avoid messing up + checks for the same functions in other packages. + + * mh-e.el (mh-compiling-flag): Move mh-xemacs-compiling-flag here + from mh-xemacs.el and rename. + (mh-xargs): Use mh-line-beginning-position and + mh-line-end-position instead of line-beginning-position and + line-end-position. + (mh-defface-compat): Use mh-display-color-cells instead of + display-color-cells. + + * mh-folder.el (which-func): Use mh-require instead of require. + + * mh-funcs.el (mh-list-folders): Use mh-view-mode-enter instead of + view-mode-enter. + + * mh-gnus.el (gnus-util, mm-bodies, mm-decode, mm-view, mml): Use + mh-require instead of require. + + * mh-letter.el (mh-letter-header-end, mh-letter-mode) + (mh-letter-next-header-field): Use mh-line-beginning-position and + mh-line-end-position instead of line-beginning-position and + line-end-position. + + * mh-limit.el (mh-subject-to-sequence-unthreaded): Use + mh-match-string-no-properties instead of + match-string-no-properties. + (mh-narrow-to-header-field): Use mh-line-beginning-position and + mh-line-end-position instead of line-beginning-position and + line-end-position. + + * mh-mime.el (mh-mime-inline-part, mh-mm-display-part) + (mh-mh-quote-unescaped-sharp, mh-mh-directive-present-p): Use + mh-line-beginning-position and mh-line-end-position instead of + line-beginning-position and line-end-position. + + * mh-search.el (which-func): Use mh-require instead of require. + (mh-make-pick-template, mh-index-visit-folder) + (mh-pick-parse-search-buffer, mh-swish-next-result) + (mh-mairix-next-result, mh-namazu-next-result) + (mh-pick-next-result, mh-grep-next-result) + (mh-index-create-imenu-index, mh-index-match-checksum) + (mh-md5sum-parser, mh-openssl-parser, mh-index-update-maps): Use + mh-line-beginning-position and mh-line-end-position instead of + line-beginning-position and line-end-position. + + * mh-seq.el (mh-list-sequences): Use mh-view-mode-enter instead of + view-mode-enter. + (mh-folder-size-flist, mh-parse-flist-output-line) + (mh-add-sequence-notation): Use mh-line-beginning-position and + mh-line-end-position instead of line-beginning-position and + line-end-position. + + * mh-show.el (mh-show-addr): Use mh-require instead of require. + + * mh-speed.el (mh-folder-speedbar-menu-items, mh-speed-toggle) + (mh-speed-view, mh-folder-speedbar-buttons) + (mh-speed-highlight, mh-speed-goto-folder) + (mh-speed-add-buttons, mh-speed-parse-flists-output) + (mh-speed-invalidate-map, mh-speedbar-change-expand-button-char) + (mh-speed-add-folder): Use mh-line-beginning-position and + mh-line-end-position instead of line-beginning-position and + line-end-position. + (mh-speed-flists): Use mh-cancel-timer instead of cancel-timer. + + * mh-thread.el (mh-thread-find-children) + (mh-thread-parse-scan-line, mh-thread-generate): Use + mh-line-beginning-position and mh-line-end-position instead of + line-beginning-position and line-end-position. + + * mh-utils.el (mh-colors-available-p): Use mh-display-color-cells + instead of display-color-cells. + (mh-folder-list): Use mh-replace-regexp-in-string instead of + replace-regexp-in-string. + (mh-sub-folders-actual, mh-letter-toggle-header-field-display): + Use mh-line-beginning-position and mh-line-end-position instead of + line-beginning-position and line-end-position. + + * mh-comp.el (mh-send-sub): Don't find components file in current + directory--this seems to have been a side-effect of commenting out + the use of an old mh-etc variable. Improve error message. + +2006-01-31 Bill Wohler <wohler@newt.com> + + * mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name + argument since compatibility functions should have our package + prefix (mh-) by Emacs convention and to avoid messing up checks + for the same functions in other packages. Use explicit argument + instead of forming name by adding mh- prefix so that one can grep + and find the definition. + + * mh-alias.el (mh-alias-local-users, mh-alias-reload) + (mh-alias-expand, mh-alias-minibuffer-confirm-address): Use + mh-assoc-string instead of assoc-string. + + * mh-compat.el (assoc-string): Rename to mh-assoc-string. + (mh-mail-abbrev-make-syntax-table, mh-url-hexify-string): Move + here from mh-utils.el. + (mh-display-completion-list): Move here from mh-comp.el. + (mh-face-foreground, mh-face-background): Move here from + mh-xface.el. + (mh-write-file-functions): Move here from mh-folder.el + + * mh-folder.el (mh-write-file-functions-compat): Move to + mh-compat.el and rename to mh-write-file-functions. + (mh-folder-mode): Use the new name. + + * mh-gnus.el (gnus-local-map-property): Rename to + mh-gnus-local-map-property. + (mm-merge-handles): Rename to mh-mm-merge-handles. + (mm-set-handle-multipart-parameter): Rename to + mh-mm-set-handle-multipart-parameter. + (mm-inline-text-vcard): Rename to mh-mm-inline-text-vcard. + (mm-possibly-verify-or-decrypt): Rename to + mh-mm-possibly-verify-or-decrypt. + (mm-handle-multipart-ctl-parameter): Rename to + mh-mm-handle-multipart-ctl-parameter. + (mm-readable-p): Rename to mh-mm-readable-p. + (mm-long-lines-p): Rename to mh-mm-long-lines-p. + (mm-keep-viewer-alive-p): Rename to mh-mm-keep-viewer-alive-p. + (mm-destroy-parts): Rename to mh-mm-destroy-parts. + (mm-uu-dissect-text-parts): Rename to mh-mm-uu-dissect-text-parts. + (mml-minibuffer-read-disposition): Rename to + mh-mml-minibuffer-read-disposition. + + * mh-identity.el (mh-identity-field-handler): Use mh-assoc-string + instead of assoc-string. + + * mh-mime.el (mh-mm-inline-media-tests, mh-mm-inline-message) + (mh-mime-display, mh-mime-display-security) + (mh-insert-mime-button, mh-insert-mime-security-button) + (mh-handle-set-external-undisplayer) + (mh-mime-security-press-button, mh-mime-security-show-details) + (mh-mml-attach-file, mh-mime-cleanup) + (mh-destroy-postponed-handles): Use new mh-* names for + compatibility functions. + + * mh-utils.el (mail-abbrev-make-syntax-table): Move to + mh-compat.el and rename to mh-mail-abbrev-make-syntax-table. + (mh-beginning-of-word): Use the new name. + (mh-get-field): Delete ancient alias. + + * mh-xface.el (mh-face-foreground-compat): Move to mh-compat.el + and rename to mh-face-foreground + (mh-face-background-compat): Move to mh-compat.el + and rename to mh-face-background. + (mh-face-display-function): Use the new names. + (mh-x-image-url-cache-canonicalize): Use mh-url-hexify-string + instead of url-hexify-string. + (url-unreserved-chars): Move to mh-compat.el and rename to + mh-url-unreserved-chars. + (url-hexify-string): Move to mh-compat.el and rename to + mh-url-hexify-string. + + * mh-letter.el (mh-complete-word): Fix bug in call to + mh-display-completion-list. Wrong argument was passed, so + completions wouldn't show highlighted prefix. + 2006-01-29 Bill Wohler <wohler@newt.com> * mh-e.el (mh-scan-format-file-check): Allow any non-nil for diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 313d3f19a2d..8f38abc56ee 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -82,25 +82,25 @@ loads \"cl\" appropriately." (funcall ',function ,@args)))) ;;;###mh-autoload -(defmacro mh-defun-compat (function arg-list &rest body) - "This is a macro to define functions which are not defined. -It is used for functions which were added to Emacs recently. -If FUNCTION is not defined then it is defined to have argument -list, ARG-LIST and body, BODY." +(defmacro mh-defun-compat (name function arg-list &rest body) + "Create function NAME. +If FUNCTION exists, then NAME becomes an alias for FUNCTION. +Otherwise, create function NAME with ARG-LIST and BODY." (let ((defined-p (fboundp function))) - (unless defined-p - `(defun ,function ,arg-list ,@body)))) + (if defined-p + `(defalias ',name ',function) + `(defun ,name ,arg-list ,@body)))) (put 'mh-defun-compat 'lisp-indent-function 'defun) ;;;###mh-autoload -(defmacro mh-defmacro-compat (function arg-list &rest body) - "This is a macro to define functions which are not defined. -It is used for macros which were added to Emacs recently. -If FUNCTION is not defined then it is defined to have argument -list, ARG-LIST and body, BODY." - (let ((defined-p (fboundp function))) - (unless defined-p - `(defmacro ,function ,arg-list ,@body)))) +(defmacro mh-defmacro-compat (name macro arg-list &rest body) + "Create macro NAME. +If MACRO exists, then NAME becomes an alias for MACRO. +Otherwise, create macro NAME with ARG-LIST and BODY." + (let ((defined-p (fboundp macro))) + (if defined-p + `(defalias ',name ',macro) + `(defmacro ,name ,arg-list ,@body)))) (put 'mh-defmacro-compat 'lisp-indent-function 'defun) diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index 98c14d63302..9dc2871241f 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -125,10 +125,10 @@ COMMA-SEPARATOR is non-nil." (setq res (match-string 1 res))) ;; Replace "&" with capitalized username (if (string-match "&" res) - (setq res (replace-regexp-in-string "&" (capitalize username) res))) + (setq res (mh-replace-regexp-in-string "&" (capitalize username) res))) ;; Remove " character (if (string-match "\"" res) - (setq res (replace-regexp-in-string "\"" "" res))) + (setq res (mh-replace-regexp-in-string "\"" "" res))) ;; If empty string, use username instead (if (string-equal "" res) (setq res username)) @@ -169,7 +169,7 @@ Exclude all aliases already in `mh-alias-alist' from \"ali\"" (if (string-equal username realname) (concat "<" username ">") (concat realname " <" username ">")))) - (when (not (assoc-string alias-name mh-alias-alist t)) + (when (not (mh-assoc-string alias-name mh-alias-alist t)) (setq passwd-alist (cons (list alias-name alias-translation) passwd-alist))))))) (forward-line 1))) @@ -198,12 +198,12 @@ been loaded." (cond ((looking-at "^[ \t]")) ;Continuation line ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias - (when (not (assoc-string (match-string 1) mh-alias-blind-alist t)) + (when (not (mh-assoc-string (match-string 1) mh-alias-blind-alist t)) (setq mh-alias-blind-alist (cons (list (match-string 1)) mh-alias-blind-alist)) (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) ((looking-at "\\(.+\\): .*$") ; A new MH alias - (when (not (assoc-string (match-string 1) mh-alias-alist t)) + (when (not (mh-assoc-string (match-string 1) mh-alias-alist t)) (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))) (forward-line 1))) @@ -214,7 +214,7 @@ been loaded." user) (while local-users (setq user (car local-users)) - (if (not (assoc-string (car user) mh-alias-alist t)) + (if (not (mh-assoc-string (car user) mh-alias-alist t)) (setq mh-alias-alist (append mh-alias-alist (list user)))) (setq local-users (cdr local-users))))) (run-hooks 'mh-alias-reloaded-hook) @@ -251,15 +251,15 @@ returns the string unchanged if not defined. The same is done here." "Return expansion for ALIAS. Blind aliases or users from /etc/passwd are not expanded." (cond - ((assoc-string alias mh-alias-blind-alist t) + ((mh-assoc-string alias mh-alias-blind-alist t) alias) ; Don't expand a blind alias - ((assoc-string alias mh-alias-passwd-alist t) - (cadr (assoc-string alias mh-alias-passwd-alist t))) + ((mh-assoc-string alias mh-alias-passwd-alist t) + (cadr (mh-assoc-string alias mh-alias-passwd-alist t))) (t (mh-alias-ali alias)))) -(require 'crm nil t) ; completing-read-multiple -(require 'multi-prompt nil t) +(mh-require 'crm nil t) ; completing-read-multiple +(mh-require 'multi-prompt nil t) ;;;###mh-autoload (defun mh-read-address (prompt) @@ -292,7 +292,7 @@ Blind aliases or users from /etc/passwd are not expanded." (let* ((case-fold-search t) (beg (mh-beginning-of-word)) (the-name (buffer-substring-no-properties beg (point)))) - (if (assoc-string the-name mh-alias-alist t) + (if (mh-assoc-string the-name mh-alias-alist t) (message "%s -> %s" the-name (mh-alias-expand the-name)) ;; Check if if was a single word likely to be an alias (if (and (equal mh-alias-flash-on-comma 1) @@ -606,12 +606,12 @@ filing messages." Then search backwards to beginning of line for the start of an e-mail address. If no e-mail address found, return nil." - (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim) + (re-search-backward "[^-_A-z0-9.@]" (mh-line-beginning-position) 'lim) (if (or (looking-at mh-address-mail-regexp) ; already at start (and (re-search-forward mh-address-mail-regexp - (line-end-position) 'lim) + (mh-line-end-position) 'lim) (goto-char (match-beginning 0)))) - (match-string-no-properties 0))) + (mh-match-string-no-properties 0))) (defun mh-alias-apropos (regexp) "Show all aliases or addresses that match a regular expression REGEXP." diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 5a0907bf612..5d2730f4afa 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -759,18 +759,9 @@ CONFIG is the window configuration before sending mail." (setq components (expand-file-name mh-comp-formfile mh-lib))) components) - ((file-exists-p - (setq components - (expand-file-name mh-comp-formfile - ;; What is this mh-etc ?? -sm - ;; This is dead code, so - ;; remove it. - ;(and (boundp 'mh-etc) mh-etc) - ))) - components) (t - (error "Can't find components file \"%s\"" - components)))) + (error "Can't find %s in %s or %s" + mh-comp-formfile mh-user-path mh-lib)))) nil))) (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) (goto-char (point-max)) @@ -1040,7 +1031,7 @@ discarded." (cond ((and overwrite-flag (mh-goto-header-field (concat field ":"))) (insert " " value) - (delete-region (point) (line-end-position))) + (delete-region (point) (mh-line-end-position))) ((and (not overwrite-flag) (mh-regexp-in-field-p (concat "\\b" value "\\b") field)) ;; Already there, do nothing. diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 452d0a3c089..d726a85a38f 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -36,31 +36,167 @@ ;; way, it's easy to occasionally go through this file and see which ;; macros we can retire. -;; See also mh-gnus.el for compatibility macros used to span different +;; Please use mh-gnus.el when providing compatibility with different ;; versions of Gnus. -;; Macros are listed alphabetically. +;; Items are listed alphabetically (except for mh-require which is +;; needed by a lesser character). -(unless (fboundp 'assoc-string) - (defsubst assoc-string (key list case-fold) - "Like `assoc' but specifically for strings. +(require 'mh-acros) + +(mh-do-in-gnu-emacs + (defalias 'mh-require 'require)) + +(mh-do-in-xemacs + (defun mh-require (feature &optional filename noerror) + "If feature FEATURE is not loaded, load it from FILENAME. +If FEATURE is not a member of the list `features', then the feature +is not loaded; so load the file FILENAME. +If FILENAME is omitted, the printname of FEATURE is used as the file name. +If the optional third argument NOERROR is non-nil, +then return nil if the file is not found instead of signaling an error. + +Simulate NOERROR argument in XEmacs which lacks it." + (if (not (featurep feature)) + (if filename + (load filename noerror t) + (load (format "%s" feature) noerror t))))) + +(mh-defun-compat mh-assoc-string assoc-string (key list case-fold) + "Like `assoc' but specifically for strings. Case is ignored if CASE-FOLD is non-nil. -This function added by MH-E for Emacs versions that lack -`assoc-string', introduced in Emacs 22." - (if case-fold - (assoc-ignore-case key list) - (assoc key list)))) +This function is used by Emacs versions that lack `assoc-string', +introduced in Emacs 22." + (if case-fold + (assoc-ignore-case key list) + (assoc key list))) + +;; For XEmacs. +(defalias 'mh-cancel-timer + (if (fboundp 'cancel-timer) + 'cancel-timer + 'delete-itimer)) + +(mh-defun-compat mh-display-color-cells display-color-cells (&optional display) + "Return the number of color cells supported by DISPLAY. +This function is used by XEmacs to always return 0 when compiling +to avoid compiling errors. Otherwise uses `device-color-cells'." + (if mh-compiling-flag + 0 + (device-color-cells display))) (defmacro mh-display-completion-list (completions &optional common-substring) "Display the list of COMPLETIONS. -Calls `display-completion-list' correctly in older environments. -Versions of Emacs prior to version 22 lacked a COMMON-SUBSTRING -argument which is used to highlight the next possible character you -can enter in the current list of completions." +See documentation for `display-completion-list' for a description of the +arguments COMPLETIONS and perhaps COMMON-SUBSTRING. +This macro is used by Emacs versions that lack a COMMON-SUBSTRING +argument, introduced in Emacs 22." (if (< emacs-major-version 22) `(display-completion-list ,completions) `(display-completion-list ,completions ,common-substring))) +(defmacro mh-face-foreground (face &optional frame inherit) + "Return the foreground color name of FACE, or nil if unspecified. +See documentation for `face-foreground' for a description of the +arguments FACE, FRAME, and perhaps INHERIT. +This macro is used by Emacs versions that lack an INHERIT argument, +introduced in Emacs 22." + (if (< emacs-major-version 22) + `(face-foreground ,face ,frame) + `(face-foreground ,face ,frame ,inherit))) + +(defmacro mh-face-background (face &optional frame inherit) + "Return the background color name of face, or nil if unspecified. +See documentation for `back-foreground' for a description of the +arguments FACE, FRAME, and INHERIT. +This macro is used by Emacs versions that lack an INHERIT argument, +introduced in Emacs 22." + (if (< emacs-major-version 22) + `(face-background ,face ,frame) + `(face-background ,face ,frame ,inherit))) + +;; For XEmacs. +(defalias 'mh-line-beginning-position + (if (fboundp 'line-beginning-position) + 'line-beginning-position + 'point-at-bol)) + +;; For XEmacs. +(defalias 'mh-line-end-position + (if (fboundp 'line-end-position) + 'line-end-position + 'point-at-eol)) + +(mh-require 'mailabbrev nil t) +(mh-defun-compat mh-mail-abbrev-make-syntax-table + mail-abbrev-make-syntax-table () + "Emacs 21 and XEmacs don't have `mail-abbrev-make-syntax-table'. +This function does nothing on those systems." + nil) + +(mh-defun-compat mh-match-string-no-properties + match-string-no-properties (num &optional string) + "Return string of text matched by last search, without text properties. +This function is used by XEmacs that lacks `match-string-no-properties'. +The function `buffer-substring-no-properties' is used instead. +The argument STRING is ignored." + (buffer-substring-no-properties + (match-beginning num) (match-end num))) + +(mh-defun-compat mh-replace-regexp-in-string replace-regexp-in-string + (rep string &optional fixedcase literal subexp start) + "Replace REGEXP with REP everywhere in STRING and return result. +This function is used by XEmacs that lacks `replace-regexp-in-string'. +The function `replace-in-string' is used instead. +The arguments FIXEDCASE, LITERAL, SUBEXP, and START are ignored." + (replace-in-string string regexp rep)) + +;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21. +(if (not (boundp 'url-unreserved-chars)) + (defconst mh-url-unresrved-chars + '( + ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z + ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z + ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 + ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) + "A list of characters that are _NOT_ reserved in the URL spec. +This is taken from RFC 2396.")) + +(mh-defun-compat mh-url-hexify-string url-hexify-string (str) + "Escape characters in a string. +This is a copy of `url-hexify-string' from url-util.el in Emacs +22; needed by Emacs 21." + (mapconcat + (lambda (char) + ;; Fixme: use a char table instead. + (if (not (memq char mh-url-unreserved-chars)) + (if (> char 255) + (error "Hexifying multibyte character %s" str) + (format "%%%02X" char)) + (char-to-string char))) + str "")) + +(mh-defun-compat mh-view-mode-enter + view-mode-enter (&optional return-to exit-action) + "Enter View mode. +This function is used by XEmacs that lacks `view-mode-enter'. +The function `view-mode' is used instead. +The arguments RETURN-TO and EXIT-ACTION are ignored." + ;; Shush compiler. + (if return-to nil) + (if exit-action nil) + (view-mode 1)) + +(defmacro mh-write-file-functions () + "Return `write-file-functions' if it exists. +Otherwise return `local-write-file-hooks'. +This macro exists purely for compatibility. The former symbol is used +in Emacs 22 onward while the latter is used in previous versions and +XEmacs." + (if (boundp 'write-file-functions) + ''write-file-functions ;Emacs 22 on + ''local-write-file-hooks)) ;XEmacs + (provide 'mh-compat) ;; Local Variables: diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 5b738933590..5dd99466313 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -6,7 +6,7 @@ ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> -;; Version: 7.85+cvs +;; Version: 7.90+cvs ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -101,7 +101,13 @@ (eval-and-compile (defvar mh-xemacs-flag (featurep 'xemacs) - "Non-nil means the current Emacs is XEmacs.")) + "Non-nil means the current Emacs is XEmacs.") + (defvar mh-compiling-flag nil + "Non-nil means we're compiling.")) + +(eval-when (compile) + (setq mh-compiling-flag t)) + (mh-do-in-xemacs (require 'mh-xemacs)) @@ -115,7 +121,7 @@ ;; Try to keep variables local to a single file. Provide accessors if ;; variables are shared. Use this section as a last resort. -(defconst mh-version "7.85+sans-entropy" "Version number of MH-E.") +(defconst mh-version "7.90+cvs" "Version number of MH-E.") ;; Variants @@ -464,7 +470,8 @@ all the strings have been used." (let ((arg-list (reverse args)) (count 0)) (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) - (push (buffer-substring-no-properties (point) (line-end-position)) + (push (buffer-substring-no-properties (point) + (mh-line-end-position)) arg-list) (incf count) (forward-line)) @@ -2970,7 +2977,7 @@ entirely if the display does not support the number of specified colors." (if mh-min-colors-defined-flag spec - (let ((cells (display-color-cells)) + (let ((cells (mh-display-color-cells)) new-spec) ;; Remove entries with min-colors, or delete them if we have fewer colors ;; than they specify. diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index 98ecc06d7c2..59526986d35 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -515,17 +515,8 @@ font-lock is done highlighting.") (set-specifier horizontal-scrollbar-visible-p nil (cons (current-buffer) nil))))) -(defmacro mh-write-file-functions-compat () - "Return `write-file-functions' if it exists. -Otherwise return `local-write-file-hooks'. This macro exists -purely for compatibility. The former symbol is used in Emacs 21.4 -onward while the latter is used in previous versions and XEmacs." - (if (boundp 'write-file-functions) - ''write-file-functions ;Emacs 21.4 - ''local-write-file-hooks)) ;XEmacs - ;; Register mh-folder-mode as supporting which-function-mode... -(require 'which-func nil t) +(mh-require 'which-func nil t) (when (boundp 'which-func-modes) (add-to-list 'which-func-modes 'mh-folder-mode)) @@ -650,8 +641,8 @@ perform the operation on all messages in that region. (setq truncate-lines t) (auto-save-mode -1) (setq buffer-offer-save t) - (mh-make-local-hook (mh-write-file-functions-compat)) - (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t) + (mh-make-local-hook (mh-write-file-functions)) + (add-hook (mh-write-file-functions) 'mh-execute-commands nil t) (make-local-variable 'revert-buffer-function) (make-local-variable 'hl-line-mode) ; avoid pollution (mh-funcall-if-exists hl-line-mode 1) diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 0565ed42e6b..f7abb4cb389 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -154,7 +154,7 @@ Display the results only if something went wrong." "-recurse" "-norecurse")) (goto-char (point-min)) - (view-mode-enter) + (mh-view-mode-enter) (setq view-exit-action 'kill-buffer) (message "Listing folders...done"))))) diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index dd2a888f12f..970f98556e2 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el @@ -32,33 +32,34 @@ (require 'mh-e) -(require 'gnus-util nil t) -(require 'mm-bodies nil t) -(require 'mm-decode nil t) -(require 'mm-view nil t) -(require 'mml nil t) +(mh-require 'gnus-util nil t) +(mh-require 'mm-bodies nil t) +(mh-require 'mm-decode nil t) +(mh-require 'mm-view nil t) +(mh-require 'mml nil t) ;; Copy of function from gnus-util.el. -(mh-defun-compat gnus-local-map-property (map) +(mh-defun-compat mh-gnus-local-map-property gnus-local-map-property (map) "Return a list suitable for a text property list specifying keymap MAP." (cond (mh-xemacs-flag (list 'keymap map)) ((>= emacs-major-version 21) (list 'keymap map)) (t (list 'local-map map)))) ;; Copy of function from mm-decode.el. -(mh-defun-compat mm-merge-handles (handles1 handles2) +(mh-defun-compat mh-mm-merge-handles mm-merge-handles (handles1 handles2) (append (if (listp (car handles1)) handles1 (list handles1)) (if (listp (car handles2)) handles2 (list handles2)))) ;; Copy of function from mm-decode.el. -(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value) +(mh-defun-compat mh-mm-set-handle-multipart-parameter + mm-set-handle-multipart-parameter (handle parameter value) ;; HANDLE could be a CTL. (if handle (put-text-property 0 (length (car handle)) parameter value (car handle)))) ;; Copy of function from mm-view.el. -(mh-defun-compat mm-inline-text-vcard (handle) +(mh-defun-compat mh-mm-inline-text-vcard mm-inline-text-vcard (handle) (let (buffer-read-only) (mm-insert-inline handle @@ -72,25 +73,27 @@ ;; Function from mm-decode.el used in PGP messages. Just define it with older ;; Gnus to avoid compiler warning. -(mh-defun-compat mm-possibly-verify-or-decrypt (parts ctl) +(mh-defun-compat mh-mm-possibly-verify-or-decrypt + mm-possibly-verify-or-decrypt (parts ctl) nil) ;; Copy of macro in mm-decode.el. -(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter) +(mh-defmacro-compat mh-mm-handle-multipart-ctl-parameter + mm-handle-multipart-ctl-parameter (handle parameter) `(get-text-property 0 ,parameter (car ,handle))) ;; Copy of function in mm-decode.el. -(mh-defun-compat mm-readable-p (handle) +(mh-defun-compat mh-mm-readable-p mm-readable-p (handle) "Say whether the content of HANDLE is readable." (and (< (with-current-buffer (mm-handle-buffer handle) (buffer-size)) 10000) (mm-with-unibyte-buffer (mm-insert-part handle) (and (eq (mm-body-7-or-8) '7bit) - (not (mm-long-lines-p 76)))))) + (not (mh-mm-long-lines-p 76)))))) ;; Copy of function in mm-bodies.el. -(mh-defun-compat mm-long-lines-p (length) +(mh-defun-compat mh-mm-long-lines-p mm-long-lines-p (length) "Say whether any of the lines in the buffer is longer than LENGTH." (save-excursion (goto-char (point-min)) @@ -102,21 +105,22 @@ (and (> (current-column) length) (current-column)))) -(mh-defun-compat mm-keep-viewer-alive-p (handle) +(mh-defun-compat mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle) ;; Released Gnus doesn't keep handles associated with externally displayed ;; MIME parts. So this will always return nil. nil) -(mh-defun-compat mm-destroy-parts (list) +(mh-defun-compat mh-mm-destroy-parts mm-destroy-parts (list) "Older versions of Emacs don't have this function." nil) -(mh-defun-compat mm-uu-dissect-text-parts (handles) +(mh-defun-compat mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles) "Emacs 21 and XEmacs don't have this function." nil) ;; Copy of function in mml.el. -(mh-defun-compat mml-minibuffer-read-disposition (type &optional default) +(mh-defun-compat mh-mml-minibuffer-read-disposition + mml-minibuffer-read-disposition (type &optional default) (unless default (setq default (if (and (string-match "\\`text/" type) (not (string-match "\\`text/rtf\\'" type))) diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index faafea71f3f..4d401bbea55 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -127,7 +127,7 @@ The field name is downcased. If the FIELD begins with the character \":\", then it must have a special handler defined in `mh-identity-handlers', else return an error since it is not a valid header field." - (or (cdr (assoc-string field mh-identity-handlers t)) + (or (cdr (mh-assoc-string field mh-identity-handlers t)) (and (eq (aref field 0) ?:) (error "Field %s not found in `mh-identity-handlers'" field)) (cdr (assoc ":default" mh-identity-handlers)) diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index dfa96c63b5a..c6af5c323a9 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -267,7 +267,7 @@ searching for `mh-mail-header-separator' in the buffer." (goto-char (point-min)) (cond ((equal mh-mail-header-separator "") (point-min)) ((search-forward (format "\n%s\n" mh-mail-header-separator) nil t) - (line-beginning-position 0)) + (mh-line-beginning-position 0)) (t (point-min))))) @@ -319,7 +319,7 @@ order). (set (make-local-variable 'mh-mail-header-separator) (save-excursion (goto-char (mh-mail-header-end)) - (buffer-substring-no-properties (point) (line-end-position)))) + (buffer-substring-no-properties (point) (mh-line-end-position)))) (make-local-variable 'mail-header-separator) (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el (mh-set-help mh-letter-mode-help-messages) @@ -828,7 +828,7 @@ body." ((< (point) (progn (beginning-of-line) (re-search-forward mh-letter-header-field-regexp - (line-end-position) t) + (mh-line-end-position) t) (point))) (beginning-of-line)) (t (end-of-line))) @@ -894,7 +894,7 @@ Any match found replaces the text from BEGIN to END." (if (equal word completion) (with-output-to-temp-buffer completions-buffer (mh-display-completion-list (all-completions word choices) - choices)) + word)) (ignore-errors (kill-buffer completions-buffer)) (delete-region begin end) diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el index 68ec25a9470..7a90b890cad 100644 --- a/lisp/mh-e/mh-limit.el +++ b/lisp/mh-e/mh-limit.el @@ -211,7 +211,7 @@ Return number of messages put in the sequence: (string-equal "" (match-string 3))) (progn (message "No subject line") nil) - (let ((subject (match-string-no-properties 3)) + (let ((subject (mh-match-string-no-properties 3)) (list)) (if (> (length subject) mh-limit-max-subject-size) (setq subject (substring subject 0 mh-limit-max-subject-size))) @@ -219,7 +219,7 @@ Return number of messages put in the sequence: (if all (goto-char (point-min))) (while (re-search-forward mh-scan-subject-regexp nil t) - (let ((this-subject (match-string-no-properties 3))) + (let ((this-subject (mh-match-string-no-properties 3))) (if (> (length this-subject) mh-limit-max-subject-size) (setq this-subject (substring this-subject 0 mh-limit-max-subject-size))) @@ -310,7 +310,7 @@ The MH command pick is used to do the match." (while (not (eobp)) (let ((num (ignore-errors (string-to-number - (buffer-substring (point) (line-end-position)))))) + (buffer-substring (point) (mh-line-end-position)))))) (when num (push num msg-list)) (forward-line)))) (if (null msg-list) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index de4c01a9604..787f5c371fe 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -144,7 +144,7 @@ mm-inline-text-html-renderer) (and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))) ("text/x-vcard" - mm-inline-text-vcard + mh-mm-inline-text-vcard (lambda (handle) (or (featurep 'vcard) (locate-library "vcard")))) @@ -174,7 +174,7 @@ ("audio/.*" ignore ignore) ("image/.*" ignore ignore) ;; Default to displaying as text - (".*" mm-inline-text mm-readable-p)) + (".*" mm-inline-text mh-mm-readable-p)) "Alist of media types/tests saying whether types can be displayed inline.") (defvar mh-mime-save-parts-directory nil @@ -302,14 +302,14 @@ the attachment labeled with that number." start end) (cond ((and data (not inserted-flag) (not displayed-flag)) (let ((contents (mm-get-part data))) - (add-text-properties (line-beginning-position) (line-end-position) - '(mh-mime-inserted t)) + (add-text-properties (mh-line-beginning-position) + (mh-line-end-position) '(mh-mime-inserted t)) (setq start (point-marker)) (forward-line 1) (mm-insert-inline data contents) (setq end (point-marker)) (add-text-properties - start (progn (goto-char start) (line-end-position)) + start (progn (goto-char start) (mh-line-end-position)) `(mh-region (,start . ,end))))) ((and data (or inserted-flag displayed-flag)) (mh-press-button) @@ -460,10 +460,10 @@ decoding the same message multiple times." (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data))) (let ((handles (mm-dissect-buffer nil))) (if handles - (mm-uu-dissect-text-parts handles) + (mh-mm-uu-dissect-text-parts handles) (setq handles (mm-uu-dissect))) (setf (mh-mime-handles (mh-buffer-data)) - (mm-merge-handles + (mh-mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))) handles)))) @@ -527,11 +527,11 @@ parsed and then displayed." (if pre-dissected-handles (setq handles pre-dissected-handles) (if (setq handles (mm-dissect-buffer nil)) - (mm-uu-dissect-text-parts handles) + (mh-mm-uu-dissect-text-parts handles) (setq handles (mm-uu-dissect))) (setf (mh-mime-handles (mh-buffer-data)) - (mm-merge-handles handles - (mh-mime-handles (mh-buffer-data)))) + (mh-mm-merge-handles handles + (mh-mime-handles (mh-buffer-data)))) (unless handles (mh-decode-message-body))) @@ -637,7 +637,7 @@ buttons for alternative parts that are usually suppressed." (let ((mh-mime-security-button-line-format mh-mime-security-button-end-line-format)) (mh-insert-mime-security-button handle)) - (mm-set-handle-multipart-parameter + (mh-mm-set-handle-multipart-parameter handle 'mh-region (cons (point-min-marker) (point-max-marker))))) (defun mh-mime-display-single (handle) @@ -746,7 +746,8 @@ buttons for alternative parts that are usually suppressed." (mh-insert-mime-button handle id (mm-handle-displayed-p handle)) (goto-char point) (when region - (add-text-properties (line-beginning-position) (line-end-position) + (add-text-properties (mh-line-beginning-position) + (mh-line-end-position) `(mh-region ,region))))))) (defun mh-mime-part-index (handle) @@ -853,7 +854,7 @@ by commands like \"K v\" which operate on individual MIME parts." (setq begin (point)) (gnus-eval-format mh-mime-button-line-format mh-mime-button-line-format-alist - `(,@(gnus-local-map-property mh-mime-button-map) + `(,@(mh-gnus-local-map-property mh-mime-button-map) mh-callback mh-mm-display-part mh-part ,index mh-data ,handle)) @@ -878,7 +879,7 @@ by commands like \"K v\" which operate on individual MIME parts." (defun mh-insert-mime-security-button (handle) "Display buttons for PGP message, HANDLE." - (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) + (let* ((protocol (mh-mm-handle-multipart-ctl-parameter handle 'protocol)) (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist)) (nth 2 (assoc protocol mm-decrypt-function-alist)) "Unknown")) @@ -886,9 +887,9 @@ by commands like \"K v\" which operate on individual MIME parts." (if (equal (car handle) "multipart/signed") " Signed" " Encrypted") " Part")) - (info (or (mm-handle-multipart-ctl-parameter handle 'gnus-info) + (info (or (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info) "Undecided")) - (details (mm-handle-multipart-ctl-parameter handle 'gnus-details)) + (details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details)) pressed-details begin end face) (setq details (if details (concat "\n" details) "")) (setq pressed-details (if mh-mime-security-button-pressed details "")) @@ -898,7 +899,7 @@ by commands like \"K v\" which operate on individual MIME parts." (gnus-eval-format mh-mime-security-button-line-format mh-mime-security-button-line-format-alist - `(,@(gnus-local-map-property mh-mime-security-button-map) + `(,@(mh-gnus-local-map-property mh-mime-security-button-map) mh-button-pressed ,mh-mime-security-button-pressed mh-callback mh-mime-security-press-button mh-line-format ,mh-mime-security-button-line-format @@ -1065,7 +1066,7 @@ This is only called in recent versions of Gnus. The MIME handles are stored in data structures corresponding to MH-E folder buffer FOLDER instead of in Gnus (as in the original). The MIME part, HANDLE is associated with the undisplayer FUNCTION." - (if (mm-keep-viewer-alive-p handle) + (if (mh-mm-keep-viewer-alive-p handle) (let ((new-handle (copy-sequence handle))) (mm-handle-set-undisplayer new-handle function) (mm-handle-set-undisplayer handle nil) @@ -1076,19 +1077,19 @@ HANDLE is associated with the undisplayer FUNCTION." (defun mh-mime-security-press-button (handle) "Callback from security button for part HANDLE." - (if (mm-handle-multipart-ctl-parameter handle 'gnus-info) + (if (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info) (mh-mime-security-show-details handle) - (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region)) + (let ((region (mh-mm-handle-multipart-ctl-parameter handle 'mh-region)) point) (setq point (point)) (goto-char (car region)) (delete-region (car region) (cdr region)) - (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer) + (with-current-buffer (mh-mm-handle-multipart-ctl-parameter handle 'buffer) (let* ((mm-verify-option 'known) (mm-decrypt-option 'known) - (new (mm-possibly-verify-or-decrypt (cdr handle) handle))) + (new (mh-mm-possibly-verify-or-decrypt (cdr handle) handle))) (unless (eq new (cdr handle)) - (mm-destroy-parts (cdr handle)) + (mh-mm-destroy-parts (cdr handle)) (setcdr handle new)))) (mh-mime-display-security handle) (goto-char point)))) @@ -1098,7 +1099,7 @@ HANDLE is associated with the undisplayer FUNCTION." ;; to be no way of getting rid of the inserted text. (defun mh-mime-security-show-details (handle) "Toggle display of detailed security info for HANDLE." - (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) + (let ((details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details))) (when details (let ((mh-mime-security-button-pressed (not (get-text-property (point) 'mh-button-pressed))) @@ -1296,7 +1297,7 @@ automatically." (type (mh-minibuffer-read-type file)) (description (mml-minibuffer-read-description)) (dispos (or disposition - (mml-minibuffer-read-disposition type)))) + (mh-mml-minibuffer-read-disposition type)))) (mml-insert-empty-tag 'part 'type type 'filename file 'disposition dispos 'description description))) @@ -1500,9 +1501,9 @@ This function will quote all such characters." (goto-char (point-min)) (while (re-search-forward "^#" nil t) (beginning-of-line) - (unless (mh-mh-directive-present-p (point) (line-end-position)) + (unless (mh-mh-directive-present-p (point) (mh-line-end-position)) (insert "#")) - (goto-char (line-end-position))))) + (goto-char (mh-line-end-position))))) ;;;###mh-autoload (defun mh-mh-to-mime-undo (noconfirm) @@ -1672,7 +1673,8 @@ buffer, while END defaults to the the end of the buffer." (block 'search-for-mh-directive (goto-char begin) (while (re-search-forward "^#" end t) - (let ((s (buffer-substring-no-properties (point) (line-end-position)))) + (let ((s (buffer-substring-no-properties + (point) (mh-line-end-position)))) (cond ((equal s "")) ((string-match "^forw[ \t\n]+" s) (return-from 'search-for-mh-directive t)) @@ -1784,7 +1786,7 @@ initialized. Always use the command `mh-have-file-command'.") ;; This is for Emacs, what about XEmacs? (mh-funcall-if-exists remove-images (point-min) (point-max)) (when mime-data - (mm-destroy-parts (mh-mime-handles mime-data)) + (mh-mm-destroy-parts (mh-mime-handles mime-data)) (remhash (current-buffer) mh-globals-hash)))) ;;;###mh-autoload @@ -1792,7 +1794,7 @@ initialized. Always use the command `mh-have-file-command'.") "Free MIME data for externally displayed MIME parts." (let ((mime-data (mh-buffer-data))) (when mime-data - (mm-destroy-parts (mh-mime-handles mime-data))) + (mh-mm-destroy-parts (mh-mime-handles mime-data))) (remhash (current-buffer) mh-globals-hash))) (provide 'mh-mime) diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 9fc9355a065..f1292dd8e1e 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -51,7 +51,6 @@ (require 'gnus-util) (require 'imenu) -(require 'which-func nil t) (defvar mh-searcher nil "Cached value of chosen search program.") @@ -358,12 +357,13 @@ configuration and is used when the search folder is dismissed." (goto-char (point-min)) (dotimes (i 5) (add-text-properties (point) (1+ (point)) '(front-sticky t)) - (add-text-properties (- (line-end-position) 2) (1- (line-end-position)) + (add-text-properties (- (mh-line-end-position) 2) + (1- (mh-line-end-position)) '(rear-nonsticky t)) - (add-text-properties (point) (1- (line-end-position)) '(read-only t)) + (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t)) (forward-line)) (add-text-properties (point) (1+ (point)) '(front-sticky t)) - (add-text-properties (point) (1- (line-end-position)) '(read-only t)) + (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t)) (goto-char (point-max))) ;; Sequence Searches @@ -526,9 +526,10 @@ group of results." (cond ((and (bolp) (eolp)) (ignore-errors (forward-line -1)) (setq msg (mh-get-msg-num t))) - ((equal (char-after (line-beginning-position)) ?+) + ((equal (char-after (mh-line-beginning-position)) ?+) (setq folder (buffer-substring-no-properties - (line-beginning-position) (line-end-position)))) + (mh-line-beginning-position) + (mh-line-end-position)))) (t (setq msg (mh-get-msg-num t))))) (when (not folder) (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map) @@ -655,13 +656,13 @@ The cdr of the element is the pattern to search." start begin) (goto-char (point-min)) (while (not (eobp)) - (if (search-forward "--------" (line-end-position) t) + (if (search-forward "--------" (mh-line-end-position) t) (setq in-body-flag t) (beginning-of-line) (setq begin (point)) (setq start (if in-body-flag (point) - (search-forward ":" (line-end-position) t) + (search-forward ":" (mh-line-end-position) t) (point))) (push (cons (and (not in-body-flag) (intern (downcase @@ -669,7 +670,7 @@ The cdr of the element is the pattern to search." begin (1- start))))) (mh-index-parse-search-regexp (buffer-substring-no-properties - start (line-end-position)))) + start (mh-line-end-position)))) pattern-list)) (forward-line)) pattern-list))) @@ -979,8 +980,8 @@ is used to search." (return nil)) (when (equal (char-after (point)) ?#) (return 'error)) - (let* ((start (search-forward " " (line-end-position) t)) - (end (search-forward " " (line-end-position) t))) + (let* ((start (search-forward " " (mh-line-end-position) t)) + (end (search-forward " " (mh-line-end-position) t))) (unless (and start end) (return 'error)) (setq end (1- end)) @@ -1058,7 +1059,7 @@ SEARCH-REGEXP-LIST is used to search." (return 'error)) (let ((start (point)) end msg-start) - (setq end (line-end-position)) + (setq end (mh-line-end-position)) (unless (search-forward mh-mairix-folder end t) (return 'error)) (goto-char (match-beginning 0)) @@ -1191,7 +1192,7 @@ is used to search." (block nil (when (eobp) (return nil)) (let ((file-name (buffer-substring-no-properties - (point) (line-end-position)))) + (point) (mh-line-end-position)))) (unless (equal (string-match mh-namazu-folder file-name) 0) (return 'error)) (unless (file-exists-p file-name) @@ -1239,17 +1240,17 @@ is used to search." (prog1 (block nil (when (eobp) (return nil)) - (when (search-forward-regexp "^\+" (line-end-position) t) + (when (search-forward-regexp "^\+" (mh-line-end-position) t) (setq mh-index-pick-folder - (buffer-substring-no-properties (line-beginning-position) - (line-end-position))) + (buffer-substring-no-properties (mh-line-beginning-position) + (mh-line-end-position))) (return 'error)) - (unless (search-forward-regexp "^[1-9][0-9]*$" (line-end-position) t) + (unless (search-forward-regexp "^[1-9][0-9]*$" (mh-line-end-position) t) (return 'error)) (list mh-index-pick-folder (string-to-number - (buffer-substring-no-properties (line-beginning-position) - (line-end-position))) + (buffer-substring-no-properties (mh-line-beginning-position) + (mh-line-end-position))) nil)) (forward-line))) @@ -1326,8 +1327,8 @@ record is invalid return 'error." (block nil (when (eobp) (return nil)) - (let ((eol-pos (line-end-position)) - (bol-pos (line-beginning-position)) + (let ((eol-pos (mh-line-end-position)) + (bol-pos (mh-line-beginning-position)) folder-start msg-end) (goto-char bol-pos) (unless (search-forward mh-user-path eol-pos t) @@ -1408,8 +1409,12 @@ being the list of messages originally from that folder." (when cur-msg (mh-goto-msg cur-msg t t)) (set-buffer-modified-p old-buffer-modified-flag))) +(mh-require 'which-func nil t) + ;; Shush compiler. -(eval-when-compile (mh-do-in-xemacs (defvar which-func-mode))) +(eval-when-compile + (if (or mh-xemacs-flag (< emacs-major-version 22)) + (defvar which-func-mode))) ;;;###mh-autoload (defun mh-index-create-imenu-index () @@ -1423,7 +1428,7 @@ being the list of messages originally from that folder." (save-excursion (beginning-of-line) (push (cons (buffer-substring-no-properties - (point) (line-end-position)) + (point) (mh-line-end-position)) (set-marker (make-marker) (point))) alist))) (setq imenu--index-alist (nreverse alist))))) @@ -1696,7 +1701,8 @@ folder, is removed from `mh-index-data'." (mh-exec-cmd-output mh-scan-prog nil "-width" "80" "-format" "%{x-mhe-checksum}\n" folder msg) (goto-char (point-min)) - (string-equal (buffer-substring-no-properties (point) (line-end-position)) + (string-equal (buffer-substring-no-properties + (point) (mh-line-end-position)) checksum))) @@ -1805,8 +1811,8 @@ PROC is used to convert the value to actual data." (defun mh-md5sum-parser () "Parse md5sum output." - (let ((begin (line-beginning-position)) - (end (line-end-position)) + (let ((begin (mh-line-beginning-position)) + (end (mh-line-end-position)) first-space last-slash) (setq first-space (search-forward " " end t)) (goto-char end) @@ -1819,8 +1825,8 @@ PROC is used to convert the value to actual data." (defun mh-openssl-parser () "Parse openssl output." - (let ((begin (line-beginning-position)) - (end (line-end-position)) + (let ((begin (mh-line-beginning-position)) + (end (mh-line-end-position)) last-space last-slash) (goto-char end) (setq last-space (search-backward " " begin t)) @@ -1854,7 +1860,7 @@ origin-index) map is updated too." (let (msg checksum) (while (not (eobp)) (setq msg (buffer-substring-no-properties - (point) (line-end-position))) + (point) (mh-line-end-position))) (forward-line) (save-excursion (cond ((not (string-match "^[0-9]*$" msg))) @@ -1865,7 +1871,7 @@ origin-index) map is updated too." (t ;; update maps (setq checksum (buffer-substring-no-properties - (point) (line-end-position))) + (point) (mh-line-end-position))) (let ((msg (string-to-number msg))) (set-buffer folder) (mh-index-update-single-msg msg checksum origin-map))))) diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index cf2027392bd..a5732d00bc6 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -175,7 +175,7 @@ The list appears in a buffer named \"*MH-E Sequences*\"." (insert "\n")) (setq seq-list (cdr seq-list))) (goto-char (point-min)) - (view-mode-enter) + (mh-view-mode-enter) (setq view-exit-action 'kill-buffer) (message "Listing sequences...done"))))) @@ -749,7 +749,7 @@ completion is over." (goto-char (point-min)) (multiple-value-bind (folder unseen total) (mh-parse-flist-output-line - (buffer-substring (point) (line-end-position))) + (buffer-substring (point) (mh-line-end-position))) (values total unseen folder)))) (defun mh-folder-size-folder (folder) @@ -777,7 +777,7 @@ folders whose names end with a '+' character." (when (search-backward " out of " (point-min) t) (setq total (string-to-number (buffer-substring-no-properties - (match-end 0) (line-end-position)))) + (match-end 0) (mh-line-end-position)))) (when (search-backward " in sequence " (point-min) t) (setq p (point)) (when (search-backward " has " (point-min) t) @@ -955,7 +955,7 @@ font-lock is turned on." ;; the case of user sequences. (mh-notate nil nil mh-cmd-note) (when font-lock-mode - (font-lock-fontify-region (point) (line-end-position)))) + (font-lock-fontify-region (point) (mh-line-end-position)))) (forward-char (+ mh-cmd-note mh-scan-field-destination-offset)) (let ((stack (gethash msg mh-sequence-notation-history))) (setf (gethash msg mh-sequence-notation-history) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index f8728edb3e4..ab636ae8ab6 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -878,7 +878,7 @@ See also `mh-folder-mode'. (defun mh-show-addr () "Use `goto-address'." (when mh-show-use-goto-addr-flag - (require 'goto-addr nil t) + (mh-require 'goto-addr nil t) (if (fboundp 'goto-address) (goto-address)))) diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index 00cfd5ef961..ebf34abbd4c 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -69,13 +69,13 @@ ["Visit Folder" mh-speed-view (save-excursion (set-buffer speedbar-buffer) - (get-text-property (line-beginning-position) 'mh-folder))] + (get-text-property (mh-line-beginning-position) 'mh-folder))] ["Expand Nested Folders" mh-speed-expand-folder - (and (get-text-property (line-beginning-position) 'mh-children-p) - (not (get-text-property (line-beginning-position) 'mh-expanded)))] + (and (get-text-property (mh-line-beginning-position) 'mh-children-p) + (not (get-text-property (mh-line-beginning-position) 'mh-expanded)))] ["Contract Nested Folders" mh-speed-contract-folder - (and (get-text-property (line-beginning-position) 'mh-children-p) - (get-text-property (line-beginning-position) 'mh-expanded))] + (and (get-text-property (mh-line-beginning-position) 'mh-children-p) + (get-text-property (mh-line-beginning-position) 'mh-expanded))] ["Refresh Speedbar" mh-speed-refresh t]) "Extra menu items for speedbar.") @@ -157,7 +157,7 @@ The optional ARGS from speedbar are ignored." (forward-line -1) (speedbar-change-expand-button-char ?+) (add-text-properties - (line-beginning-position) (1+ (line-beginning-position)) + (mh-line-beginning-position) (1+ (line-beginning-position)) '(mh-expanded nil))) (t (forward-line) @@ -165,7 +165,7 @@ The optional ARGS from speedbar are ignored." (goto-char point) (speedbar-change-expand-button-char ?-) (add-text-properties - (line-beginning-position) (1+ (line-beginning-position)) + (mh-line-beginning-position) (1+ (line-beginning-position)) `(mh-expanded t))))))) (defun mh-speed-view (&rest args) @@ -173,7 +173,7 @@ The optional ARGS from speedbar are ignored." The optional ARGS from speedbar are ignored." (interactive) (declare (ignore args)) - (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) + (let* ((folder (get-text-property (mh-line-beginning-position) 'mh-folder)) (range (and (stringp folder) (mh-read-range "Scan" folder t nil nil mh-interpret-number-as-range-flag)))) @@ -199,9 +199,9 @@ created." (forward-line -1) (setf (gethash nil mh-speed-folder-map) (set-marker (or (gethash nil mh-speed-folder-map) (make-marker)) - (1+ (line-beginning-position)))) + (1+ (mh-line-beginning-position)))) (add-text-properties - (line-beginning-position) (1+ (line-beginning-position)) + (mh-line-beginning-position) (1+ (line-beginning-position)) `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0)) (mh-speed-stealth-update t) (when (> mh-speed-update-interval 0) @@ -268,12 +268,12 @@ The update is always carried out if FORCE is non-nil." (speedbar-with-writable (goto-char (gethash folder mh-speed-folder-map (point))) (beginning-of-line) - (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t) + (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (mh-line-end-position) t) (setq face (mh-speed-bold-face face)) (setq face (mh-speed-normal-face face))) (beginning-of-line) - (when (re-search-forward "\\[.\\] " (line-end-position) t) - (put-text-property (point) (line-end-position) 'face face))))) + (when (re-search-forward "\\[.\\] " (mh-line-end-position) t) + (put-text-property (point) (mh-line-end-position) 'face face))))) (defun mh-speed-normal-face (face) "Return normal face for given FACE." @@ -313,7 +313,7 @@ The function will expand out parent folders of FOLDER if needed." (while suffix-list ;; We always need atleast one toggle. We need two if the directory list ;; is stale since a folder was added. - (when (equal prefix (get-text-property (line-beginning-position) + (when (equal prefix (get-text-property (mh-line-beginning-position) 'mh-folder)) (mh-speed-toggle) (unless (get-text-property (point) 'mh-expanded) @@ -368,9 +368,9 @@ uses." (setf (gethash folder-name mh-speed-folder-map) (set-marker (or (gethash folder-name mh-speed-folder-map) (make-marker)) - (1+ (line-beginning-position)))) + (1+ (mh-line-beginning-position)))) (add-text-properties - (line-beginning-position) (1+ (line-beginning-position)) + (mh-line-beginning-position) (1+ (mh-line-beginning-position)) `(mh-folder ,folder-name mh-expanded nil mh-children-p ,(not (not (cdr f))) @@ -400,7 +400,7 @@ flists is run only for that one folder." (interactive (list t)) (when force (when mh-speed-flists-timer - (cancel-timer mh-speed-flists-timer) + (mh-cancel-timer mh-speed-flists-timer) (setq mh-speed-flists-timer nil)) (when (and (processp mh-speed-flists-process) (not (eq (process-status mh-speed-flists-process) 'exit))) @@ -471,25 +471,25 @@ be handled next." face) (when pos (goto-char pos) - (goto-char (line-beginning-position)) + (goto-char (mh-line-beginning-position)) (cond ((null (get-text-property (point) 'mh-count)) - (goto-char (line-end-position)) + (goto-char (mh-line-end-position)) (setq face (get-text-property (1- (point)) 'face)) (insert (format " (%s/%s)" unseen total)) (mh-speed-highlight 'unknown face) - (goto-char (line-beginning-position)) + (goto-char (mh-line-beginning-position)) (add-text-properties (point) (1+ (point)) `(mh-count (,unseen . ,total)))) ((not (equal (get-text-property (point) 'mh-count) (cons unseen total))) - (goto-char (line-end-position)) + (goto-char (mh-line-end-position)) (setq face (get-text-property (1- (point)) 'face)) - (re-search-backward " " (line-beginning-position) t) - (delete-region (point) (line-end-position)) + (re-search-backward " " (mh-line-beginning-position) t) + (delete-region (point) (mh-line-end-position)) (insert (format " (%s/%s)" unseen total)) (mh-speed-highlight 'unknown face) - (goto-char (line-beginning-position)) + (goto-char (mh-line-beginning-position)) (add-text-properties (point) (1+ (point)) `(mh-count (,unseen . ,total)))))))))))) @@ -519,15 +519,15 @@ be handled next." (caar parent-kids))) (setq parent-change ? )))) (goto-char parent-position) - (when (equal (get-text-property (line-beginning-position) 'mh-folder) + (when (equal (get-text-property (mh-line-beginning-position) 'mh-folder) parent) - (when (get-text-property (line-beginning-position) 'mh-expanded) + (when (get-text-property (mh-line-beginning-position) 'mh-expanded) (mh-speed-toggle)) (when parent-change (speedbar-with-writable (mh-speedbar-change-expand-button-char parent-change) (add-text-properties - (line-beginning-position) (1+ (line-beginning-position)) + (mh-line-beginning-position) (1+ (mh-line-beginning-position)) `(mh-children-p ,(equal parent-change ?+))))) (mh-speed-highlight mh-speed-last-selected-folder 'mh-speedbar-folder) (setq mh-speed-last-selected-folder nil) @@ -541,7 +541,7 @@ be handled next." "Change the expansion button character to CHAR for the current line." (save-excursion (beginning-of-line) - (if (re-search-forward "\\[.\\]" (line-end-position) t) + (if (re-search-forward "\\[.\\]" (mh-line-end-position) t) (speedbar-with-writable (backward-char 2) (delete-char 1) @@ -573,9 +573,9 @@ The function invalidates the latest ancestor that is present." (speedbar-with-writable (mh-speedbar-change-expand-button-char ?+) (add-text-properties - (line-beginning-position) (1+ (line-beginning-position)) + (mh-line-beginning-position) (1+ (mh-line-beginning-position)) `(mh-children-p t))) - (when (get-text-property (line-beginning-position) 'mh-expanded) + (when (get-text-property (mh-line-beginning-position) 'mh-expanded) (mh-speed-toggle)) (setq mh-speed-refresh-flag t)))) diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index fa9719985a9..0686b10ac26 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -296,7 +296,7 @@ at the end." (while (not (eobp)) (forward-char address-start-offset) (unless (equal (string-match spaces (buffer-substring-no-properties - (point) (line-end-position))) + (point) (mh-line-end-position))) 0) (beginning-of-line) (backward-char) @@ -456,9 +456,9 @@ are the same containers." If optional argument STRING is given then that is assumed to be the scan line. Otherwise uses the line at point as the scan line to parse." - (let* ((string (or string - (buffer-substring-no-properties (line-beginning-position) - (line-end-position)))) + (let* ((string (or string (buffer-substring-no-properties + (mh-line-beginning-position) + (mh-line-end-position)))) (address-start (+ mh-cmd-note mh-scan-field-from-start-offset)) (body-start (+ mh-cmd-note mh-scan-field-from-end-offset)) (first-string (substring string 0 address-start))) @@ -599,18 +599,20 @@ Only information about messages in MSG-LIST are added to the tree." (while (not (eobp)) (block process-message (let* ((index-line - (prog1 (buffer-substring (point) (line-end-position)) + (prog1 (buffer-substring (point) (mh-line-end-position)) (forward-line))) (index (string-to-number index-line)) - (id (prog1 (buffer-substring (point) (line-end-position)) + (id (prog1 (buffer-substring (point) (mh-line-end-position)) (forward-line))) - (refs (prog1 (buffer-substring (point) (line-end-position)) + (refs (prog1 + (buffer-substring (point) (mh-line-end-position)) (forward-line))) (in-reply-to (prog1 (buffer-substring (point) - (line-end-position)) + (mh-line-end-position)) (forward-line))) (subject (prog1 - (buffer-substring (point) (line-end-position)) + (buffer-substring + (point) (mh-line-end-position)) (forward-line))) (subject-re-p nil)) (unless (gethash index mh-thread-scan-line-map) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index ec26a6a140c..e948860058f 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -51,11 +51,6 @@ used in lieu of `search' in the CL package." ;;; General Utilities -(require 'mailabbrev nil t) -(mh-defun-compat mail-abbrev-make-syntax-table () - "Emacs 21 and XEmacs don't have this function." - nil) - ;;;###mh-autoload (defun mh-beginning-of-word (&optional n) "Return position of the N th word backwards." @@ -63,7 +58,7 @@ used in lieu of `search' in the CL package." (let ((syntax-table (syntax-table))) (unwind-protect (save-excursion - (mail-abbrev-make-syntax-table) + (mh-mail-abbrev-make-syntax-table) (set-syntax-table mail-abbrev-syntax-table) (backward-word n) (point)) @@ -73,7 +68,7 @@ used in lieu of `search' in the CL package." (defun mh-colors-available-p () "Check if colors are available in the Emacs being used." (or mh-xemacs-flag - (let ((color-cells (display-color-cells))) + (let ((color-cells (mh-display-color-cells))) (and (numberp color-cells) (>= color-cells 8))))) ;;;###mh-autoload @@ -507,8 +502,8 @@ not be returned." ;; top-level folders; otherwise mh-sub-folders returns all the ;; files in / if given an empty string or +. (when folder - (setq folder (replace-regexp-in-string "^\+" "" folder)) - (setq folder (replace-regexp-in-string "/*$" "/" folder)) + (setq folder (mh-replace-regexp-in-string "^\+" "" folder)) + (setq folder (mh-replace-regexp-in-string "/*$" "/" folder)) (if (equal folder "") (setq folder nil))) (loop for f in (mh-sub-folders folder) do @@ -558,9 +553,10 @@ directories that aren't usually mail folders are hidden." (apply #'call-process arg-list) (goto-char (point-min)) (while (not (and (eolp) (bolp))) - (goto-char (line-end-position)) - (let ((start-pos (line-beginning-position)) - (has-pos (search-backward " has " (line-beginning-position) t))) + (goto-char (mh-line-end-position)) + (let ((start-pos (mh-line-beginning-position)) + (has-pos (search-backward " has " + (mh-line-beginning-position) t))) (when (integerp has-pos) (while (equal (char-after has-pos) ? ) (decf has-pos)) @@ -575,7 +571,7 @@ directories that aren't usually mail folders are hidden." (setq name (substring name 0 (1- (length name))))) (push (cons name - (search-forward "(others)" (line-end-position) t)) + (search-forward "(others)" (mh-line-end-position) t)) results)))) (forward-line 1)))) (setq results (nreverse results)) @@ -817,8 +813,6 @@ current buffer." (buffer-substring-no-properties start (point)))) "")) -(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility - ;;;###mh-autoload (defun mh-goto-header-field (field) "Move to FIELD in the message header. @@ -934,10 +928,12 @@ is hidden, if positive then the field is displayed." (unwind-protect (cond ((or (and (not arg) (text-property-any begin end 'invisible 'vanish)) - (and (numberp arg) (>= arg 0)) - (and (eq arg 'long) (> (line-beginning-position 5) end))) + (and (numberp arg) + (>= arg 0)) + (and (eq arg 'long) + (> (mh-line-beginning-position 5) end))) (remove-text-properties begin end '(invisible nil)) - (search-forward ":" (line-end-position) t) + (search-forward ":" (mh-line-end-position) t) (mh-letter-skip-leading-whitespace-in-header-field)) ;; XXX Redesign to make usable by user. Perhaps use a positive ;; numeric prefix to make that many lines visible. diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 45431bef5d2..58d175f5470 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -59,32 +59,6 @@ mh-clean-message-header-flag)) (funcall mh-show-xface-function))) -(defmacro mh-face-foreground-compat (face &optional frame inherit) - "Return the foreground color name of FACE, or nil if unspecified. -See documentation for `face-foreground' for a description of the -arguments FACE, FRAME, and INHERIT. - -Calls `face-foreground' correctly in older environments. Versions -of Emacs prior to version 22 lacked an INHERIT argument which -when t tells `face-foreground' to consider an inherited value for -the foreground if the face does not define one itself." - (if (>= emacs-major-version 22) - `(face-foreground ,face ,frame ,inherit) - `(face-foreground ,face ,frame))) - -(defmacro mh-face-background-compat(face &optional frame inherit) - "Return the background color name of face, or nil if unspecified. -See documentation for `back-foreground' for a description of the -arguments FACE, FRAME, and INHERIT. - -Calls `face-background' correctly in older environments. Versions -of Emacs prior to version 22 lacked an INHERIT argument which -when t tells `face-background' to consider an inherited value for -the background if the face does not define one itself." - (if (>= emacs-major-version 22) - `(face-background ,face ,frame ,inherit) - `(face-background ,face ,frame))) - ;; Shush compiler. (eval-when-compile (mh-do-in-xemacs (defvar default-enable-multibyte-characters))) @@ -120,9 +94,9 @@ in this order is used." insert-image (create-image raw type t :foreground - (mh-face-foreground-compat 'mh-show-xface nil t) + (mh-face-foreground 'mh-show-xface nil t) :background - (mh-face-background-compat 'mh-show-xface nil t)) + (mh-face-background 'mh-show-xface nil t)) " "))) ;; XEmacs (mh-do-in-xemacs @@ -386,41 +360,17 @@ This is only done if `mh-x-image-cache-directory' is nil." (defun mh-x-image-url-cache-canonicalize (url) "Canonicalize URL. Replace the ?/ character with a ?! character and append .png. -Also replaces special characters with `url-hexify-string' since -not all characters, such as :, are legal within Windows -filenames. See URL `http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp'." +Also replaces special characters with `mh-url-hexify-string' +since not all characters, such as :, are legal within Windows +filenames. See URL +`http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp'." (format "%s/%s.png" mh-x-image-cache-directory - (url-hexify-string + (mh-url-hexify-string (with-temp-buffer (insert url) (mh-replace-string "/" "!") (buffer-string))))) -;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21. -(if (not (boundp 'url-unreserved-chars)) - (defconst url-unreserved-chars - '( - ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z - ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z - ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 - ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) - "A list of characters that are _NOT_ reserved in the URL spec. -This is taken from RFC 2396.")) - -(mh-defun-compat url-hexify-string (str) - "Escape characters in a string. -This is a copy of the function of the same name from url-util.el -in Emacs 22; needed by Emacs 21." - (mapconcat - (lambda (char) - ;; Fixme: use a char table instead. - (if (not (memq char url-unreserved-chars)) - (if (> char 255) - (error "Hexifying multibyte character %s" str) - (format "%%%02X" char)) - (char-to-string char))) - str "")) - (defun mh-x-image-get-download-state (file) "Check the state of FILE by following any symbolic links." (unless (file-exists-p mh-x-image-cache-directory) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index ca007554267..44e3fa8c6ec 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -92,7 +92,7 @@ Each element looks like (SERVER-REGEXP . CHANNEL-LIST)." (defcustom rcirc-fill-column nil "*Column beyond which automatic line-wrapping should happen. -If nil, use value of `fill-column'. If frame-width, use the +If nil, use value of `fill-column'. If 'frame-width, use the maximum frame width." :type '(choice (const :tag "Value of `fill-column'") (const :tag "Full frame width" frame-width) @@ -128,7 +128,7 @@ Used as the first arg to `format-time-string'." :group 'rcirc) (defcustom rcirc-read-only-flag t - "*Non-nil means make text in irc buffers read-only." + "*Non-nil means make text in IRC buffers read-only." :type 'boolean :group 'rcirc) @@ -167,7 +167,7 @@ See also `rcirc-authinfo-file-name'." :group 'rcirc) (defcustom rcirc-prompt "> " - "Prompt string to use in irc buffers. + "Prompt string to use in IRC buffers. The following replacements are made: %n is your nick. @@ -354,7 +354,7 @@ last ping." "If non-nil, write information to `rcirc-debug-buffer'.") (defun rcirc-debug (process text) "Add an entry to the debug log including PROCESS and TEXT. -Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-p' +Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-flag' is non-nil." (when rcirc-debug-flag (save-excursion @@ -401,8 +401,8 @@ Functions are called with PROCESS and SENTINEL arguments.") ps)) (defvar rcirc-receive-message-hooks nil - "Hook functions run when a message is recieved from server. -Function is called with PROCESS COMMAND SENDER ARGS and LINE.") + "Hook functions run when a message is received from server. +Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (defun rcirc-filter (process output) "Called when PROCESS receives OUTPUT." (rcirc-debug process output) @@ -587,7 +587,7 @@ If buffer is nil, return the target of the current buffer." (define-key global-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer) (defvar rcirc-browse-url-map (make-sparse-keymap) - "Keymap used ror browsing URLs in `rcirc-mode'.") + "Keymap used for browsing URLs in `rcirc-mode'.") (define-key rcirc-browse-url-map (kbd "RET") 'rcirc-browse-url-at-point) (define-key rcirc-browse-url-map (kbd "<mouse-2>") 'rcirc-browse-url-at-mouse) @@ -599,7 +599,7 @@ If buffer is nil, return the target of the current buffer." "Hook run when setting up rcirc buffer.") (defun rcirc-mode (process target) - "Major mode for irc channel buffers. + "Major mode for IRC channel buffers. \\{rcirc-mode-map}" (kill-all-local-variables) @@ -722,7 +722,7 @@ If ALL is non-nil, update prompts in all IRC buffers." (defun rcirc-generate-new-buffer-name (process target) "Return a buffer name based on PROCESS and TARGET. -This is used for the initial name given to irc buffers." +This is used for the initial name given to IRC buffers." (if target (concat target "@" (process-name process)) (concat "*" (process-name process) "*"))) @@ -985,7 +985,7 @@ record activity." 1)) ; [ (t 3)) ; *** 1) - ? ))) + ?\s))) (fill-column (cond ((eq rcirc-fill-column 'frame-width) (1- (frame-width))) (rcirc-fill-column @@ -1046,7 +1046,7 @@ record activity." process sender response target text))))) (defun rcirc-startup-channels (server) - "Return the list of startup channels for server." + "Return the list of startup channels for SERVER." (let (channels) (dolist (i rcirc-startup-channels-alist) (if (string-match (car i) server) @@ -1127,8 +1127,8 @@ record activity." (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x)))))))) (defun rcirc-ignore-update-automatic (nick) - "Remove NICK from `rcirc-ignore-list' -if NICK is also on `rcirc-ignore-list-automatic'." + "Remove NICK from `rcirc-ignore-list' +if NICK is also on `rcirc-ignore-list-automatic'." (when (member nick rcirc-ignore-list-automatic) (setq rcirc-ignore-list-automatic (delete nick rcirc-ignore-list-automatic) @@ -1486,10 +1486,10 @@ With a prefix arg, prompt for new topic." "Manage the ignore list. Ignore NICK, unignore NICK if already ignored, or list ignored nicks when no NICK is given. When listing ignored nicks, the -ones added to the list automatically are marked with an asterix." +ones added to the list automatically are marked with an asterisk." (interactive "sToggle ignoring of nick: ") (if (string= "" nick) - (rcirc-print process (rcirc-nick process) "NOTICE" target + (rcirc-print process (rcirc-nick process) "NOTICE" target (mapconcat (lambda (nick) (concat nick @@ -1511,19 +1511,19 @@ ones added to the list automatically are marked with an asterix." (propertize (or string "") 'face face 'rear-nonsticky t)) (defvar rcirc-url-regexp - (rx word-boundary + (rx word-boundary (or "www." - (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet" "wais" + (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet" "wais" "mailto") "://" (1+ (char "a-zA-Z0-9_.")) (optional ":" (1+ (char "0-9"))))) (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,")) (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;")) - "Regexp matching URL's. Set to nil to disable URL features in rcirc.") + "Regexp matching URLs. Set to nil to disable URL features in rcirc.") (defun rcirc-browse-url (&optional arg) - "Prompt for url to browse based on urls in buffer." + "Prompt for URL to browse based on URLs in buffer." (interactive) (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls)) (initial-input (car rcirc-urls)) @@ -1559,13 +1559,13 @@ FUNCTION takes 3 arguments, MATCH-START, MATCH-END, and STRING." "Return TEXT with properties added based on various patterns." ;; ^B (setq text - (rcirc-map-regexp + (rcirc-map-regexp (lambda (start end string) (let ((orig-face (get-text-property start 'face string))) (add-text-properties start end (list 'face (if (listp orig-face) - (append orig-face + (append orig-face (list 'bold)) (list orig-face 'bold)) 'rear-nonsticky t) @@ -1573,7 +1573,7 @@ FUNCTION takes 3 arguments, MATCH-START, MATCH-END, and STRING." ".*?" text)) ;; TODO: deal with ^_ and ^C colors sequences - (while (string-match "\\(.*\\)[]\\(.*\\)" text) + (while (string-match "\\(.*\\)[]\\(.*\\)" text) (setq text (concat (match-string 1 text) (match-string 2 text)))) ;; my nick @@ -1596,7 +1596,7 @@ FUNCTION takes 3 arguments, MATCH-START, MATCH-END, and STRING." (let ((orig-face (get-text-property start 'face string))) (add-text-properties start end (list 'face (if (listp orig-face) - (append orig-face + (append orig-face (list 'bold)) (list orig-face 'bold)) 'rear-nonsticky t @@ -1991,7 +1991,7 @@ Passwords are read from `rcirc-authinfo-file-name' (which see)." '((((min-colors 88) (background dark)) (:foreground "cyan1")) (((background dark)) (:foreground "cyan")) (t (:foreground "dark blue"))) - "The face to use to highlight prompts." + "The face used to highlight prompts." :group 'rcirc-faces) (defface rcirc-mode-line-nick diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 10a5dd9eedf..5ff8a0832bc 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -6766,13 +6766,14 @@ If `tramp-discard-garbage' is nil, just erase buffer." "Convert file-attributes ATTR generated by perl script or ls. Convert file mode bits to string and set virtual device number. Return ATTR." + ;; Convert file mode bits to string. (unless (stringp (nth 8 attr)) - ;; Convert file mode bits to string. (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))) - ;; Set file's gid change bit. - (setcar (nthcdr 9 attr) - (not (= (nth 3 attr) - (tramp-get-remote-gid multi-method method user host)))) + ;; Set file's gid change bit. Possible only when id-format is 'integer. + (when (numberp (nth 3 attr)) + (setcar (nthcdr 9 attr) + (not (= (nth 3 attr) + (tramp-get-remote-gid multi-method method user host))))) ;; Set virtual device number. (setcar (nthcdr 11 attr) (tramp-get-device multi-method method user host)) diff --git a/lisp/replace.el b/lisp/replace.el index 46f672a8d1a..92b4be7fd7b 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -973,7 +973,8 @@ the matching is case-sensitive." (defun multi-occur (bufs regexp &optional nlines) "Show all lines in buffers BUFS containing a match for REGEXP. This function acts on multiple buffers; otherwise, it is exactly like -`occur'." +`occur'. When you invoke this command interactively, you must specify +the buffer names that you want, one by one." (interactive (cons (let* ((bufs (list (read-buffer "First buffer to search: " @@ -993,15 +994,19 @@ This function acts on multiple buffers; otherwise, it is exactly like (occur-read-primary-args))) (occur-1 regexp nlines bufs)) -(defun multi-occur-by-filename-regexp (bufregexp regexp &optional nlines) - "Show all lines matching REGEXP in buffers named by BUFREGEXP. +(defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs) + "Show all lines matching REGEXP in buffers specified by BUFREGEXP. +Normally BUFREGEXP matches against each buffer's visited file name, +but if you specify a prefix argument, it matches against the buffer name. See also `multi-occur'." (interactive (cons (let* ((default (car regexp-history)) (input (read-from-minibuffer - "List lines in buffers whose filename matches regexp: " + (if current-prefix-arg + "List lines in buffers whose names match regexp: " + "List lines in buffers whose filenames match regexp: ") nil nil nil @@ -1011,12 +1016,15 @@ See also `multi-occur'." input)) (occur-read-primary-args))) (when bufregexp - (occur-1 regexp nlines + (occur-1 regexp nil (delq nil (mapcar (lambda (buf) - (when (and (buffer-file-name buf) - (string-match bufregexp - (buffer-file-name buf))) + (when (if allbufs + (string-match bufregexp + (buffer-name buf)) + (and (buffer-file-name buf) + (string-match bufregexp + (buffer-file-name buf)))) buf)) (buffer-list)))))) diff --git a/lisp/savehist.el b/lisp/savehist.el index ef75369c761..6c6d936af6a 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -1,6 +1,6 @@ ;;; savehist.el --- Save minibuffer history. -;; Copyright (C) 1997,2005 Free Software Foundation +;; Copyright (C) 1997, 2005 Free Software Foundation ;; Author: Hrvoje Niksic <hniksic@xemacs.org> ;; Keywords: minibuffer @@ -171,7 +171,7 @@ buffer text.") (defvar savehist-loaded nil "Whether the history has already been loaded. -This prevents toggling savehist-mode from destroying existing +This prevents toggling `savehist-mode' from destroying existing minibuffer history.") (when (featurep 'xemacs) @@ -226,9 +226,9 @@ which is probably undesirable." Don't call this from new code, use (savehist-mode 1) instead. This function loads the variables stored in `savehist-file' and turns on -savehist-mode. If savehist-file is in the old format that doesn't record -the value of `savehist-minibuffer-history-variables', that value is -deducted from the contents of the file." +`savehist-mode'. If `savehist-file' is in the old format that doesn't +record the value of `savehist-minibuffer-history-variables', that value +is deducted from the contents of the file." (savehist-mode 1) ;; Old versions of savehist distributed with XEmacs didn't save ;; savehist-minibuffer-history-variables. If that variable is nil @@ -250,8 +250,8 @@ deducted from the contents of the file." (defun savehist-install () "Hook savehist into Emacs. Normally invoked by calling `savehist-mode' to set the minor mode. -Installs `savehist-autosave' in `kill-emacs-hook' and on a timer. To -undo this, call `savehist-uninstall'." +Installs `savehist-autosave' in `kill-emacs-hook' and on a timer. +To undo this, call `savehist-uninstall'." (add-hook 'minibuffer-setup-hook 'savehist-minibuffer-hook) (add-hook 'kill-emacs-hook 'savehist-autosave) ;; Install an invocation of savehist-autosave on a timer. This @@ -333,14 +333,14 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, (defun savehist-autosave () "Save the minibuffer history if it has been modified since the last save. -Does nothing if savehist-mode is off." +Does nothing if `savehist-mode' is off." (when savehist-mode (savehist-save t))) (defun savehist-trim-history (value) - "Retain only the first history-length items in VALUE. + "Retain only the first `history-length' items in VALUE. Only used under XEmacs, which doesn't (yet) implement automatic -trimming of history lists to history-length items." +trimming of history lists to `history-length' items." (if (and (featurep 'xemacs) (natnump history-length) (> (length value) history-length)) diff --git a/lisp/simple.el b/lisp/simple.el index 19615997f7f..53f3d7cfc91 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3735,7 +3735,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." ;; Move to beginning-of-line, ignoring fields and invisibles. (skip-chars-backward "^\n") (while (and (not (bobp)) (line-move-invisible-p (1- (point)))) - (goto-char (previous-char-property-change (1- (point)))) + (goto-char (previous-char-property-change (point))) (skip-chars-backward "^\n")) ;; Take care of fields. diff --git a/lisp/xml.el b/lisp/xml.el index 5b83f4d3479..c97c8052148 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -188,62 +188,62 @@ If PARSE-NS is non-nil, then QNAMES are expanded." (defvar xml-att-def-re) (let* ((start-chars (concat "[:alpha:]:_")) (name-chars (concat "-[:digit:]." start-chars)) -;;[3] S ::= (#x20 | #x9 | #xD | #xA)+ + ;;[3] S ::= (#x20 | #x9 | #xD | #xA)+ (whitespace "[ \t\n\r]")) -;;[4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] -;; | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF] -;; | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] -;; | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF] + ;;[4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] + ;; | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF] + ;; | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] + ;; | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF] (defvar xml-name-start-char-re (concat "[" start-chars "]")) -;;[4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040] + ;;[4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040] (defvar xml-name-char-re (concat "[" name-chars "]")) -;;[5] Name ::= NameStartChar (NameChar)* + ;;[5] Name ::= NameStartChar (NameChar)* (defvar xml-name-re (concat xml-name-start-char-re xml-name-char-re "*")) -;;[6] Names ::= Name (#x20 Name)* + ;;[6] Names ::= Name (#x20 Name)* (defvar xml-names-re (concat xml-name-re "\\(?: " xml-name-re "\\)*")) -;;[7] Nmtoken ::= (NameChar)+ + ;;[7] Nmtoken ::= (NameChar)+ (defvar xml-nmtoken-re (concat xml-name-char-re "+")) -;;[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)* + ;;[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)* (defvar xml-nmtokens-re (concat xml-nmtoken-re "\\(?: " xml-name-re "\\)*")) -;;[66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';' + ;;[66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';' (defvar xml-char-ref-re "\\(?:&#[0-9]+;\\|&#x[0-9a-fA-F]+;\\)") -;;[68] EntityRef ::= '&' Name ';' + ;;[68] EntityRef ::= '&' Name ';' (defvar xml-entity-ref (concat "&" xml-name-re ";")) -;;[69] PEReference ::= '%' Name ';' + ;;[69] PEReference ::= '%' Name ';' (defvar xml-pe-reference-re (concat "%" xml-name-re ";")) -;;[67] Reference ::= EntityRef | CharRef + ;;[67] Reference ::= EntityRef | CharRef (defvar xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)")) -;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'" + ;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'" (defvar xml-att-value-re (concat "\\(?:\"\\(?:[^&\"]\\|" xml-reference-re "\\)*\"\\|" "'\\(?:[^&']\\|" xml-reference-re "\\)*'\\)")) -;;[56] TokenizedType ::= 'ID' [VC: ID] [VC: One ID per Element Type] [VC: ID Attribute Default] -;; | 'IDREF' [VC: IDREF] -;; | 'IDREFS' [VC: IDREF] -;; | 'ENTITY' [VC: Entity Name] -;; | 'ENTITIES' [VC: Entity Name] -;; | 'NMTOKEN' [VC: Name Token] -;; | 'NMTOKENS' [VC: Name Token] + ;;[56] TokenizedType ::= 'ID' [VC: ID] [VC: One ID per Element Type] [VC: ID Attribute Default] + ;; | 'IDREF' [VC: IDREF] + ;; | 'IDREFS' [VC: IDREF] + ;; | 'ENTITY' [VC: Entity Name] + ;; | 'ENTITIES' [VC: Entity Name] + ;; | 'NMTOKEN' [VC: Name Token] + ;; | 'NMTOKENS' [VC: Name Token] (defvar xml-tokenized-type-re "\\(?:ID\\|IDREF\\|IDREFS\\|ENTITY\\|ENTITIES\\|NMTOKEN\\|NMTOKENS\\)") -;;[58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')' + ;;[58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')' (defvar xml-notation-type-re (concat "\\(?:NOTATION" whitespace "(" whitespace "*" xml-name-re "\\(?:" whitespace "*|" whitespace "*" xml-name-re "\\)*" whitespace "*)\\)")) -;;[59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' [VC: Enumeration] [VC: No Duplicate Tokens] + ;;[59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' [VC: Enumeration] [VC: No Duplicate Tokens] (defvar xml-enumeration-re (concat "\\(?:(" whitespace "*" xml-nmtoken-re "\\(?:" whitespace "*|" whitespace "*" xml-nmtoken-re "\\)*" whitespace ")\\)")) -;;[57] EnumeratedType ::= NotationType | Enumeration + ;;[57] EnumeratedType ::= NotationType | Enumeration (defvar xml-enumerated-type-re (concat "\\(?:" xml-notation-type-re "\\|" xml-enumeration-re "\\)")) -;;[54] AttType ::= StringType | TokenizedType | EnumeratedType -;;[55] StringType ::= 'CDATA' + ;;[54] AttType ::= StringType | TokenizedType | EnumeratedType + ;;[55] StringType ::= 'CDATA' (defvar xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re "\\|" xml-notation-type-re"\\|" xml-enumerated-type-re "\\)")) -;;[60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue) + ;;[60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue) (defvar xml-default-decl-re (concat "\\(?:#REQUIRED\\|#IMPLIED\\|\\(?:#FIXED" whitespace "\\)*" xml-att-value-re "\\)")) -;;[53] AttDef ::= S Name S AttType S DefaultDecl + ;;[53] AttDef ::= S Name S AttType S DefaultDecl (defvar xml-att-def-re (concat "\\(?:" whitespace "*" xml-name-re whitespace "*" xml-att-type-re whitespace "*" xml-default-decl-re "\\)")) -;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"' -;; | "'" ([^%&'] | PEReference | Reference)* "'" + ;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"' + ;; | "'" ([^%&'] | PEReference | Reference)* "'" (defvar xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re "\\|" xml-reference-re "\\)*\"\\|'\\(?:[^%&']\\|" xml-pe-reference-re "\\|" xml-reference-re "\\)*'\\)"))) @@ -269,7 +269,7 @@ If PARSE-NS is non-nil, then QNAMES are expanded." ;; Get space syntax correct per XML [3]. (dotimes (c 31) (modify-syntax-entry c "." table)) ; all are space in standard table - (dolist (c '(?\t ?\n ?\r)) ; these should be space + (dolist (c '(?\t ?\n ?\r)) ; these should be space (modify-syntax-entry c " " table)) ;; For skipping attributes. (modify-syntax-entry ?\" "\"" table) @@ -306,16 +306,16 @@ is not well-formed XML. If PARSE-DTD is non-nil, the DTD is parsed rather than skipped, and returned as the first element of the list. If PARSE-NS is non-nil, then QNAMES are expanded." - (save-restriction - (narrow-to-region beg end) - ;; Use fixed syntax table to ensure regexp char classes and syntax - ;; specs DTRT. - (with-syntax-table (standard-syntax-table) - (let ((case-fold-search nil) ; XML is case-sensitive. - xml result dtd) - (save-excursion - (if buffer - (set-buffer buffer)) + ;; Use fixed syntax table to ensure regexp char classes and syntax + ;; specs DTRT. + (with-syntax-table (standard-syntax-table) + (let ((case-fold-search nil) ; XML is case-sensitive. + xml result dtd) + (save-excursion + (if buffer + (set-buffer buffer)) + (save-restriction + (narrow-to-region beg end) (goto-char (point-min)) (while (not (eobp)) (if (search-forward "<" nil t) @@ -390,7 +390,7 @@ Returns one of: parse-ns (if parse-ns (list - ;; Default for empty prefix is no namespace + ;; Default for empty prefix is no namespace (cons "" "") ;; "xml" namespace (cons "xml" "http://www.w3.org/XML/1998/namespace") @@ -431,12 +431,12 @@ Returns one of: ;; Parse this node (let* ((node-name (match-string 1)) - ;; Parse the attribute list. - (attrs (xml-parse-attlist xml-ns)) - children pos) + ;; Parse the attribute list. + (attrs (xml-parse-attlist xml-ns)) + children pos) - ;; add the xmlns:* attrs to our cache - (when (consp xml-ns) + ;; add the xmlns:* attrs to our cache + (when (consp xml-ns) (dolist (attr attrs) (when (and (consp (car attr)) (equal "http://www.w3.org/2000/xmlns/" @@ -444,7 +444,7 @@ Returns one of: (push (cons (cdar attr) (cdr attr)) xml-ns)))) - (setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns))) + (setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns))) ;; is this an empty element ? (if (looking-at "/>") @@ -494,21 +494,21 @@ Returns one of: (defun xml-parse-string () "Parse the next whatever. Could be a string, or an element." - (let* ((pos (point)) - (string (progn (if (search-forward "<" nil t) - (forward-char -1) - (goto-char (point-max))) - (buffer-substring pos (point))))) - ;; Clean up the string. As per XML specifications, the XML - ;; processor should always pass the whole string to the - ;; application. But \r's should be replaced: - ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends - (setq pos 0) - (while (string-match "\r\n?" string pos) - (setq string (replace-match "\n" t t string)) - (setq pos (1+ (match-beginning 0)))) - - (xml-substitute-special string))) + (let* ((pos (point)) + (string (progn (if (search-forward "<" nil t) + (forward-char -1) + (goto-char (point-max))) + (buffer-substring pos (point))))) + ;; Clean up the string. As per XML specifications, the XML + ;; processor should always pass the whole string to the + ;; application. But \r's should be replaced: + ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends + (setq pos 0) + (while (string-match "\r\n?" string pos) + (setq string (replace-match "\n" t t string)) + (setq pos (1+ (match-beginning 0)))) + + (xml-substitute-special string))) (defun xml-parse-attlist (&optional xml-ns) "Return the attribute-list after point. @@ -543,8 +543,8 @@ Leave point at the first non-blank character after the tag." (replace-regexp-in-string "\\s-\\{2,\\}" " " string) (let ((expansion (xml-substitute-special string))) (unless (stringp expansion) - ; We say this is the constraint. It is acctually that - ; external entities nor "<" can be in an attribute value. + ; We say this is the constraint. It is acctually that + ; external entities nor "<" can be in an attribute value. (error "XML: (Not Well-Formed) Entities in attributes cannot expand into elements")) (push (cons name expansion) attlist))) |