X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=826c8ecb9809de4a461b9642efda05ce51342fcb;hb=69563203b0ee984bca60e4f12af29f954a9b9415;hp=16651910555712199e7dfe1424d654260a38760a;hpb=2d09ea7141f9a1cf6ef806967d9587f6a048fab6;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 1665191..826c8ec 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -580,6 +580,7 @@ Timezone package is used." Bind `print-quoted' and `print-readably' to t while printing." (let ((print-quoted t) (print-readably t) + (print-escape-multibyte nil) print-level print-length) (prin1 form (current-buffer)))) @@ -603,14 +604,6 @@ Bind `print-quoted' and `print-readably' to t while printing." ;; Write the buffer. (write-region (point-min) (point-max) file nil 'quietly)) -(defmacro gnus-delete-assq (key list) - `(let ((listval (eval ,list))) - (setq ,list (delq (assq ,key listval) listval)))) - -(defmacro gnus-delete-assoc (key list) - `(let ((listval ,list)) - (setq ,list (delq (assoc ,key listval) listval)))) - (defun gnus-delete-file (file) "Delete FILE if it exists." (when (file-exists-p file) @@ -629,10 +622,22 @@ Bind `print-quoted' and `print-readably' to t while printing." (save-restriction (goto-char beg) (while (re-search-forward "[ \t]*\n" end 'move) - (put-text-property beg (match-beginning 0) prop val) + (gnus-put-text-property beg (match-beginning 0) prop val) (setq beg (point))) - (put-text-property beg (point) prop val))))) - + (gnus-put-text-property beg (point) prop val))))) + +(defun gnus-put-text-property-excluding-characters-with-faces (beg end + prop val) + "The same as `put-text-property', but don't put props on characters with the `gnus-face' property." + (let ((b beg)) + (while (/= b end) + (when (get-text-property b 'gnus-face) + (setq b (next-single-property-change b 'gnus-face nil end))) + (when (/= b end) + (gnus-put-text-property + b (setq b (next-single-property-change b 'gnus-face nil end)) + prop val))))) + ;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 ;;; The primary idea here is to try to protect internal datastructures ;;; from becoming corrupted when the user hits C-g, or if a hook or @@ -852,6 +857,7 @@ ARG is passed to the first function." (defvar gnus-netrc-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?@ "w" table) (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?! "w" table) @@ -874,50 +880,59 @@ ARG is passed to the first function." "password" "account" "macdef" "force")) alist elem result pair) (nnheader-set-temp-buffer " *netrc*") - (set-syntax-table gnus-netrc-syntax-table) - (insert-file-contents file) - (goto-char (point-min)) - ;; Go through the file, line by line. - (while (not (eobp)) - (narrow-to-region (point) (gnus-point-at-eol)) - ;; For each line, get the tokens and values. - (while (not (eobp)) - (skip-chars-forward "\t ") - (unless (eobp) - (setq elem (buffer-substring - (point) (progn (forward-sexp 1) (point)))) - (cond - ((equal elem "macdef") - ;; We skip past the macro definition. + (unwind-protect + (progn + (set-syntax-table gnus-netrc-syntax-table) + (insert-file-contents file) + (goto-char (point-min)) + ;; Go through the file, line by line. + (while (not (eobp)) + (narrow-to-region (point) (gnus-point-at-eol)) + ;; For each line, get the tokens and values. + (while (not (eobp)) + (skip-chars-forward "\t ") + (unless (eobp) + (setq elem (buffer-substring + (point) (progn (forward-sexp 1) (point)))) + (cond + ((equal elem "macdef") + ;; We skip past the macro definition. + (widen) + (while (and (zerop (forward-line 1)) + (looking-at "$"))) + (narrow-to-region (point) (point))) + ((member elem tokens) + ;; Tokens that don't have a following value are ignored, + ;; except "default". + (when (and pair (or (cdr pair) + (equal (car pair) "default"))) + (push pair alist)) + (setq pair (list elem))) + (t + ;; Values that haven't got a preceding token are ignored. + (when pair + (setcdr pair elem) + (push pair alist) + (setq pair nil)))))) + (if alist + (push (nreverse alist) result)) + (setq alist nil + pair nil) (widen) - (while (and (zerop (forward-line 1)) - (looking-at "$"))) - (narrow-to-region (point) (point))) - ((member elem tokens) - ;; Tokens that don't have a following value are ignored. - (when (and pair (cdr pair)) - (push pair alist)) - (setq pair (list elem))) - (t - ;; Values that haven't got a preceding token are ignored. - (when pair - (setcdr pair elem) - (push pair alist) - (setq pair nil)))))) - (push alist result) - (setq alist nil - pair nil) - (widen) - (forward-line 1)) - result)))) + (forward-line 1)) + (nreverse result)) + (kill-buffer " *netrc*")))))) (defun gnus-netrc-machine (list machine) - "Return the netrc values from LIST for MACHINE." - (while (and list - (not (equal (cdr (assoc "machine" (car list))) machine))) - (pop list)) - (when list - (car list))) + "Return the netrc values from LIST for MACHINE or for the default entry." + (let ((rest list)) + (while (and list + (not (equal (cdr (assoc "machine" (car list))) machine))) + (pop list)) + (car (or list + (progn (while (and rest (not (assoc "default" (car rest)))) + (pop rest)) + rest))))) (defun gnus-netrc-get (alist type) "Return the value of token TYPE from ALIST." @@ -933,6 +948,41 @@ ARG is passed to the first function." (set-buffer gnus-group-buffer) (eq major-mode 'gnus-group-mode)))) +(defun gnus-remove-duplicates (list) + (let (new (tail list)) + (while tail + (or (member (car tail) new) + (setq new (cons (car tail) new))) + (setq tail (cdr tail))) + (nreverse new))) + +(defun gnus-delete-if (predicate list) + "Delete elements from LIST that satisfy PREDICATE." + (let (out) + (while list + (unless (funcall predicate (car list)) + (push (car list) out)) + (pop list)) + (nreverse out))) + +(defun gnus-delete-alist (key alist) + "Delete all entries in ALIST that have a key eq to KEY." + (let (entry) + (while (setq entry (assq key alist)) + (setq alist (delq entry alist))) + alist)) + +(defmacro gnus-pull (key alist) + "Modify ALIST to be without KEY." + (unless (symbolp alist) + (error "Not a symbol: %s" alist)) + `(setq ,alist (delq (assq ,key ,alist) ,alist))) + +(defun gnus-globalify-regexp (re) + "Returns a regexp that matches a whole line, iff RE matches a part of it." + (concat (unless (string-match "^\\^" re) "^.*") + re + (unless (string-match "\\$$" re) ".*$"))) (provide 'gnus-util)