home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / gnu / emacs / sources / 561 < prev    next >
Encoding:
Text File  |  1992-07-29  |  27.7 KB  |  801 lines
  1. Newsgroups: gnu.emacs.sources
  2. Path: sparky!uunet!cis.ohio-state.edu!d0sb10.fnal.gov!SNYDER
  3. From: SNYDER@d0sb10.fnal.gov (scott snyder)
  4. Subject: better subprocess support for vms emacs (4/4)
  5. Message-ID: <920730000129.28a0007c@D0SB10.FNAL.GOV>
  6. Sender: daemon@cis.ohio-state.edu
  7. Organization: Source only  Discussion and requests in gnu.emacs.help.
  8. Distribution: gnu
  9. Date: Wed, 29 Jul 1992 19:01:29 GMT
  10. Lines: 789
  11.  
  12. -+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+
  13. X    ;; Sort each VERSION-NUMBER-LIST,
  14. X    ;; and remove the versions not to be deleted.
  15. X    (let ((fval file-version-assoc-list))
  16. X      (while fval
  17. X`09(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
  18. X`09       (v-count (length sorted-v-list)))
  19. X`09  (if (> v-count (+ early-retention late-retention))
  20. X`09      (rplacd (nthcdr early-retention sorted-v-list)
  21. X`09`09      (nthcdr (- v-count late-retention)
  22. X`09`09`09      sorted-v-list)))
  23. X`09  (rplacd (car fval)
  24. X`09`09  (cdr sorted-v-list)))
  25. X`09(setq fval (cdr fval))))
  26. X    ;; Look at each file.  If it is a numeric backup file,
  27. X    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
  28. X    (dired-map-dired-file-lines 'dired-trample-file-versions)))
  29. X
  30. X(defun dired-collect-file-versions (ignore fn)
  31. X  "If it looks like fn has versions, we make a list of the versions.
  32. XWe may want to flag some for deletion."
  33. X    (let* ((base-versions
  34. X`09    (concat (file-name-nondirectory fn) ".`7E"))
  35. X`09   (bv-length (length base-versions))
  36. X`09   (possibilities (file-name-all-completions
  37. X`09`09`09   base-versions
  38. X`09`09`09   (file-name-directory fn)))
  39. X`09   (versions (mapcar 'backup-extract-version possibilities)))
  40. X      (if versions
  41. X`09  (setq file-version-assoc-list (cons (cons fn versions)
  42. X`09`09`09`09`09      file-version-assoc-list)))))
  43. X
  44. X(defun dired-trample-file-versions (ignore fn)
  45. X  (let* ((start-vn (string-match "\\.`7E`5B0-9`5D+`7E$" fn))
  46. X`09 base-version-list)
  47. X    (and start-vn
  48. X`09 (setq base-version-list`09; there was a base version to which
  49. X`09       (assoc (substring fn 0 start-vn)`09; this looks like a
  50. X`09`09      file-version-assoc-list))`09; subversion
  51. X`09 (not (memq (string-to-int (substring fn (+ 2 start-vn)))
  52. X`09`09    base-version-list))`09; this one doesn't make the cut
  53. X`09 (dired-flag-this-line-for-DEATH))))
  54. X
  55. X(defun dired-flag-this-line-for-DEATH ()
  56. X  (beginning-of-line)
  57. X  (delete-char 1)
  58. X  (insert "D"))
  59. X
  60. X(defun dired-flag-backup-files ()
  61. X  "Flag all backup files (names ending with `7E) for deletion."
  62. X  (interactive)
  63. X  (save-excursion
  64. X   (let ((buffer-read-only nil))
  65. X     (goto-char (point-min))
  66. X     (while (not (eobp))
  67. X       (and (not (looking-at "  d"))
  68. X`09    (not (eolp))
  69. X`09    (if (fboundp 'backup-file-name-p)
  70. X`09`09(let ((fn (dired-get-filename t t)))
  71. X`09`09  (if fn (backup-file-name-p fn)))
  72. X`09      (end-of-line)
  73. X`09      (forward-char -1)
  74. X`09      (looking-at "`7E"))
  75. X`09    (progn (beginning-of-line)
  76. X`09`09   (delete-char 1)
  77. X`09`09   (insert "D")))
  78. X       (forward-line 1)))))
  79. X
  80. X(defun dired-flag-backup-and-auto-save-files ()
  81. X  "Flag all backup and temporary files for deletion.
  82. XBackup files have names ending in `7E.  Auto save file names usually
  83. Xstart with #."
  84. X  (interactive)
  85. X  (dired-flag-backup-files)
  86. X  (dired-flag-auto-save-files))
  87. X`0C
  88. X(defun dired-rename-file (to-file)
  89. X  "Rename this file to TO-FILE."
  90. X  (interactive
  91. X   (list (read-file-name (format "Rename %s to: "
  92. X`09`09`09`09 (file-name-nondirectory (dired-get-filename)))
  93. X`09`09`09 nil (dired-get-filename))))
  94. X  (setq to-file (expand-file-name to-file))
  95. X  (rename-file (dired-get-filename) to-file)
  96. X  (let ((buffer-read-only nil))
  97. X    (beginning-of-line)
  98. X    (delete-region (point) (progn (forward-line 1) (point)))
  99. X    (setq to-file (expand-file-name to-file))
  100. X    (dired-add-entry (file-name-directory to-file)
  101. X`09`09     (file-name-nondirectory to-file))))
  102. X
  103. X(defun dired-copy-file (to-file)
  104. X  "Copy this file to TO-FILE."
  105. X  (interactive "FCopy to: ")
  106. X  (copy-file (dired-get-filename) to-file)
  107. X  (setq to-file (expand-file-name to-file))
  108. X  (dired-add-entry (file-name-directory to-file)
  109. X`09`09   (file-name-nondirectory to-file)))
  110. X
  111. X(defun dired-add-entry (directory filename)
  112. X  ;; If tree dired is implemented, this function will have to do
  113. X  ;; something smarter with the directory.  Currently, just check
  114. X  ;; default directory, if same, add the new entry at point.  With tree
  115. X  ;; dired, should call 'dired-current-directory' or similar.  Note
  116. X  ;; that this adds the entry 'out of order' if files sorted by time,
  117. X  ;; etc.
  118. X  (if (string-equal directory default-directory)
  119. X      (let ((buffer-read-only nil))
  120. X`09(beginning-of-line)
  121. X`09(call-process "ls" nil t nil
  122. X`09`09      "-d" dired-listing-switches (concat directory filename))
  123. X`09(forward-line -1)
  124. X`09(insert "  ")
  125. X`09(dired-move-to-filename)
  126. X`09(let* ((beg (point))
  127. X`09       (end (progn (end-of-line) (point))))
  128. X`09  (setq filename (buffer-substring beg end))
  129. X`09  (delete-region beg end)
  130. X`09  (insert (file-name-nondirectory filename)))
  131. X`09(beginning-of-line))))
  132. X`0C
  133. X(defun dired-compress ()
  134. X  "Compress this file."
  135. X  (interactive)
  136. X  (let* ((buffer-read-only nil)
  137. X`09 (from-file (dired-get-filename))
  138. X`09 (to-file (concat from-file ".Z")))
  139. X    (if (string-match "\\.Z$" from-file)
  140. X`09(error "%s is already compressed!" from-file))
  141. X    (message "Compressing %s..." from-file)
  142. X    (call-process "compress" nil nil nil "-f" from-file)
  143. X    (message "Compressing %s... done" from-file)
  144. X    (dired-redisplay to-file)))
  145. X
  146. X(defun dired-uncompress ()
  147. X  "Uncompress this file."
  148. X  (interactive)
  149. X  (let* ((buffer-read-only nil)
  150. X`09 (from-file (dired-get-filename))
  151. X`09 (to-file (substring from-file 0 -2)))
  152. X    (if (string-match "\\.Z$" from-file) nil
  153. X`09(error "%s is not compressed!" from-file))
  154. X    (message "Uncompressing %s..." from-file)
  155. X    (call-process "uncompress" nil nil nil from-file)
  156. X    (message "Uncompressing %s... done" from-file)
  157. X    (dired-redisplay to-file)))
  158. X
  159. X(defun dired-byte-recompile ()
  160. X  "Byte recompile this file."
  161. X  (interactive)
  162. X  (let* ((buffer-read-only nil)
  163. X`09 (from-file (dired-get-filename))
  164. X`09 (to-file (substring from-file 0 -3)))
  165. X    (if (string-match "\\.el$" from-file) nil
  166. X`09(error "%s is uncompilable!" from-file))
  167. X    (byte-compile-file from-file)))
  168. X
  169. X(defun dired-chmod (mode)
  170. X  "Change mode of this file."
  171. X  (interactive "sChange to Mode: ")
  172. X  (let ((buffer-read-only nil)
  173. X`09(file (dired-get-filename)))
  174. X    (call-process "/bin/chmod" nil nil nil mode file)
  175. X    (dired-redisplay file)))
  176. X
  177. X(defun dired-chgrp (group)
  178. X  "Change group of this file."
  179. X  (interactive "sChange to Group: ")
  180. X  (let ((buffer-read-only nil)
  181. X`09(file (dired-get-filename)))
  182. X    (call-process "/bin/chgrp" nil nil nil group file)
  183. X    (dired-redisplay file)))
  184. X
  185. X(defun dired-chown (owner)
  186. X  "Change Owner of this file."
  187. X  (interactive "sChange to Owner: ")
  188. X  (let ((buffer-read-only nil)
  189. X`09(file (dired-get-filename)))
  190. X    (call-process "/etc/chown" nil nil nil owner file)
  191. X    (dired-redisplay file)))
  192. X
  193. X(defun dired-redisplay (file) "Redisplay this line."
  194. X  (beginning-of-line)
  195. X  (delete-region (point) (progn (forward-line 1) (point)))
  196. X  (if file (dired-add-entry (file-name-directory    file)
  197. X`09`09`09    (file-name-nondirectory file)))
  198. X  (dired-move-to-filename))
  199. X`0C
  200. X(defun dired-do-deletions ()
  201. X  "In dired, delete the files flagged for deletion."
  202. X  (interactive)
  203. X  (let (delete-list answer)
  204. X    (save-excursion
  205. X     (goto-char 1)
  206. X     (while (re-search-forward "`5ED" nil t)
  207. X       (setq delete-list
  208. X`09     (cons (cons (dired-get-filename t) (1- (point)))
  209. X`09`09   delete-list))))
  210. X    (if (null delete-list)
  211. X`09(message "(No deletions requested)")
  212. X      (save-window-excursion
  213. X       (switch-to-buffer " *Deletions*")
  214. X       (erase-buffer)
  215. X       (setq fill-column 70)
  216. X       (let ((l (reverse delete-list)))
  217. X`09 ;; Files should be in forward order for this loop.
  218. X`09 (while l
  219. X`09   (if (> (current-column) 59)
  220. X`09       (insert ?\n)
  221. X`09     (or (bobp)
  222. X`09`09 (indent-to (* (/ (+ (current-column) 19) 20) 20) 1)))
  223. X`09   (insert (car (car l)))
  224. X`09   (setq l (cdr l))))
  225. X       (goto-char (point-min))
  226. X       (setq answer (yes-or-no-p "Delete these files? ")))
  227. X      (if answer
  228. X`09  (let ((l delete-list)
  229. X`09`09failures)
  230. X`09    ;; Files better be in reverse order for this loop!
  231. X`09    ;; That way as changes are made in the buffer
  232. X`09    ;; they do not shift the lines still to be changed.
  233. X`09    (while l
  234. X`09      (goto-char (cdr (car l)))
  235. X`09      (let ((buffer-read-only nil))
  236. X`09`09(condition-case ()
  237. X`09`09    (let ((fn (concat default-directory (car (car l)))))
  238. X`09`09      (if (file-directory-p fn)
  239. X`09`09`09  (progn
  240. X`09`09`09    (call-process "rmdir" nil nil nil fn)
  241. X`09`09`09    (if (file-exists-p fn) (delete-file fn)))
  242. X`09`09`09(delete-file fn))
  243. X`09`09      (delete-region (point)
  244. X`09`09`09`09     (progn (forward-line 1) (point))))
  245. X`09`09  (error (delete-char 1)
  246. X`09`09`09 (insert " ")
  247. X`09`09`09 (setq failures (cons (car (car l)) failures)))))
  248. X`09      (setq l (cdr l)))
  249. X`09    (if failures
  250. X`09`09(message "Deletions failed: %s"
  251. X`09`09`09 (prin1-to-string failures))))))))
  252. X
  253. X(provide 'dired)
  254. $ CALL UNPACK DIRED.EL;10 841372101
  255. $ create 'f'
  256. XPatches to calc 2.02 to get the gnuplot interface working on vms
  257. Xwith my patched emacs.  You'll need to define the symbol `60gnuplot' to
  258. Xstart up gnuplot.
  259. X
  260. X*** calc-graph.el-orig`09Mon May 18 22:50:34 1992
  261. X--- calc-graph.el`09Mon May 18 22:50:33 1992
  262. X***************
  263. X*** 1,6 ****
  264. X--- 1,7 ----
  265. X  ;; Calculator for GNU Emacs, part II `5Bcalc-graph.el`5D
  266. X  ;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  267. X  ;; Written by Dave Gillespie, daveg@csvax.cs.caltech.edu.
  268. X+ ;; hacked for vms - sss
  269. X `20
  270. X  ;; This file is part of GNU Emacs.
  271. X `20
  272. X***************
  273. X*** 32,38 ****
  274. X  ;;; Graphics
  275. X `20
  276. X  ;;; Note that some of the following initial values also occur in calc.el.
  277. X! (defvar calc-gnuplot-tempfile "/tmp/calc")
  278. X `20
  279. X  (defvar calc-gnuplot-default-device "default")
  280. X  (defvar calc-gnuplot-default-output "STDOUT")
  281. X--- 33,42 ----
  282. X  ;;; Graphics
  283. X `20
  284. X  ;;; Note that some of the following initial values also occur in calc.el.
  285. X! (defvar calc-gnuplot-tempfile`20
  286. X!   (if (eq system-type 'vax-vms)
  287. X!       "sys$scratch:calc"
  288. X!     "/tmp/calc")) ; sss
  289. X `20
  290. X  (defvar calc-gnuplot-default-device "default")
  291. X  (defvar calc-gnuplot-default-output "STDOUT")
  292. X***************
  293. X*** 59,64 ****
  294. X--- 63,72 ----
  295. X  (defvar calc-graph-data-cache nil)
  296. X  (defvar calc-graph-data-cache-limit 10)
  297. X `20
  298. X+ (if (and (eq system-type 'vax-vms)
  299. X+ `09 (string= calc-gnuplot-default-output "/dev/null"))
  300. X+     (setq calc-gnuplot-default-output "nla0:")) ; sss
  301. X+`20
  302. X  (defun calc-graph-fast (many)
  303. X    (interactive "P")
  304. X    (let ((calc-graph-no-auto-view t))
  305. X***************
  306. X*** 343,349 ****
  307. X  `09 (if (or (equal device "") (equal device "default"))
  308. X  `09     (setq device (if printing
  309. X  `09`09`09      "postscript"
  310. X! `09`09`09    (if (or (eq window-system 'x) (getenv "DISPLAY"))
  311. X  `09`09`09`09"x11"
  312. X  `09`09`09      (if (>= calc-gnuplot-version 3)
  313. X  `09`09`09`09  "dumb" "postscript")))))
  314. X--- 351,360 ----
  315. X  `09 (if (or (equal device "") (equal device "default"))
  316. X  `09     (setq device (if printing
  317. X  `09`09`09      "postscript"
  318. X! `09`09`09    (if (or (eq window-system 'x)
  319. X! `09`09`09`09    (getenv (if (eq system-type 'vax-vms)
  320. X! `09`09`09`09`09`09"DECW$DISPLAY"
  321. X! `09`09`09`09`09      "DISPLAY"))) ; sss
  322. X  `09`09`09`09"x11"
  323. X  `09`09`09      (if (>= calc-gnuplot-version 3)
  324. X  `09`09`09`09  "dumb" "postscript")))))
  325. X***************
  326. X*** 1458,1463 ****
  327. X--- 1469,1477 ----
  328. X  `09`09`09   calc-gnuplot-buffer
  329. X  `09`09`09   calc-gnuplot-name
  330. X  `09`09`09   args))
  331. X+ `09      (if (eq system-type 'vax-vms)
  332. X+ `09`09  (setq calc-graph-no-wait
  333. X+ `09`09`09(not process-connection-type))) ; sss
  334. X  `09      (process-kill-without-query calc-gnuplot-process))
  335. X  `09  (file-error
  336. X  `09   (error "Sorry, can't find \"%s\" on your system."
  337. $ CALL UNPACK CALC.DIFFS;2 1178037821
  338. $ create 'f'
  339. XThese are diffs for GNUS 3.14.1 to make it work on vms with my patched emacs
  340. V.
  341. X
  342. XThese patches also include Felix Lee's faster newgroup checking code, and
  343. Xa faster article threader which I wrote.
  344. X
  345. XI also put the following stuff in my .emacs:
  346. X
  347. X(autoload 'gnus "gnus" "Read network news." t)
  348. X(autoload 'gnus-post-news "gnuspost" "Post a new news." t)
  349. X(setq gnus-nntp-server "fnnews")
  350. X(setq gnus-nntp-service 119)
  351. X(setq gnus-startup-file "home:`5Bnews`5Dnewsrc")
  352. X(setq gnus-default-article-saver 'gnus-Subject-save-in-file)
  353. X(setq gnus-article-save-directory "/home/news.")
  354. X(setq gnus-your-organization "SUNY Stony Brook High Energy Physics")
  355. X(setq gnus-novice-user nil)
  356. X(setq gnus-local-timezone "CDT")
  357. X
  358. X
  359. X*** gnus.el-orig`09Mon May 18 22:50:49 1992
  360. X--- gnus.el`09Sun Jun  7 00:51:12 1992
  361. X***************
  362. X*** 1132,1138 ****
  363. X    "Insert startup message in current buffer."
  364. X    ;; Insert the message.
  365. X    (insert "
  366. X!                    GNUS Version 3.14.1
  367. X `20
  368. X           NNTP-based News Reader for GNU Emacs
  369. X `20
  370. X--- 1132,1138 ----
  371. X    "Insert startup message in current buffer."
  372. X    ;; Insert the message.
  373. X    (insert "
  374. X!                    GNUS Version 3.14.1   (sss hacked vers)
  375. X `20
  376. X           NNTP-based News Reader for GNU Emacs
  377. X `20
  378. X***************
  379. X*** 4443,4449 ****
  380. X    (let ((default
  381. X  `09  (expand-file-name
  382. X  `09   (concat (if gnus-use-long-file-name
  383. X! `09`09       (capitalize newsgroup)
  384. X  `09`09     (gnus-newsgroup-directory-form newsgroup))
  385. X  `09`09   "/" (int-to-string (nntp-header-number headers)))
  386. X  `09   (or gnus-article-save-directory "`7E/News"))))
  387. X--- 4443,4451 ----
  388. X    (let ((default
  389. X  `09  (expand-file-name
  390. X  `09   (concat (if gnus-use-long-file-name
  391. X! `09`09       (capitalize (if (eq system-type 'vax-vms)
  392. X! `09`09`09`09       (gnus-dots-to-underscores newsgroup)
  393. X! `09`09`09`09     newsgroup))
  394. X  `09`09     (gnus-newsgroup-directory-form newsgroup))
  395. X  `09`09   "/" (int-to-string (nntp-header-number headers)))
  396. X  `09   (or gnus-article-save-directory "`7E/News"))))
  397. X***************
  398. X*** 5523,5536 ****
  399. X        (fset (car defs) (car (cdr defs)))
  400. X        )))
  401. X `20
  402. X  (defun gnus-make-threads (newsgroup-headers)
  403. X    "Make conversation threads tree from NEWSGROUP-HEADERS."
  404. X!   (let ((headers newsgroup-headers)
  405. X! `09(h nil)
  406. X  `09(d nil)
  407. X  `09(roots nil)
  408. X! `09(dependencies nil))
  409. X!     ;; Make message dependency alist.
  410. X      (while headers
  411. X        (setq h (car headers))
  412. X        (setq headers (cdr headers))
  413. X--- 5525,5620 ----
  414. X        (fset (car defs) (car (cdr defs)))
  415. X        )))
  416. X `20
  417. X+ ;(defun gnus-make-threads (newsgroup-headers)
  418. X+ ;  "Make conversation threads tree from NEWSGROUP-HEADERS."
  419. X+ ;  (let ((headers newsgroup-headers)
  420. X+ ;`09(h nil)
  421. X+ ;`09(d nil)
  422. X+ ;`09(roots nil)
  423. X+ ;`09(dependencies nil))
  424. X+ ;    ;; Make message dependency alist.
  425. X+ ;    (while headers
  426. X+ ;      (setq h (car headers))
  427. X+ ;      (setq headers (cdr headers))
  428. X+ ;      ;; Ignore invalid headers.
  429. X+ ;      (if (vectorp h)`09`09`09;Depends on nntp.el.
  430. X+ ;`09  (progn
  431. X+ ;`09    ;; Ignore broken references, e.g "<123@a.b.c".
  432. X+ ;`09    (setq d (and (nntp-header-references h)
  433. X+ ;`09`09`09 (string-match "\\(<`5B`5E<>`5D+>\\)`5B`5E>`5D*$"
  434. X+ ;`09`09`09`09       (nntp-header-references h))
  435. X+ ;;;`09`09`09 (gnus-find-header-by-id
  436. X+ ;;;`09`09`09  newsgroup-headers
  437. X+ ;;;`09`09`09  (substring (nntp-header-references h)
  438. X+ ;;;`09`09`09`09     (match-beginning 1) (match-end 1)))
  439. X+ ;`09`09`09 ;; In fact if the variable newsgroup-headers
  440. X+ ;`09`09`09 ;; is not 'equal' to the variable
  441. X+ ;`09`09`09 ;; gnus-newsgroup-headers, the following
  442. X+ ;`09`09`09 ;; function call may return bogus value.
  443. X+ ;`09`09`09 (gnus-get-header-by-id
  444. X+ ;`09`09`09  (substring (nntp-header-references h)
  445. X+ ;`09`09`09`09     (match-beginning 1) (match-end 1)))
  446. X+ ;`09`09`09 ))
  447. X+ ;`09    ;; Check subject equality.
  448. X+ ;`09    (or gnus-thread-ignore-subject
  449. X+ ;`09`09(null d)
  450. X+ ;`09`09(string-equal (gnus-simplify-subject
  451. X+ ;`09`09`09       (nntp-header-subject h) 're)
  452. X+ ;`09`09`09      (gnus-simplify-subject
  453. X+ ;`09`09`09       (nntp-header-subject d) 're))
  454. X+ ;`09`09;; H should be a thread root.
  455. X+ ;`09`09(setq d nil))
  456. X+ ;`09    ;; H depends on D.
  457. X+ ;`09    (setq dependencies
  458. X+ ;`09`09  (cons (cons h d) dependencies))
  459. X+ ;`09    ;; H is a thread root.
  460. X+ ;`09    (if (null d)
  461. X+ ;`09`09(setq roots (cons h roots)))
  462. X+ ;`09    ))
  463. X+ ;      )
  464. X+ ;    ;; Make complete threads from the roots.
  465. X+ ;    ;; Note: dependencies are in reverse order, but
  466. X+ ;    ;; gnus-make-threads-1 processes it in reverse order again.  So,
  467. X+ ;    ;; we don't have to worry about it.
  468. X+ ;    (mapcar
  469. X+ ;     (function
  470. X+ ;      (lambda (root)
  471. X+ ;`09(gnus-make-threads-1 root dependencies))) (nreverse roots))
  472. X+ ;    ))
  473. X+`20
  474. X+ ;(defun gnus-make-threads-1 (parent dependencies)
  475. X+ ;  (let ((children nil)
  476. X+ ;`09(d nil)
  477. X+ ;`09(depends dependencies))
  478. X+ ;    ;; Find children.
  479. X+ ;    (while depends
  480. X+ ;      (setq d (car depends))
  481. X+ ;      (setq depends (cdr depends))
  482. X+ ;      (and (cdr d)
  483. X+ ;`09   (eq (nntp-header-id parent) (nntp-header-id (cdr d)))
  484. X+ ;`09   (setq children (cons (car d) children))))
  485. X+ ;    ;; Go down.
  486. X+ ;    (cons parent
  487. X+ ;`09  (mapcar
  488. X+ ;`09   (function
  489. X+ ;`09    (lambda (child)
  490. X+ ;`09      (gnus-make-threads-1 child dependencies))) children))
  491. X+ ;    ))
  492. X+`20
  493. X+ ;; faster threading fns - sss
  494. X+`20
  495. X  (defun gnus-make-threads (newsgroup-headers)
  496. X    "Make conversation threads tree from NEWSGROUP-HEADERS."
  497. X!   (let ((tab (gnus-make-hashtable))
  498. X  `09(d nil)
  499. X+ `09(dlist nil)
  500. X  `09(roots nil)
  501. X! `09(headers newsgroup-headers))
  502. X!`20
  503. X!     (mapcar (function (lambda (h)
  504. X! `09`09`09(gnus-sethash (nntp-header-id h) (list h) tab)))
  505. X! `09    newsgroup-headers)
  506. X!`20
  507. X      (while headers
  508. X        (setq h (car headers))
  509. X        (setq headers (cdr headers))
  510. X***************
  511. X*** 5538,5558 ****
  512. X        (if (vectorp h)`09`09`09;Depends on nntp.el.
  513. X  `09  (progn
  514. X  `09    ;; Ignore broken references, e.g "<123@a.b.c".
  515. X! `09    (setq d (and (nntp-header-references h)
  516. X! `09`09`09 (string-match "\\(<`5B`5E<>`5D+>\\)`5B`5E>`5D*$"
  517. X! `09`09`09`09       (nntp-header-references h))
  518. X! ;;`09`09`09 (gnus-find-header-by-id
  519. X! ;;`09`09`09  newsgroup-headers
  520. X! ;;`09`09`09  (substring (nntp-header-references h)
  521. X! ;;`09`09`09`09     (match-beginning 1) (match-end 1)))
  522. X! `09`09`09 ;; In fact if the variable newsgroup-headers
  523. X! `09`09`09 ;; is not 'equal' to the variable
  524. X! `09`09`09 ;; gnus-newsgroup-headers, the following
  525. X! `09`09`09 ;; function call may return bogus value.
  526. X! `09`09`09 (gnus-get-header-by-id
  527. X! `09`09`09  (substring (nntp-header-references h)
  528. X! `09`09`09`09     (match-beginning 1) (match-end 1)))
  529. X! `09`09`09 ))
  530. X  `09    ;; Check subject equality.
  531. X  `09    (or gnus-thread-ignore-subject
  532. X  `09`09(null d)
  533. X--- 5622,5635 ----
  534. X        (if (vectorp h)`09`09`09;Depends on nntp.el.
  535. X  `09  (progn
  536. X  `09    ;; Ignore broken references, e.g "<123@a.b.c".
  537. X! `09    (setq dlist (and (nntp-header-references h)
  538. X! `09`09`09     (string-match "\\(<`5B`5E<>`5D+>\\)`5B`5E>`5D*$"
  539. X! `09`09`09`09`09   (nntp-header-references h))
  540. X! `09`09`09     (gnus-gethash
  541. X! `09`09`09      (substring (nntp-header-references h)
  542. X! `09`09`09`09`09 (match-beginning 1) (match-end 1))
  543. X! `09`09`09      tab)))
  544. X! `09    (setq d (car dlist))
  545. X  `09    ;; Check subject equality.
  546. X  `09    (or gnus-thread-ignore-subject
  547. X  `09`09(null d)
  548. X***************
  549. X*** 5562,5573 ****
  550. X  `09`09`09       (nntp-header-subject d) 're))
  551. X  `09`09;; H should be a thread root.
  552. X  `09`09(setq d nil))
  553. X! `09    ;; H depends on D.
  554. X! `09    (setq dependencies
  555. X! `09`09  (cons (cons h d) dependencies))
  556. X! `09    ;; H is a thread root.
  557. X! `09    (if (null d)
  558. X! `09`09(setq roots (cons h roots)))
  559. X  `09    ))
  560. X        )
  561. X      ;; Make complete threads from the roots.
  562. X--- 5639,5649 ----
  563. X  `09`09`09       (nntp-header-subject d) 're))
  564. X  `09`09;; H should be a thread root.
  565. X  `09`09(setq d nil))
  566. X! `09    (if d
  567. X! `09`09;; H depends on D.
  568. X! `09`09(setcdr dlist (cons h (cdr dlist)))
  569. X! `09      ;; H is a thread root.
  570. X! `09      (setq roots (cons h roots)))
  571. X  `09    ))
  572. X        )
  573. X      ;; Make complete threads from the roots.
  574. X***************
  575. X*** 5577,5604 ****
  576. X      (mapcar
  577. X       (function
  578. X        (lambda (root)
  579. X! `09(gnus-make-threads-1 root dependencies))) (nreverse roots))
  580. X      ))
  581. X `20
  582. X- (defun gnus-make-threads-1 (parent dependencies)
  583. X-   (let ((children nil)
  584. X- `09(d nil)
  585. X- `09(depends dependencies))
  586. X-     ;; Find children.
  587. X-     (while depends
  588. X-       (setq d (car depends))
  589. X-       (setq depends (cdr depends))
  590. X-       (and (cdr d)
  591. X- `09   (eq (nntp-header-id parent) (nntp-header-id (cdr d)))
  592. X- `09   (setq children (cons (car d) children))))
  593. X-     ;; Go down.
  594. X-     (cons parent
  595. X- `09  (mapcar
  596. X- `09   (function
  597. X- `09    (lambda (child)
  598. X- `09      (gnus-make-threads-1 child dependencies))) children))
  599. X-     ))
  600. X `20
  601. X  (defun gnus-narrow-to-page (&optional arg)
  602. X    "Make text outside current page invisible except for page delimiter.
  603. X  A numeric arg specifies to move forward or backward by that many pages,
  604. X--- 5653,5688 ----
  605. X      (mapcar
  606. X       (function
  607. X        (lambda (root)
  608. X! `09(gnus-make-threads-1 root tab))) (nreverse roots))
  609. X      ))
  610. X `20
  611. X `20
  612. X+ ;(defun gnus-make-threads-1 (parent tab)
  613. X+ ;  (let ((depends (cdr (gnus-gethash (nntp-header-id parent) tab)))
  614. X+ ;`09(children nil))
  615. X+ ;
  616. X+ ;    (while depends
  617. X+ ;      (setq children (cons (car depends) children))
  618. X+ ;      (setq depends (cdr depends)))
  619. X+ ;
  620. X+ ;    (cons parent
  621. X+ ;`09  (mapcar
  622. X+ ;`09   (function
  623. X+ ;`09    (lambda (child)
  624. X+ ;`09      (gnus-make-threads-1 child tab))) children))
  625. X+ ;))
  626. X+`20
  627. X+`20
  628. X+ (defun gnus-make-threads-1 (parent tab)
  629. X+   (cons parent
  630. X+ `09(mapcar
  631. X+ `09 (function
  632. X+ `09  (lambda (child)
  633. X+ `09    (gnus-make-threads-1 child tab)))
  634. X+ `09 (nreverse (cdr (gnus-gethash (nntp-header-id parent) tab)))
  635. X+ `09 ))
  636. X+   )
  637. X+`20
  638. X  (defun gnus-narrow-to-page (&optional arg)
  639. X    "Make text outside current page invisible except for page delimiter.
  640. X  A numeric arg specifies to move forward or backward by that many pages,
  641. X***************
  642. X*** 5720,5730 ****
  643. X  `09`09`09`09  (list newsgroup t))
  644. X  `09`09`09      (car (car gnus-newsrc-assoc)))))
  645. X `20
  646. X  (defun gnus-find-new-newsgroups ()
  647. X    "Looking for new newsgroups and return names.
  648. X  `60-n' option of options line in .newsrc file is recognized."
  649. X    (let ((group nil)
  650. X! `09(new-newsgroups nil))
  651. X      (mapatoms
  652. X       (function
  653. X        (lambda (sym)
  654. X--- 5804,5858 ----
  655. X  `09`09`09`09  (list newsgroup t))
  656. X  `09`09`09      (car (car gnus-newsrc-assoc)))))
  657. X `20
  658. X+ ;(defun gnus-find-new-newsgroups ()
  659. X+ ;  "Looking for new newsgroups and return names.
  660. X+ ;`60-n' option of options line in .newsrc file is recognized."
  661. X+ ;  (let ((group nil)
  662. X+ ;`09(new-newsgroups nil))
  663. X+ ;    (mapatoms
  664. X+ ;     (function
  665. X+ ;      (lambda (sym)
  666. X+ ;`09(setq group (symbol-name sym))
  667. X+ ;`09;; Taking account of `60-n' option.
  668. X+ ;`09(and (or (null gnus-newsrc-options-n-no)
  669. X+ ;`09`09 (not (string-match gnus-newsrc-options-n-no group))
  670. X+ ;`09`09 (and gnus-newsrc-options-n-yes
  671. X+ ;`09`09      (string-match gnus-newsrc-options-n-yes group)))
  672. X+ ;`09     (null (assoc group gnus-killed-assoc)) ;Ignore killed.
  673. X+ ;`09     (null (assoc group gnus-newsrc-assoc)) ;Really new.
  674. X+ ;`09     ;; Find new newsgroup.
  675. X+ ;`09     (setq new-newsgroups
  676. X+ ;`09`09   (cons group new-newsgroups)))
  677. X+ ;`09))
  678. X+ ;     gnus-active-hashtb)
  679. X+ ;    ;; Return new newsgroups.
  680. X+ ;    new-newsgroups
  681. X+ ;    ))
  682. X+`20
  683. X+ ;; Secondly, replace the lousy gnus newgroup checking.  Drop the
  684. X+ ;; following into your .emacs file and you'll get a significant speedup.
  685. X+ ;; I dropped this into gnus.el on our system and byte compiled it so that
  686. X+ ;; everyone else also benefits from the improvement.  I can be a nice guy
  687. X+ ;; sometimes :-)
  688. X+ ;; From: flee@cs.psu.edu (Felix Lee)
  689. X+ ;; Newsgroups: gnu.emacs.gnus
  690. X+ ;; Subject: Re: Why gnus is SLOW to start
  691. X+ ;; Date: 14 Mar 91 03:15:11 GMT
  692. X+ ;;
  693. X  (defun gnus-find-new-newsgroups ()
  694. X    "Looking for new newsgroups and return names.
  695. X  `60-n' option of options line in .newsrc file is recognized."
  696. X    (let ((group nil)
  697. X! `09(new-newsgroups nil)
  698. X! `09(known-groups (gnus-make-hashtable)))
  699. X!     ;; Build a table of known newsgroups.
  700. X!     (mapcar
  701. X!      (function (lambda (group) (gnus-sethash (car group) t known-groups)))
  702. X!      gnus-killed-assoc)
  703. X!     (mapcar
  704. X!      (function (lambda (group) (gnus-sethash (car group) t known-groups)))
  705. X!      gnus-newsrc-assoc)
  706. X!     ;; Compare the active file against what's known.
  707. X      (mapatoms
  708. X       (function
  709. X        (lambda (sym)
  710. X***************
  711. X*** 5734,5741 ****
  712. X  `09`09 (not (string-match gnus-newsrc-options-n-no group))
  713. X  `09`09 (and gnus-newsrc-options-n-yes
  714. X  `09`09      (string-match gnus-newsrc-options-n-yes group)))
  715. X! `09     (null (assoc group gnus-killed-assoc)) ;Ignore killed.
  716. X! `09     (null (assoc group gnus-newsrc-assoc)) ;Really new.
  717. X  `09     ;; Find new newsgroup.
  718. X  `09     (setq new-newsgroups
  719. X  `09`09   (cons group new-newsgroups)))
  720. X--- 5862,5868 ----
  721. X  `09`09 (not (string-match gnus-newsrc-options-n-no group))
  722. X  `09`09 (and gnus-newsrc-options-n-yes
  723. X  `09`09      (string-match gnus-newsrc-options-n-yes group)))
  724. X! `09     (null (gnus-gethash group known-groups))
  725. X  `09     ;; Find new newsgroup.
  726. X  `09     (setq new-newsgroups
  727. X  `09`09   (cons group new-newsgroups)))
  728. X***************
  729. X*** 6150,6159 ****
  730. X  `09     (message "Reading %s... Done" newsrc-file)))
  731. X        )))
  732. X `20
  733. X  (defun gnus-make-newsrc-file (file)
  734. X    "Make server dependent file name by catenating FILE and server host name
  735. V."
  736. X    (let* ((file (expand-file-name file nil))
  737. X! `09 (real-file (concat file "-" gnus-nntp-server)))
  738. X      (if (file-exists-p real-file)
  739. X  `09real-file file)
  740. X      ))
  741. X--- 6277,6298 ----
  742. X  `09     (message "Reading %s... Done" newsrc-file)))
  743. X        )))
  744. X `20
  745. X+ (defun gnus-dots-to-underscores (s)
  746. X+   (let ((i 0)
  747. X+ `09(ss (copy-sequence s)))
  748. X+     (while (< i (length ss))
  749. X+       (if (eq (aref ss i) ?.)
  750. X+ `09  (aset ss i ?_))
  751. X+       (setq i (1+ i)))
  752. X+     ss))
  753. X+`20
  754. X  (defun gnus-make-newsrc-file (file)
  755. X    "Make server dependent file name by catenating FILE and server host name
  756. V."
  757. X    (let* ((file (expand-file-name file nil))
  758. X! `09 (real-file (concat file "-" (if (eq system-type 'vax-vms)
  759. X! `09`09`09`09`09 (gnus-dots-to-underscores
  760. X! `09`09`09`09`09  gnus-nntp-server)
  761. X! `09`09`09`09       gnus-nntp-server))))
  762. X      (if (file-exists-p real-file)
  763. X  `09real-file file)
  764. X      ))
  765. X***************
  766. X*** 6306,6312 ****
  767. X  `09   (message "Saving %s..." gnus-current-startup-file)
  768. X  `09   (let ((make-backup-files t)
  769. X  `09`09 (version-control nil)
  770. X! `09`09 (require-final-newline t)) ;Don't ask even if requested.
  771. X  `09     ;; Make backup file of master newsrc.
  772. X  `09     ;; You can stop or change version control of backup file.
  773. X  `09     ;; Suggested by jason@violet.berkeley.edu.
  774. X--- 6445,6453 ----
  775. X  `09   (message "Saving %s..." gnus-current-startup-file)
  776. X  `09   (let ((make-backup-files t)
  777. X  `09`09 (version-control nil)
  778. X! `09`09 (require-final-newline t) ;Don't ask even if requested.
  779. X! `09`09 (vms-stmlf-recfm t)) ; otherwise lines get broken after 512
  780. X! `09`09`09`09      ; chars on vms
  781. X  `09     ;; Make backup file of master newsrc.
  782. X  `09     ;; You can stop or change version control of backup file.
  783. X  `09     ;; Suggested by jason@violet.berkeley.edu.
  784. X*** gnuspost.el-orig`09Mon May 18 22:50:51 1992
  785. X--- gnuspost.el`09Mon May 18 22:50:51 1992
  786. X***************
  787. X*** 593,598 ****
  788. X--- 593,601 ----
  789. X  `09(setq domain (substring domain 1)))
  790. X      (if (null gnus-local-domain)
  791. X  `09(setq gnus-local-domain domain))
  792. X+     (if (and (eq system-type 'vax-vms)  ; sss
  793. X+ `09     (eq (elt host 0) ?_))
  794. X+ `09(setq host (substring host 1)))
  795. X      ;; Support GENERICFROM as same as standard Bnews system.
  796. X      ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
  797. X      (cond ((null genericfrom)
  798. $ CALL UNPACK GNUS.DIFFS;3 677996035
  799. $ v=f$verify(v)
  800. $ EXIT
  801.