~vm/vm/vmpc-prompt : revision 1201

144

((member source vm-pop-auto-expunge-warned)

145

nil)

146

(t

147

(message

148

(concat "Warning: POP folder is not set to auto-expunge"))

147

(vm-warn 1 1

148

"Warning: POP folder is not set to auto-expunge")

149

(setq vm-pop-auto-expunge-warned

150

(cons source vm-pop-auto-expunge-warned))

151

(sit-for 1)

152

151

nil)))

153

152

(unwind-protect

154

153

(catch 'done

195

194

(if (null uidl)

196

195

(signal 'vm-cant-uidl nil))

197

196

(setcar msgid uidl)

198

(if (member msgid pop-retrieved-messages)

199

(progn

200

(if vm-pop-ok-to-ask

201

(message

202

"Skipping message %d (of %d) from %s (retrieved already)..."

203

n mailbox-count popdrop))

204

(throw 'skip t))))

197

(when (member msgid pop-retrieved-messages)

198

(if vm-pop-ok-to-ask

199

(vm-inform

200

6

201

"Skipping message %d (of %d) from %s (retrieved already)..."

202

n mailbox-count popdrop))

203

(throw 'skip t)))

205

204

(vm-cant-uidl

206

205

;; something failed, so UIDL must not be working.

207

206

(if (and (not auto-expunge)

208

207

(or (not vm-pop-ok-to-ask)

209

208

(not (vm-pop-ask-about-no-uidl popdrop))))

210

209

(progn

211

(message "Skipping mailbox %s (no UIDL support)"

210

(vm-inform 0 "Skipping mailbox %s (no UIDL support)"

212

211

popdrop)

213

212

(throw 'done (not (equal retrieved 0))))

214

213

;; user doesn't care, so go ahead and

230

229

(progn

231

230

(if (eq response 'delete)

232

231

(progn

233

(message "Deleting message %d..." n)

232

(vm-inform 6 "Deleting message %d..." n)

234

233

(vm-pop-send-command process (format "DELE %d" n))

235

234

(and (null (vm-pop-read-response process))

236

235

(throw 'done (not (equal retrieved 0)))))

237

236

(if vm-pop-ok-to-ask

238

(message "Skipping message %d..." n)

239

(message

237

(vm-inform 6 "Skipping message %d..." n)

238

(vm-inform

239

5

240

"Skipping message %d in %s, too large (%d > %d)..."

241

n popdrop message-size vm-pop-max-message-size)))

242

(throw 'skip t)))

243

(message "Retrieving message %d (of %d) from %s..."

243

(vm-inform 6 "Retrieving message %d (of %d) from %s..."

244

n mailbox-count popdrop)

245

(vm-pop-send-command process (format "RETR %d" n))

246

(and (null (vm-pop-read-response process))

248

(and (null (vm-pop-retrieve-to-target process destination

249

statblob))

250

(throw 'done (not (equal retrieved 0))))

251

(message "Retrieving message %d (of %d) from %s...done"

251

(vm-inform 6 "Retrieving message %d (of %d) from %s...done"

252

n mailbox-count popdrop)

253

(vm-increment retrieved)

254

(and b-per-session

366

(setq popdrop (vm-safe-popdrop-string source))

367

(condition-case nil

368

(progn

369

(message "Opening POP session to %s..." popdrop)

369

(vm-inform 6

370

"Opening POP session to %s..." popdrop)

370

371

(setq process (vm-pop-make-session source))

371

372

(if (null process)

372

373

(signal 'error nil))

373

(message "Expunging messages in %s..." popdrop))

374

(vm-inform 6

375

"Expunging messages in %s..." popdrop))

374

376

(error

375

(message

376

"Couldn't open POP session to %s, skipping..."

377

popdrop)

377

(vm-warn 0 2

378

"Couldn't open POP session to %s, skipping..."

379

popdrop)

378

380

(setq trouble (cons popdrop trouble))

379

(sleep-for 2)

380

381

(while (equal (nth 1 (car mp)) source)

381

382

(setq mp (cdr mp)))

382

383

(throw 'replay t)))

396

397

(vm-increment delete-count)))

397

398

(setq mp (cdr mp)))

398

399

(vm-dele-failed

399

(message "DELE %s failed on %s, skipping rest of mailbox..."

400

(car match) popdrop)

400

(vm-warn

401

0 2 "DELE %s failed on %s, skipping rest of mailbox..."

402

(car match) popdrop)

401

403

(setq trouble (cons popdrop trouble))

402

(sleep-for 2)

403

404

(while (equal (nth 1 (car mp)) source)

404

405

(setq mp (cdr mp)))

405

406

(throw 'replay t))

406

407

(vm-uidl-failed

407

(message "UIDL %s failed on %s, skipping this mailbox..."

408

(car match) popdrop)

408

(vm-warn

409

0 2 "UIDL %s failed on %s, skipping this mailbox..."

410

(car match) popdrop)

409

411

(setq trouble (cons popdrop trouble))

410

(sleep-for 2)

411

412

(while (equal (nth 1 (car mp)) source)

412

413

(setq mp (cdr mp)))

413

414

(throw 'replay t))))

427

428

(setq mp (cdr mp)))

428

429

(setq buffer-read-only t)

429

430

(display-buffer (current-buffer)))

430

(message "%s POP message%s expunged."

431

(vm-inform 5 "%s POP message%s expunged."

431

432

(if (zerop delete-count) "No" delete-count)

432

433

(if (= delete-count 1) "" "s"))))

433

434

(and process (vm-pop-end-session process)))

512

513

(setq pass (cadr authinfo)))))

513

514

(when (null pass)

514

515

(if (null vm-pop-ok-to-ask)

515

(progn (message "Need password for %s" popdrop)

516

(progn (vm-inform 0 "Need password for %s" popdrop)

516

517

(throw 'done nil))

517

518

(setq pass

518

519

(read-passwd

577

578

(setq vm-pop-passwords

578

579

(delete (list source-nopwd pass)

579

580

vm-pop-passwords))

580

(message "POP password for %s incorrect" popdrop)

581

(vm-inform 0 "POP password for %s incorrect" popdrop)

581

582

;; don't sleep unless we're running synchronously.

582

583

(when vm-pop-ok-to-ask

583

584

(sleep-for 2))

595

596

(when (null timestamp)

596

597

(goto-char (point-max))

597

598

(insert-before-markers "<<< ooops, no timestamp found in greeting! >>>\n")

598

(message "Server of %s does not support APOP" popdrop)

599

(vm-inform 0 "Server of %s does not support APOP" popdrop)

599

600

;; don't sleep unless we're running synchronously

600

601

(if vm-pop-ok-to-ask

601

602

(sleep-for 2))

609

610

(setq vm-pop-passwords

610

611

(delete (list source-nopwd pass)

611

612

vm-pop-passwords))

612

(message "POP password for %s incorrect" popdrop)

613

(vm-inform 0 "POP password for %s incorrect" popdrop)

613

614

(when vm-pop-ok-to-ask

614

615

(sleep-for 2))

615

616

(throw 'done nil)))

640

641

(if vm-pop-read-quit-response

641

642

(progn

642

643

(and verbose

643

(message "Waiting for response to POP QUIT command..."))

644

(vm-inform 5 "Waiting for response to POP QUIT command..."))

644

645

(vm-pop-read-response process)

645

646

(and verbose

646

(message

647

(vm-inform 5

647

648

"Waiting for response to POP QUIT command... done"))))))

648

649

(if (and (process-buffer process)

649

650

(buffer-live-p (process-buffer process)))

691

692

693

(defun vm-pop-stop-status-timer (status-blob)

693

694

(if (vm-pop-stat-did-report status-blob)

694

(message ""))

695

(vm-inform 5 ""))

695

696

(if (fboundp 'disable-timeout)

696

697

(disable-timeout (vm-pop-stat-timer status-blob))

697

698

(cancel-timer (vm-pop-stat-timer status-blob))))

702

703

;; should not be possible, but better safe...

703

704

((not (eq (vm-pop-stat-x-box o) (vm-pop-stat-y-box o))) t)

704

705

((not (eq (vm-pop-stat-x-currmsg o) (vm-pop-stat-y-currmsg o))) t)

705

(t (message "Retrieving message %d (of %d) from %s, %s..."

706

(t (vm-inform 6 "Retrieving message %d (of %d) from %s, %s..."

706

707

(vm-pop-stat-x-currmsg o)

707

708

(vm-pop-stat-x-maxmsg o)

708

709

(vm-pop-stat-x-box o)

1107

1108

(setq r-list (cdr r-list)

1108

1109

n (1+ n))))

1109

1110

(error

1110

(message "Retrieval from %s signaled: %s" safe-popdrop

1111

(vm-inform 0 "Retrieval from %s signaled: %s" safe-popdrop

1111

1112

error-data))

1112

1113

(quit

1113

(message "Quit received during retrieval from %s"

1114

(vm-inform 0 "Quit received during retrieval from %s"

1114

1115

safe-popdrop)))

1115

1116

(and statblob (vm-pop-stop-status-timer statblob))

1116

1117

;; to make the "Mail" indicator go away

1252

1253

(vm-select-folder-buffer-and-validate 0 (interactive-p))

1253

1254

(if (or vm-pop-keep-trace-buffer

1254

1255

(y-or-n-p "Did you run vm-pop-start-bug-report earlier? "))

1255

(message "Thank you. Preparing the bug report... ")

1256

(message "Consider running vm-pop-start-bug-report before the problem occurrence"))

1256

(vm-inform 5 "Thank you. Preparing the bug report... ")

1257

(vm-inform 1 "Consider running vm-pop-start-bug-report before the problem occurrence"))

1257

1258

(let ((process (vm-folder-pop-process)))

1258

1259

(if process

1259

1260

(vm-pop-end-session process)))