This commits remove a lot of dead code.
Signed-off-by: Julien Danjou <julien@danjou.info>
+2012-07-24 Julien Danjou <julien@danjou.info>
+
+ * mail-source.el (mail-source-movemail-and-remove): Remove, unused.
+
+ * nntp.el (nntp-send-nosy-authinfo, nntp-send-authinfo-from-file)
+ (nntp-async-timer-handler): Remove, unused.
+
+ * nnimap.el (nnimap-get-responses): Remove, unused.
+
+ * nnheader.el (mail-header-set-extra): Remove, unused.
+
+ * netrc.el (netrc-find-service-number, netrc-store-data): Remove,
+ unused.
+
+ * mm-view.el (mm-view-sound-file): Remove, unused.
+
+ * mm-url.el (mm-url-fetch-simple, mm-url-fetch-form)
+ (mm-url-encode-multipart-form-data): Remove, unused.
+
+ * message.el (message-remove-signature, message-make-host-name)
+ (message-fill-address): Remove, unused.
+
+ * gnus.el (gnus-writable-groups, gnus-group-guess-prefixed-name)
+ (gnus-group-guess-full-name, gnus-group-guess-prefixed-name): Remove,
+ unused.
+
+ * gnus-xmas.el (gnus-xmas-highlight-selected-summary)
+ (gnus-xmas-call-region): Remove, unused.
+
+ * gnus-uu.el (gnus-uu-find-name-in-shar): Remove, unused.
+
+ * gnus-util.el (gnus-extract-address-component-name)
+ (gnus-extract-address-component-email, gnus-sortable-date)
+ (gnus-alist-to-hashtable, gnus-hashtable-to-alist)
+ (gnus-process-live-p): Remove, unused.
+
+ * gnus-topic.el (gnus-group-parent-topic): Remove, unused.
+
+ * gnus-sum.el (gnus-score-set-default, gnus-article-parent-p)
+ (gnus-article-read-p, gnus-uncompress-marks): Remove, unused.
+ (gnus-summary-set-current-mark): Remove obsolete, empty and unused
+ function.
+
+ * gnus-start.el (gnus-kill-newsgroup): Remove unused obsolete function.
+
+ * gnus-score.el (gnus-summary-score-crossposting)
+ (gnus-score-regexp-bad-p): Remove, unused.
+
+ * gnus-salt.el (gnus-tree-goto-article): Remove, unused.
+
+ * gnus-range.el (gnus-sublist-p): Remove, unused.
+
+ * gnus-msg.el (gnus-mail-parse-comma-list, gnus-put-message): Remove,
+ unused.
+
+ * gnus-kill.el (gnus-Newsgroup-kill-file): Remove, unused.
+
+ * gnus-int.el (gnus-list-active-group, gnus-request-group-articles)
+ (gnus-request-associate-buffer): Remove, unused.
+
+ * gnus-group.el (gnus-group-set-method-info)
+ (gnus-group-set-params-info): Remove, unused.
+
+ * gnus-fun.el (gnus-shell-command-to-string)
+ (gnus-shell-command-on-region): Remove, unused.
+
+ * gnus-cite.el (gnus-cited-line-p): Remove, unused.
+
+ * gnus-art.el (gnus-article-text-type-exists-p)
+ (article-translate-characters, gnus-article-hide-text-of-type)
+ (gnus-kill-sticky-article-buffers, gnus-article-maybe-highlight):
+ Remove, unused.
+
2012-07-22 Andrew Cohen <cohen@bu.edu>
* nnir.el ("nnir"): Add 'virtual ability to nnir backend.
(put-text-property (max (1- b) (point-min))
b 'intangible nil)))
-(defun gnus-article-hide-text-of-type (type)
- "Hide text of TYPE in the current buffer."
- (save-excursion
- (let ((b (point-min))
- (e (point-max)))
- (while (setq b (text-property-any b e 'article-type type))
- (add-text-properties b (incf b) gnus-hidden-properties)))))
-
(defun gnus-article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
(save-excursion
b (or (text-property-not-all b (point-max) 'invisible t)
(point-max)))))))
-(defun gnus-article-text-type-exists-p (type)
- "Say whether any text of type TYPE exists in the buffer."
- (text-property-any (point-min) (point-max) 'article-type type))
-
(defsubst gnus-article-header-rank ()
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
(let ((list gnus-sorted-header-list)
props)
(insert replace)))))))))
-(defun article-translate-characters (from to)
- "Translate all characters in the body of the article according to FROM and TO.
-FROM is a string of characters to translate from; to is a string of
-characters to translate to."
- (save-excursion
- (when (article-goto-body)
- (let ((inhibit-read-only t)
- (x (make-string 225 ?x))
- (i -1))
- (while (< (incf i) (length x))
- (aset x i i))
- (setq i 0)
- (while (< i (length from))
- (aset x (aref from i) (aref to i))
- (incf i))
- (translate-region (point) (point-max) x)))))
-
(defun article-translate-strings (map)
"Translate all string in the body of the article according to MAP.
MAP is an alist where the elements are on the form (\"from\" \"to\")."
(when (eq major-mode 'gnus-sticky-article-mode)
(gnus-kill-buffer buffer))))
-(defun gnus-kill-sticky-article-buffers (arg)
- "Kill all sticky article buffers.
-If a prefix ARG is given, ask for confirmation."
- (interactive "P")
- (dolist (buf (gnus-buffers))
- (with-current-buffer buf
- (when (eq major-mode 'gnus-sticky-article-mode)
- (if (not arg)
- (gnus-kill-buffer buf)
- (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
- (gnus-kill-buffer buf)))))))
-
;;;
;;; Gnus MIME viewing functions
;;;
(gnus-article-hide-citation-maybe arg force)
(gnus-article-hide-signature arg))
-(defun gnus-article-maybe-highlight ()
- "Do some article highlighting if article highlighting is requested."
- (when (gnus-visual-p 'article-highlight 'highlight)
- (gnus-article-highlight-some)))
-
(defun gnus-check-group-server ()
;; Make sure the connection to the server is alive.
(unless (gnus-server-opened
(while vars
(make-local-variable (pop vars)))))
-(defun gnus-cited-line-p ()
- "Say whether the current line is a cited line."
- (save-excursion
- (beginning-of-line)
- (let ((found nil))
- (dolist (prefix (mapcar 'car gnus-cite-prefix-alist))
- (when (string= (buffer-substring (point) (+ (length prefix) (point)))
- prefix)
- (setq found t)))
- found)))
-
-
;; Highlighting of different citation levels in message-mode.
;; - message-cite-prefix will be overridden if this is enabled.
(call-process shell-file-name nil (list standard-output nil)
nil shell-command-switch command)))
-(defun gnus-shell-command-on-region (start end command)
- "A simplified `shell-command-on-region'.
-Output to the current buffer, replace text, and don't mingle error."
- (call-process-region start end shell-file-name t
- (list (current-buffer) nil)
- nil shell-command-switch command))
-
;;;###autoload
(defun gnus-random-x-face ()
"Return X-Face header data chosen randomly from `gnus-x-face-directory'."
(gnus-list-of-unread-articles (car info))))))
(error "No such group: %s" (gnus-info-group info))))))
-(defun gnus-group-set-method-info (group select-method)
- (gnus-group-set-info select-method group 'method))
-
-(defun gnus-group-set-params-info (group params)
- (gnus-group-set-info params group 'params))
-
;; Ad-hoc function for inserting data from a different newsrc.eld
;; file. Use with caution, if at all.
(defun gnus-import-other-newsrc-file (file)
dont-check
info)))
-(defun gnus-list-active-group (group)
- "Request active information on GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'list-active-group))
- (when (gnus-check-backend-function func group)
- (funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
-
(defun gnus-request-group-description (group)
"Request a description of GROUP."
(let ((gnus-command-method (gnus-find-method-for-group group))
(funcall (gnus-get-function gnus-command-method func)
(gnus-group-real-name group) (nth 1 gnus-command-method)))))
-(defun gnus-request-group-articles (group)
- "Request a list of existing articles in GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'request-group-articles))
- (when (gnus-check-backend-function func group)
- (funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
-
(defun gnus-close-group (group)
"Request the GROUP be closed."
(let ((gnus-command-method (inline (gnus-find-method-for-group group))))
(gnus-agent-regenerate-group group (list article)))
result))
-(defun gnus-request-associate-buffer (group)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-associate-buffer)
- (gnus-group-real-name group))))
-
(defun gnus-request-restore-buffer (article group)
"Request a new buffer restored to the state of ARTICLE."
(let ((gnus-command-method (gnus-find-method-for-group group)))
;; For kill files
-(defun gnus-Newsgroup-kill-file (newsgroup)
- "Return the name of a kill file for NEWSGROUP.
-If NEWSGROUP is nil, return the global kill file instead."
- (cond ((or (null newsgroup)
- (string-equal newsgroup ""))
- ;; The global kill file is placed at top of the directory.
- (expand-file-name gnus-kill-file-name gnus-kill-files-directory))
- (gnus-use-long-file-name
- ;; Append ".KILL" to capitalized newsgroup name.
- (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
- "." gnus-kill-file-name)
- gnus-kill-files-directory))
- (t
- ;; Place "KILL" under the hierarchical directory.
- (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
- "/" gnus-kill-file-name)
- gnus-kill-files-directory))))
-
(defun gnus-expunge (marks)
"Remove lines marked with MARKS."
(with-current-buffer gnus-summary-buffer
(when (gnus-y-or-n-p "Send this complaint? ")
(message-send-and-exit))))))
-(defun gnus-mail-parse-comma-list ()
- (let (accumulated
- beg)
- (skip-chars-forward " ")
- (while (not (eobp))
- (setq beg (point))
- (skip-chars-forward "^,")
- (while (zerop
- (save-excursion
- (save-restriction
- (let ((i 0))
- (narrow-to-region beg (point))
- (goto-char beg)
- (logand (progn
- (while (search-forward "\"" nil t)
- (incf i))
- (if (zerop i) 2 i))
- 2)))))
- (skip-chars-forward ",")
- (skip-chars-forward "^,"))
- (skip-chars-backward " ")
- (push (buffer-substring beg (point))
- accumulated)
- (skip-chars-forward "^,")
- (skip-chars-forward ", "))
- accumulated))
-
(defun gnus-inews-add-to-address (group)
(let ((to-address (mail-fetch-field "to")))
(when (and to-address
(format "Do you want to add this as `to-list': %s? " to-address))
(gnus-group-add-parameter group (cons 'to-list to-address))))))
-(defun gnus-put-message ()
- "Put the current message in some group and return to Gnus."
- (interactive)
- (let ((reply gnus-article-reply)
- (winconf gnus-prev-winconf)
- (group gnus-newsgroup-name))
- (unless (and group
- (not (gnus-group-read-only-p group)))
- (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
-
- (when (gnus-group-entry group)
- (error "No such group: %s" group))
- (save-excursion
- (save-restriction
- (widen)
- (message-narrow-to-headers)
- (let ((gnus-deletable-headers nil))
- (message-generate-headers
- (if (message-news-p)
- message-required-news-headers
- message-required-mail-headers)))
- (goto-char (point-max))
- (if (string-match " " group)
- (insert "Gcc: \"" group "\"\n")
- (insert "Gcc: " group "\n"))
- (widen)))
- (gnus-inews-do-gcc)
- (when (and (get-buffer gnus-group-buffer)
- (gnus-buffer-exists-p (car-safe reply))
- (cdr reply))
- (set-buffer (car reply))
- (gnus-summary-mark-article-as-replied (cdr reply)))
- (when winconf
- (set-window-configuration winconf))))
-
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
If YANK is non-nil, include the original article."
(setq sum
(+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
-(defun gnus-sublist-p (list sublist)
- "Test whether all elements in SUBLIST are members of LIST."
- (let ((sublistp t))
- (while sublist
- (unless (memq (pop sublist) list)
- (setq sublistp nil
- sublist nil)))
- sublistp))
-
(defun gnus-range-add (range1 range2)
"Add RANGE2 to RANGE1 (nondestructively)."
(unless (listp (cdr range1))
(when pos
(cons pos (next-single-property-change pos 'gnus-number)))))
-(defun gnus-tree-goto-article (article)
- (let ((pos (text-property-any
- (point-min) (point-max) 'gnus-number article)))
- (when pos
- (goto-char pos))))
-
(defun gnus-tree-recenter ()
"Center point in the tree window."
(let ((selected (selected-window))
(gnus-summary-raise-score score))))
(beginning-of-line 2))))
(gnus-set-mode-line 'summary))
-
-(defun gnus-summary-score-crossposting (score date)
- ;; Enter score file entry for current crossposting.
- ;; SCORE is the score to add.
- ;; DATE is the expire date.
- (let ((xref (gnus-summary-header "xref"))
- (start 0)
- group)
- (unless xref
- (error "This article is not crossposted"))
- (while (string-match " \\([^ \t]+\\):" xref start)
- (setq start (match-end 0))
- (when (not (string=
- (setq group
- (substring xref (match-beginning 1) (match-end 1)))
- gnus-newsgroup-name))
- (gnus-summary-score-entry
- "xref" (concat " " group ":") nil score date t)))))
-
\f
;;;
;;; Gnus Score Files
;; Return whether this score file needs to be saved. By Je-haysuss!
updated))
-(defun gnus-score-regexp-bad-p (regexp)
- "Test whether REGEXP is safe for Gnus scoring.
-A regexp is unsafe if it matches newline or a buffer boundary.
-
-If the regexp is good, return nil. If the regexp is bad, return a
-cons cell (SYM . STRING), where the symbol SYM is `new' or `bad'.
-In the `new' case, the string is a safe replacement for REGEXP.
-In the `bad' case, the string is a unsafe subexpression of REGEXP,
-and we do not have a simple replacement to suggest.
-
-See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
- (let (case-fold-search)
- (and
- ;; First, try a relatively fast necessary condition.
- ;; Notice ranges (like [^:] or [\t-\r]), \s>, \Sw, \W, \', \`:
- (string-match "\n\\|\\\\[SsW`']\\|\\[\\^\\|[\0-\n]-" regexp)
- ;; Now break the regexp into tokens, and check each:
- (let ((tail regexp) ; remaining regexp to check
- tok ; current token
- bad ; nil, or bad subexpression
- new ; nil, or replacement regexp so far
- end) ; length of current token
- (while (and (not bad)
- (string-match
- "\\`\\(\\\\[sS]?.\\|\\[\\^?]?[^]]*]\\|[^\\]\\)"
- tail))
- (setq end (match-end 0)
- tok (substring tail 0 end)
- tail (substring tail end))
- (if;; Is token `bad' (matching newline or buffer ends)?
- (or (member tok '("\n" "\\W" "\\`" "\\'"))
- ;; This next handles "[...]", "\\s.", and "\\S.":
- (and (> end 2) (string-match tok "\n")))
- (let ((newtok
- ;; Try to suggest a replacement for tok ...
- (cond ((string-equal tok "\\`") "^") ; or "\\(^\\)"
- ((string-equal tok "\\'") "$") ; or "\\($\\)"
- ((string-match "\\[\\^" tok) ; very common
- (concat (substring tok 0 -1) "\n]")))))
- (if newtok
- (setq new
- (concat
- (or new
- ;; good prefix so far:
- (substring regexp 0 (- (+ (length tail) end))))
- newtok))
- ;; No replacement idea, so give up:
- (setq bad tok)))
- ;; tok is good, may need to extend new
- (and new (setq new (concat new tok)))))
- ;; Now return a value:
- (cond
- (bad (cons 'bad bad))
- (new (cons 'new new))
- (t nil))))))
-
(provide 'gnus-score)
;;; gnus-score.el ends here
(funcall gnus-group-change-level-function
group level oldlevel previous)))))
-(defun gnus-kill-newsgroup (newsgroup)
- "Obsolete function. Kills a newsgroup."
- (gnus-group-change-level
- (gnus-group-entry newsgroup) gnus-level-killed))
-
(defun gnus-check-bogus-newsgroups (&optional confirm)
"Remove bogus newsgroups.
If CONFIRM is non-nil, the user has to confirm the deletion of every
(setq gnus-summary-tool-bar-map map))))
(set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
-(defun gnus-score-set-default (var value)
- "A version of set that updates the GNU Emacs menu-bar."
- (set var value)
- ;; It is the message that forces the active status to be updated.
- (message ""))
-
(defun gnus-make-score-map (type)
"Make a summary score map of type TYPE."
(if t
"Say whether this article is a sparse article or not."
`(memq ,article gnus-newsgroup-ancient))
-(defun gnus-article-parent-p (number)
- "Say whether this article is a parent or not."
- (let ((data (gnus-data-find-list number)))
- (and (cdr data) ; There has to be an article after...
- (< (gnus-data-level (car data)) ; And it has to have a higher level.
- (gnus-data-level (nth 1 data))))))
-
(defun gnus-article-children (number)
"Return a list of all children to NUMBER."
(let* ((data (gnus-data-find-list number))
"Say whether this article is intangible or not."
'(get-text-property (point) 'gnus-intangible))
-(defun gnus-article-read-p (article)
- "Say whether ARTICLE is read or not."
- (not (or (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-spam-marked)
- (memq article gnus-newsgroup-unreads)
- (memq article gnus-newsgroup-unselected)
- (memq article gnus-newsgroup-dormant))))
-
;; Some summary mode macros.
(defmacro gnus-summary-article-number ()
(setq articles (cdr articles)))
out))
-(defun gnus-uncompress-marks (marks)
- "Uncompress the mark ranges in MARKS."
- (let ((uncompressed '(score bookmark))
- out)
- (while marks
- (if (memq (caar marks) uncompressed)
- (push (car marks) out)
- (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
- (setq marks (cdr marks)))
- out))
-
(defun gnus-article-mark-to-type (mark)
"Return the type of MARK."
(or (cadr (assq mark gnus-article-special-mark-lists))
gnus-buttonized-mime-types)))
(gnus-summary-select-article nil 'force)))
-(defun gnus-summary-set-current-mark (&optional current-mark)
- "Obsolete function."
- nil)
-
(defun gnus-summary-next-article (&optional unread subject backward push)
"Select the next article.
If UNREAD, only unread articles are selected.
(setq alist (cdr alist)))
out))
-(defun gnus-group-parent-topic (group)
- "Return the topic GROUP is member of by looking at the group buffer."
- (with-current-buffer gnus-group-buffer
- (if (gnus-group-goto-group group)
- (gnus-current-topic)
- (gnus-group-topic group))))
-
(defun gnus-topic-goto-topic (topic)
(when topic
(gnus-goto-char (text-property-any (point-min) (point-max)
(match-end 0)))))
(list (if (string= name "") nil name) (or address from))))
-(defun gnus-extract-address-component-name (from)
- "Extract name from a From header.
-Uses `gnus-extract-address-components'."
- (nth 0 (gnus-extract-address-components from)))
-
-(defun gnus-extract-address-component-email (from)
- "Extract e-mail address from a From header.
-Uses `gnus-extract-address-components'."
- (nth 1 (gnus-extract-address-components from)))
-
(declare-function message-fetch-field "message" (header &optional not-all))
(defun gnus-fetch-field (field)
;; should be gnus-characterp, but this can't be called in XEmacs anyway
(cons (and (numberp event) event) event)))
-(defun gnus-sortable-date (date)
- "Make string suitable for sorting from DATE."
- (gnus-time-iso8601 (date-to-time date)))
-
(defun gnus-copy-file (file &optional to)
"Copy FILE to TO."
(interactive
(unless dir
(delete-directory directory)))))
-;; The following two functions are used in gnus-registry.
-;; They were contributed by Andreas Fuchs <asf@void.at>.
-(defun gnus-alist-to-hashtable (alist)
- "Build a hashtable from the values in ALIST."
- (let ((ht (make-hash-table
- :size 4096
- :test 'equal)))
- (mapc
- (lambda (kv-pair)
- (puthash (car kv-pair) (cdr kv-pair) ht))
- alist)
- ht))
-
-(defun gnus-hashtable-to-alist (hash)
- "Build an alist from the values in HASH."
- (let ((list nil))
- (maphash
- (lambda (key value)
- (setq list (cons (cons key value) list)))
- hash)
- list))
-
(defun gnus-strip-whitespace (string)
"Return STRING stripped of all whitespace."
(while (string-match "[\r\n\t ]+" string)
(with-current-buffer gnus-group-buffer
(eq major-mode 'gnus-group-mode))))
-(defun gnus-process-live-p (process)
- "Returns non-nil if PROCESS is alive.
-A process is considered alive if its status is `run', `open',
-`listen', `connect' or `stop'."
- (memq (process-status process)
- '(run open listen connect stop)))
-
(defun gnus-remove-if (predicate sequence &optional hash-table-p)
"Return a copy of SEQUENCE with all items satisfying PREDICATE removed.
SEQUENCE should be a list, a vector, or a string. Returns always a list.
gnus-shell-command-separator " sh")))))
state))
-;; Returns the name of what the shar file is going to unpack.
-(defun gnus-uu-find-name-in-shar ()
- (let ((oldpoint (point))
- res)
- (goto-char (point-min))
- (when (re-search-forward gnus-uu-shar-name-marker nil t)
- (setq res (buffer-substring (match-beginning 1) (match-end 1))))
- (goto-char oldpoint)
- res))
-
;; `gnus-uu-choose-action' chooses what action to perform given the name
;; and `gnus-uu-file-action-list'. Returns either nil if no action is
;; found, or the name of the command to run if such a rule is found.
(defvar gnus-agent-summary-mode)
(defvar gnus-draft-mode)
-(defun gnus-xmas-highlight-selected-summary ()
- ;; Highlight selected article in summary buffer
- (when gnus-summary-selected-face
- (when gnus-newsgroup-selected-overlay
- (delete-extent gnus-newsgroup-selected-overlay))
- (setq gnus-newsgroup-selected-overlay
- (make-extent (point-at-bol) (point-at-eol)))
- (set-extent-face gnus-newsgroup-selected-overlay
- gnus-summary-selected-face)))
-
(defcustom gnus-xmas-force-redisplay nil
"*If non-nil, force a redisplay before recentering the summary buffer.
This is ugly, but it works around a bug in `window-displayed-height'."
nil
(mail-strip-quoted-names address)))
-(defun gnus-xmas-call-region (command &rest args)
- (apply
- 'call-process-region (point-min) (point-max) command t '(t nil) nil
- args))
-
(defvar gnus-xmas-modeline-left-extent
(let ((ext (copy-extent modeline-buffer-id-left-extent)))
ext))
(t ;Has positive number
(eq (gnus-request-type group article) 'news)))) ;use it.
-;; Returns a list of writable groups.
-(defun gnus-writable-groups ()
- (let ((alist gnus-newsrc-alist)
- groups group)
- (while (setq group (car (pop alist)))
- (unless (gnus-group-read-only-p group)
- (push group groups)))
- (nreverse groups)))
-
;; Check whether to use long file names.
(defun gnus-use-long-file-name (symbol)
;; The variable has to be set...
group
(concat (gnus-method-to-server-name method) ":" group)))
-(defun gnus-group-guess-prefixed-name (group)
- "Guess the whole name from GROUP and METHOD."
- (gnus-group-prefixed-name group (gnus-find-method-for-group
- group)))
-
(defun gnus-group-full-name (group method)
"Return the full name from GROUP and METHOD, even if the method is native."
(gnus-group-prefixed-name group method t))
-(defun gnus-group-guess-full-name (group)
- "Guess the full name from GROUP, even if the method is native."
- (if (gnus-group-prefixed-p group)
- group
- (gnus-group-full-name group (gnus-find-method-for-group group))))
-
(defun gnus-group-guess-full-name-from-command-method (group)
"Guess the full name from GROUP, even if the method is native."
(if (gnus-group-prefixed-p group)
;; Return whether we moved successfully or not.
to)))
-(defun mail-source-movemail-and-remove (from to)
- "Move FROM to TO using movemail, then remove FROM if empty."
- (or (not (mail-source-movemail from to))
- (not (zerop (nth 7 (file-attributes from))))
- (delete-file from)))
-
(defun mail-source-fetch-with-program (program)
(eq 0 (call-process shell-file-name nil nil nil
shell-command-switch program)))
(forward-char -1)
nil))))
-(defun message-remove-signature ()
- "Remove the signature from the text between point and mark.
-The text will also be indented the normal way."
- (save-excursion
- (let ((start (point))
- mark)
- (if (not (re-search-forward message-signature-separator (mark t) t))
- ;; No signature here, so we just indent the cited text.
- (message-indent-citation)
- ;; Find the last non-empty line.
- (forward-line -1)
- (while (looking-at "[ \t]*$")
- (forward-line -1))
- (forward-line 1)
- (setq mark (set-marker (make-marker) (point)))
- (goto-char start)
- (message-indent-citation)
- ;; Enable undoing the deletion.
- (undo-boundary)
- (delete-region mark (mark t))
- (set-marker mark nil)))))
-
\f
;;;
(concat system-name
".i-did-not-set--mail-host-address--so-tickle-me")))))
-(defun message-make-host-name ()
- "Return the name of the host."
- (let ((fqdn (message-make-fqdn)))
- (string-match "^[^.]+\\." fqdn)
- (substring fqdn 0 (1- (match-end 0)))))
-
(defun message-make-domain ()
"Return the domain name."
(or mail-host-address
(forward-char 1)))
(skip-chars-forward " \t\n")))
-(defun message-fill-address (header value)
- (insert (capitalize (symbol-name header))
- ": "
- (if (consp value) (car value) value)
- "\n")
- (message-fill-field-address))
-
(defun message-split-line ()
"Split current line, moving portion beyond point vertically down.
If the current line has `message-yank-prefix', insert it on the new line."
(autoload 'mml-compute-boundary "mml")
-(defun mm-url-encode-multipart-form-data (pairs &optional boundary)
- "Return PAIRS encoded in multipart/form-data."
- ;; RFC1867
-
- ;; Get a good boundary
- (unless boundary
- (setq boundary (mml-compute-boundary '())))
-
- (concat
-
- ;; Start with the boundary
- "--" boundary "\r\n"
-
- ;; Create name value pairs
- (mapconcat
- 'identity
- ;; Delete any returned items that are empty
- (delq nil
- (mapcar (lambda (data)
- (when (car data)
- ;; For each pair
- (concat
-
- ;; Encode the name
- "Content-Disposition: form-data; name=\""
- (car data) "\"\r\n"
- "Content-Type: text/plain; charset=utf-8\r\n"
- "Content-Transfer-Encoding: binary\r\n\r\n"
-
- (cond ((stringp (cdr data))
- (cdr data))
- ((integerp (cdr data))
- (int-to-string (cdr data))))
-
- "\r\n")))
- pairs))
- ;; use the boundary as a separator
- (concat "--" boundary "\r\n"))
-
- ;; put a boundary at the end.
- "--" boundary "--\r\n"))
-
-(defun mm-url-fetch-form (url pairs)
- "Fetch a form from URL with PAIRS as the data using the POST method."
- (mm-url-load-url)
- (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun mm-url-fetch-simple (url content)
- (mm-url-load-url)
- (let ((url-request-data content)
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
(defun mm-url-remove-markup ()
"Remove all HTML markup, leaving just plain text."
(goto-char (point-min))
(defun mm-inline-audio (handle)
(message "Not implemented"))
-(defun mm-view-sound-file ()
- (message "Not implemented"))
-
(defun mm-w3-prepare-buffer ()
(require 'w3)
(let ((url-standalone-mode t)
(eq type (car (cddr service)))))))
(car service)))
-(defun netrc-find-service-number (name &optional type)
- (let ((services (netrc-parse-services))
- service)
- (setq type (or type 'tcp))
- (while (and (setq service (pop services))
- (not (and (string= name (car service))
- (eq type (car (cddr service)))))))
- (cadr service)))
-
-(defun netrc-store-data (file host port user password)
- (with-temp-buffer
- (when (file-exists-p file)
- (insert-file-contents file))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (insert (format "machine %s login %s password %s port %s\n"
- host user password port))
- (write-region (point-min) (point-max) file nil 'silent)))
-
;;;###autoload
(defun netrc-credentials (machine &rest ports)
"Return a user name/password pair.
(forward-line 1)))
(buffer-substring (point) end))))
-(defun nnimap-get-responses (sequences)
- (let (responses)
- (dolist (sequence sequences)
- (goto-char (point-min))
- (when (re-search-forward (format "^%d " sequence) nil t)
- (push (list sequence (nnimap-parse-response))
- responses)))
- responses))
-
(defvar nnimap-incoming-split-list nil)
(defun nnimap-fetch-inbox (articles)
(read-passwd (format "NNTP (%s@%s) password: "
user nntp-address))))))))))
-(defun nntp-send-nosy-authinfo ()
- "Send the AUTHINFO to the nntp server."
- (let ((user (read-string (format "NNTP (%s) user name: " nntp-address))))
- (unless (member user '(nil ""))
- (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
- (when t ;???Should check if AUTHINFO succeeded
- (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
- (read-passwd (format "NNTP (%s@%s) password: "
- user nntp-address)))))))
-
-(defun nntp-send-authinfo-from-file ()
- "Send the AUTHINFO to the nntp server.
-
-The authinfo login name is taken from the user's login name and the
-password contained in '~/.nntp-authinfo'."
- (when (file-exists-p "~/.nntp-authinfo")
- (with-temp-buffer
- (insert-file-contents "~/.nntp-authinfo")
- (goto-char (point-min))
- (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point) (point-at-eol))))))
-
;;; Internal functions.
(defun nntp-handle-authinfo (process)
nntp-process-start-point (point-max))
(setq after-change-functions '(nntp-after-change-function))))
-(defun nntp-async-timer-handler ()
- (mapcar
- (lambda (proc)
- (if (memq (process-status proc) '(open run))
- (nntp-async-trigger proc)
- (nntp-async-stop proc)))
- nntp-async-process-list))
-
(defun nntp-async-stop (proc)
(setq nntp-async-process-list (delq proc nntp-async-process-list))
(when (and nntp-async-timer (not nntp-async-process-list))
projects / gnus / commitdiff