Mercurial > hg > xemacs-beta
changeset 36:c53a95d3c46d r19-15b101
Import from CVS: tag r19-15b101
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 08:53:21 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 08:53:38 2007 +0200 @@ -1,4 +1,17 @@ -*- indented-text -*- +to 19.15 beta101 +-- itimer.el-1.05 +-- hyperbole-4.023 +-- cc-mode.el-4.381 +-- floating-toolbar.el-1.02 +-- balloon-help.el-1.05 +-- W3-3.0.69 +-- VM-6.20 +-- Custom-1.65 +-- Gnus-5.4.30 +-- strip unimplemented subwindows subr code +-- GIF correction courtesy Darrell Kindred + to 19.15 beta100 -- GIF crash fix courtesy of David Moore -- Fix for problem dumping comint with sparcworks
--- a/etc/vm/gear.xpm Mon Aug 13 08:53:21 2007 +0200 +++ b/etc/vm/gear.xpm Mon Aug 13 08:53:38 2007 +0200 @@ -1,9 +1,10 @@ /* XPM */ static char *gear[] = { /* width height num_colors chars_per_pixel */ -" 24 30 241 2", +" 24 30 242 2", /* colors */ ".. c #aaaaaa s background", +"zz c #aaaaaa", ".# c #8e8e8e", ".a c #4d4d4d", ".b c #9f9f9f", @@ -254,18 +255,18 @@ "......#K#X.H.4...p...3.G.J.I.i.i.i.i.6ab.z.r....", "......#N.m.4.3.3.G.G.J.J.W.z.i.i.i.n.i.i.i.I....", ".....J.6.r.4.3.G.G.J.W.W#K#X.n.6#t.i.i.i.i.n.#..", -"..#K.0.0.0.3.G.J.J.W.W#K.....#.H.#.n.i.i.i.i#t..", -"...G.H.3.3.G.J.J.W.W#K.....r.raB#X.6.i.i.i.aaB..", -"...4.3.G.G.J.J.W#K#K.....r.raB#X#X#i.n.i.n#i....", +"..#K.0.0.0.3.G.J.J.W.W#Kzzzz.#.H.#.n.i.i.i.i#t..", +"...G.H.3.3.G.J.J.W.W#Kzzzz.r.raB#X.6.i.i.i.aaB..", +"...4.3.G.G.J.J.W#K#Kzzzz.r.raB#X#X#i.n.i.n#i....", "..#X.r.G.J.J#K.W#K.raB.r.raB#X.#.#.c.a.n.i.6....", "..aB.p.r.J.W#K#KaB.p.m#NaB#X.#.#.c.l.z.i.i.m....", -"....aBaB.W#K#K..#t.n.i.h.#.#.#.c#iab.i.i.i.i#g.I", -"....#K#K#K.....r.a.z.a.i#X.c.c#i.l.a.i.i.i.i.i.6", -"...W.H.....r.raB.a.I.m.i.l.##i.l.l.I.i.i.i.n.h#t", -"...J.G...r.raB#X#tab#t.i.I...l#N#N#N.a.p.n.h.6#t", +"....aBaB.W#K#Kzz#t.n.i.h.#.#.#.c#iab.i.i.i.i#g.I", +"....#K#K#Kzzzz.r.a.z.a.i#X.c.c#i.l.a.i.i.i.i.i.6", +"...W.Hzzzz.r.raB.a.I.m.i.l.##i.l.l.I.i.i.i.n.h#t", +"...J.Gzz.r.raB#X#tab#t.i.Izz.l#N#N#N.a.p.n.h.6#t", ".....3.r.raB#X#X#N.p.p#g.m#K.l#N#N#t.I.I.h.6ab.l", ".....3aBaB#X#X.#.c.c.i.i#t.r#N#t#t.I.6.6ababab..", -".....3.#.c.#.c.c.c...l.p.J.l#t.I.I.I.6.6.pab....", +".....3.#.c.#.c.c.czz.l.p.J.l#t.I.I.I.6.6.pab....", "....#X.a.p#N.c#i#i#i#K.G.c#t.I.I.6.6abab.n.p....", "..........#t#i#i.l#N#N#t.I.I.I.6.6ab.m.z.i.naB..", "...........J.l#N#N#N#t.I.I.6.6.a.a.h.i.i.i#i....",
--- a/lib-src/update-elc.sh Mon Aug 13 08:53:21 2007 +0200 +++ b/lib-src/update-elc.sh Mon Aug 13 08:53:38 2007 +0200 @@ -32,11 +32,11 @@ fi fi -EMACS=${XEMACS:-./src/xemacs} +EMACS="./src/xemacs" +export EMACS + echo " (using $EMACS)" -export EMACS - # fuckin' sysv, man... if [ "`uname -r | sed 's/\(.\).*/\1/'`" -gt 4 ]; then echon() @@ -50,7 +50,6 @@ } fi - REAL=`cd \`dirname $EMACS\` ; pwd | sed 's|^/tmp_mnt||'`/`basename $EMACS` BYTECOMP="$REAL -batch -q -no-site-file " echo "Recompiling in `pwd|sed 's|^/tmp_mnt||'`"
--- a/lisp/comint/comint-xemacs.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/comint/comint-xemacs.el Mon Aug 13 08:53:38 2007 +0200 @@ -31,20 +31,20 @@ ;;; Code: +(defgroup 'comint nil + "General command interpreter in a window stuff." + :group 'processes) + (defface comint-input-face '((((class color) (background dark)) (:foreground "red")) (((class color) (background light)) (:foreground "blue")) - (((class mono)) - (:bold t)) - (((class grayscale)) - (:bold t)) (t (:bold t))) "How to display user input for comint shells." - :group 'comint-input-face) + :group 'comint)
--- a/lisp/custom/ChangeLog Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/custom/ChangeLog Mon Aug 13 08:53:38 2007 +0200 @@ -1,5 +1,17 @@ +Tue Mar 18 14:42:31 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.65 released. + +Tue Mar 18 11:03:02 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-face.el (custom-face-attributes): Removed `:invert'. + (custom-invert-face): Removed. + Mon Mar 17 11:32:51 1997 Per Abrahamsen <abraham@dina.kvl.dk> + * wid-edit.el (widget-file-action): Spelling correction by Greg + Stark <gsstark@mit.edu>. + * Version 1.64 released. Mon Mar 17 10:43:10 1997 Per Abrahamsen <abraham@dina.kvl.dk> @@ -7,7 +19,7 @@ * cus-edit.el (custom-group-menu-create): Split definition into XEmacs and Emacs. XEmacs uses :filter. Emacs limits `custom-menu-nesting'. - (custom-menu-create): Do noy limit `custom-menu-nesting' here. + (custom-menu-create): Do not limit `custom-menu-nesting' here. (custom-menu-update): Removed XEmacs support. * custom.el (custom-help-menu): Use `custom-menu-create' in XEmacs
--- a/lisp/custom/cus-edit.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 08:53:38 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -1808,8 +1808,8 @@ (defun custom-group-menu-create (widget symbol) "Ignoring WIDGET, create a menu entry for customization group SYMBOL." `( ,(custom-unlispify-menu-entry symbol t) - :filter (lambda (&rest junk) - (cdr (custom-menu-create ',symbol))))) + :filter (lambda (&rest junk) + (cdr (custom-menu-create ',symbol))))) ;; But emacs can't. (defun custom-group-menu-create (widget symbol) "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
--- a/lisp/custom/cus-face.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 08:53:38 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -111,33 +111,33 @@ ;; Too hard to do right on XEmacs. (defalias 'initialize-face-resources 'ignore))) -(if (string-match "XEmacs" emacs-version) - ;; Xemacs. - (defun custom-invert-face (face &optional frame) - "Swap the foreground and background colors of face FACE. -If the colors are not specified in the face, use the default colors." - (interactive (list (read-face-name "Reverse face: "))) - (let ((fg (color-name (face-foreground face frame) frame)) - (bg (color-name (face-background face frame) frame))) - (set-face-foreground face bg frame) - (set-face-background face fg frame))) - ;; Emacs. - (defun custom-invert-face (face &optional frame) - "Swap the foreground and background colors of face FACE. -If the colors are not specified in the face, use the default colors." - (interactive (list (read-face-name "Reverse face: "))) - (let ((fg (or (face-foreground face frame) - (face-foreground 'default frame) - (frame-property (or frame (selected-frame)) - 'foreground-color) - "black")) - (bg (or (face-background face frame) - (face-background 'default frame) - (frame-property (or frame (selected-frame)) - 'background-color) - "white"))) - (set-face-foreground face bg frame) - (set-face-background face fg frame)))) +;;(if (string-match "XEmacs" emacs-version) +;; ;; Xemacs. +;; (defun custom-invert-face (face &optional frame) +;; "Swap the foreground and background colors of face FACE. +;;If the colors are not specified in the face, use the default colors." +;; (interactive (list (read-face-name "Reverse face: "))) +;; (let ((fg (color-name (face-foreground face frame) frame)) +;; (bg (color-name (face-background face frame) frame))) +;; (set-face-foreground face bg frame) +;; (set-face-background face fg frame))) +;; ;; Emacs. +;; (defun custom-invert-face (face &optional frame) +;; "Swap the foreground and background colors of face FACE. +;;If the colors are not specified in the face, use the default colors." +;; (interactive (list (read-face-name "Reverse face: "))) +;; (let ((fg (or (face-foreground face frame) +;; (face-foreground 'default frame) +;; (frame-property (or frame (selected-frame)) +;; 'foreground-color) +;; "black")) +;; (bg (or (face-background face frame) +;; (face-background 'default frame) +;; (frame-property (or frame (selected-frame)) +;; 'background-color) +;; "white"))) +;; (set-face-foreground face bg frame) +;; (set-face-background face fg frame)))) (defcustom custom-background-mode nil "The brightness of the background. @@ -249,14 +249,14 @@ :value "white" :help-echo "Set background color.") set-face-background) - (:invert (const :format "Invert Face\n" - :sibling-args (:help-echo "\ -Reverse the foreground and background color. -If you haven't specified them for the face, the default colors will be used.") - t) - (lambda (face value &optional frame) - ;; We don't use VALUE. - (custom-invert-face face frame))) + ;; (:invert (const :format "Invert Face\n" + ;; :sibling-args (:help-echo " + ;;Reverse the foreground and background color. + ;;If you haven't specified them for the face, the default colors will be used.") + ;; t) + ;; (lambda (face value &optional frame) + ;; ;; We don't use VALUE. + ;; (custom-invert-face face frame))) (:stipple (editable-field :format "Stipple: %v" :help-echo "Name of background bitmap file.") set-face-stipple))
--- a/lisp/custom/custom.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 08:53:38 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/custom/wid-browse.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/custom/wid-browse.el Mon Aug 13 08:53:38 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/custom/wid-edit.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 08:53:38 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -2158,7 +2158,7 @@ (file (file-name-nondirectory value)) (menu-tag (widget-apply widget :menu-tag-get)) (must-match (widget-get widget :must-match)) - (answer (read-file-name (concat menu-tag ": (defalt `" value "') ") + (answer (read-file-name (concat menu-tag ": (default `" value "') ") dir nil must-match file))) (widget-value-set widget (abbreviate-file-name answer)) (widget-apply widget :notify widget event)
--- a/lisp/custom/widget-example.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/custom/widget-example.el Mon Aug 13 08:53:38 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget)
--- a/lisp/custom/widget.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 08:53:38 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/gnus/ChangeLog Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/ChangeLog Mon Aug 13 08:53:38 2007 +0200 @@ -1,3 +1,65 @@ +Tue Mar 18 23:54:17 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.30 is released. + +Tue Mar 18 23:43:50 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-group.el (gnus-group-subscribe): Doc fix. + +Tue Mar 18 23:39:08 1997 Lance A. Brown <brown9@niehs.nih.gov> + + * gnus-sum.el (gnus-update-marks): Articles->list. + +Tue Mar 18 23:07:35 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-sum.el (gnus-summary-update-article-line): Don't pass nil + on as subject string. + + * gnus-group.el (gnus-group-read-group): Revert to old + definition. + + * gnus-sum.el (gnus-summary-read-group-1): New function. + (gnus-summary-read-group): Use it. + +Tue Mar 18 17:56:26 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.29 is released. + +Tue Mar 18 14:29:49 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-group.el (gnus-group-read-ephemeral-group): Would set virt + ser too much. + (gnus-group-read-group): Return right value. + + * nnml.el (nnml-generate-nov-databases-1): Save active. + + * gnus-msg.el (gnus-summary-supersede-article): Place point in the + with buffer. + (gnus-inews-add-to-address): Prompt before adding. + + * gnus-art.el (article-strip-leading-space): Not a new command + and keystroke (HTDW Jaari fix). + + * nnfolder.el (nnfolder-close-group): Don't push bogus entries + onto alist. + +Tue Mar 18 14:28:27 1997 Jan Vroonhof <vroonhof@math.ethz.ch> + + * nnfolder.el (nnfolder-request-scan): Check whether buffer really + is live. + +Tue Mar 18 13:53:00 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-group.el (gnus-group-read-group): Iterate instead of + recurse. + + * nnfolder.el (nnfolder-request-accept-article): Don't insert into + Message-ID cache. + * nnbabyl.el (nnbabyl-request-accept-article): Ditto. + * nnmbox.el (nnmbox-request-accept-article): Ditto. + * nnml.el (nnml-request-accept-article): Ditto. + * nnmh.el (nnmh-request-accept-article): Ditto. + Tue Mar 18 00:35:06 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> * gnus.el: Gnus v5.4.28 is released.
--- a/lisp/gnus/gnus-art.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/gnus-art.el Mon Aug 13 08:53:38 2007 +0200 @@ -1018,6 +1018,17 @@ (while (re-search-forward "\n\n\n+" nil t) (replace-match "\n\n" t t))))) +(defun article-strip-leading-space () + "Remove all white space from the beginning of the lines in the article." + (interactive) + (save-excursion + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (while (re-search-forward "^[ \t]+" nil t) + (replace-match "" t t))))) + (defun article-strip-blank-lines () "Strip leading, trailing and multiple blank lines." (interactive) @@ -1669,6 +1680,7 @@ article-remove-trailing-blank-lines article-strip-leading-blank-lines article-strip-multiple-blank-lines + article-strip-leading-space article-strip-blank-lines article-date-local article-date-original
--- a/lisp/gnus/gnus-group.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/gnus-group.el Mon Aug 13 08:53:38 2007 +0200 @@ -1563,9 +1563,9 @@ (require (car method)) (when (boundp saddr) (unless (assq saddr method) - (nconc method `((,saddr ,(cadr method))))) - (setf (cadr method) (format "%s-%d" (cadr method) - (incf gnus-ephemeral-group-server))))) + (nconc method `((,saddr ,(cadr method)))) + (setf (cadr method) (format "%s-%d" (cadr method) + (incf gnus-ephemeral-group-server)))))) (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name group method)))) (gnus-sethash @@ -2538,7 +2538,7 @@ (gnus-group-unsubscribe-current-group n 'unsubscribe)) (defun gnus-group-subscribe (&optional n) - "Unsubscribe the current group." + "Subscribe the current group." (interactive "P") (gnus-group-unsubscribe-current-group n 'subscribe))
--- a/lisp/gnus/gnus-msg.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/gnus-msg.el Mon Aug 13 08:53:38 2007 +0200 @@ -308,13 +308,10 @@ (message-supersede) (push `((lambda () - (gnus-cache-possibly-remove-article ,article nil nil nil t))) - message-send-actions) - (push - `((lambda () (when (buffer-name (get-buffer ,gnus-summary-buffer)) (save-excursion (set-buffer (get-buffer ,gnus-summary-buffer)) + (gnus-cache-possibly-remove-article ,article nil nil nil t) (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) message-send-actions)))) @@ -726,7 +723,9 @@ (gnus-alive-p)) ;; This mail group doesn't have a `to-list', so we add one ;; here. Magic! - (gnus-group-add-parameter group (cons 'to-list to-address))))) + (when (gnus-y-or-n-p + (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."
--- a/lisp/gnus/gnus-sum.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/gnus-sum.el Mon Aug 13 08:53:38 2007 +0200 @@ -1312,7 +1312,8 @@ "t" gnus-article-remove-trailing-blank-lines "l" gnus-article-strip-leading-blank-lines "m" gnus-article-strip-multiple-blank-lines - "a" gnus-article-strip-blank-lines) + "a" gnus-article-strip-blank-lines + "s" gnus-article-strip-leading-space) (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) "v" gnus-version @@ -1514,7 +1515,8 @@ ["Leading" gnus-article-strip-leading-blank-lines t] ["Multiple" gnus-article-strip-multiple-blank-lines t] ["Trailing" gnus-article-remove-trailing-blank-lines t] - ["All of the above" gnus-article-strip-blank-lines t]) + ["All of the above" gnus-article-strip-blank-lines t] + ["Leading space" gnus-article-strip-leading-space t]) ["Overstrike" gnus-article-treat-overstrike t] ["Emphasis" gnus-article-emphasize t] ["Word wrap" gnus-article-fill-cited-article t] @@ -2460,6 +2462,21 @@ If SHOW-ALL is non-nil, already read articles are also listed. If NO-ARTICLE is non-nil, no article is selected initially. If NO-DISPLAY, don't generate a summary buffer." + (let (result) + (while (and group + (null (setq result + (gnus-summary-read-group-1 + group show-all no-article + kill-buffer no-display))) + (eq gnus-auto-select-next 'quietly)) + (set-buffer gnus-group-buffer) + (if (not (equal group (gnus-group-group-name))) + (setq group (gnus-group-group-name)) + (setq group nil))) + result)) + +(defun gnus-summary-read-group-1 (group show-all no-article + kill-buffer no-display) ;; Killed foreign groups can't be entered. (when (and (not (gnus-group-native-p group)) (not (gnus-gethash group gnus-newsrc-hashtb))) @@ -2560,7 +2577,7 @@ (not no-display)) (progn ;; This newsgroup is empty. - (gnus-summary-catchup-and-exit nil t) ;Without confirmations. + (gnus-summary-catchup-and-exit nil t) (gnus-message 6 "No unread news") (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) @@ -2916,17 +2933,18 @@ (memq article gnus-newsgroup-expirable) ;; Only insert the Subject string when it's different ;; from the previous Subject string. - (unless (gnus-subject-equal - (condition-case () - (mail-header-subject - (gnus-data-header - (cadr - (gnus-data-find-list - article - (gnus-data-list t))))) - (error "")) - (mail-header-subject header)) - (mail-header-subject header)) + (if (gnus-subject-equal + (condition-case () + (mail-header-subject + (gnus-data-header + (cadr + (gnus-data-find-list + article + (gnus-data-list t))))) + (error "")) + (mail-header-subject header)) + (mail-header-subject header) + "") nil (cdr (assq article gnus-newsgroup-scored)) (memq article gnus-newsgroup-processable)) (when length @@ -3832,7 +3850,7 @@ gnus-save-score list) (let* ((arts list) - (prev (cons nil articles)) + (prev (cons nil list)) (all prev)) (while arts (if (or (not (consp (car arts)))
--- a/lisp/gnus/gnus.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/gnus.el Mon Aug 13 08:53:38 2007 +0200 @@ -226,7 +226,7 @@ :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.4.28" +(defconst gnus-version-number "5.4.30" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number)
--- a/lisp/gnus/nnbabyl.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/nnbabyl.el Mon Aug 13 08:53:38 2007 +0200 @@ -333,7 +333,6 @@ (save-excursion (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (car (nnbabyl-save-mail (if (stringp group) (list (cons group (nnbabyl-active-number group))) @@ -344,7 +343,6 @@ (goto-char (match-end 0)) (insert-buffer-substring buf) (when last - (nnmail-cache-insert (nnmail-fetch-field "message-id")) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result))))
--- a/lisp/gnus/nnfolder.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/nnfolder.el Mon Aug 13 08:53:38 2007 +0200 @@ -225,7 +225,7 @@ (let ((bufs nnfolder-buffer-alist)) (save-excursion (while bufs - (if (not (buffer-name (nth 1 (car bufs)))) + (if (not (buffer-live-p (nth 1 (car bufs)))) (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) @@ -246,7 +246,8 @@ (equal group nnfolder-current-group)) (let ((inf (assoc group nnfolder-buffer-alist))) (when inf - (when nnfolder-current-group + (when (and nnfolder-current-group + nnfolder-current-buffer) (push (list nnfolder-current-group nnfolder-current-buffer) nnfolder-buffer-alist)) (setq nnfolder-buffer-alist @@ -374,7 +375,6 @@ (forward-line -1) (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (car (nnfolder-save-mail (if (stringp group) @@ -384,8 +384,7 @@ (when last (save-excursion (nnfolder-possibly-change-folder (or (caar art-group) group)) - (nnfolder-save-buffer) - (nnmail-cache-close)))) + (nnfolder-save-buffer)))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (unless result (nnheader-report 'nnfolder "Couldn't store article"))
--- a/lisp/gnus/nnmbox.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/nnmbox.el Mon Aug 13 08:53:38 2007 +0200 @@ -304,7 +304,6 @@ (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (nnmbox-save-mail (if (stringp group) (list (cons group (nnmbox-active-number group))) @@ -314,7 +313,6 @@ (goto-char (point-max)) (insert-buffer-substring buf) (when last - (nnmail-cache-close) (nnmail-save-active nnmbox-group-alist nnmbox-active-file) (save-buffer)))) (car result)))
--- a/lisp/gnus/nnmh.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/nnmh.el Mon Aug 13 08:53:38 2007 +0200 @@ -290,20 +290,16 @@ (deffoo nnmh-request-accept-article (group &optional server last noinsert) (nnmh-possibly-change-directory group server) (nnmail-check-syntax) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) - (prog1 - (if (stringp group) - (and - (nnmail-activate 'nnmh) - (car (nnmh-save-mail - (list (cons group (nnmh-active-number group))) - noinsert))) - (and - (nnmail-activate 'nnmh) - (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) - noinsert)))) - (when last - (nnmail-cache-close)))) + (if (stringp group) + (and + (nnmail-activate 'nnmh) + (car (nnmh-save-mail + (list (cons group (nnmh-active-number group))) + noinsert))) + (and + (nnmail-activate 'nnmh) + (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) + noinsert))))) (deffoo nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group)
--- a/lisp/gnus/nnml.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/gnus/nnml.el Mon Aug 13 08:53:38 2007 +0200 @@ -313,7 +313,6 @@ (nnml-possibly-change-directory group server) (nnmail-check-syntax) (let (result) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) (if (stringp group) (and (nnmail-activate 'nnml) @@ -328,7 +327,6 @@ (nnmail-article-group 'nnml-active-number)))) (when last (nnmail-save-active nnml-group-alist nnml-active-file) - (nnmail-cache-close) (nnml-save-nov)))) result)) @@ -682,11 +680,11 @@ (nnml-open-server (or (nnoo-current-server 'nnml) "")) (setq nnml-directory (expand-file-name nnml-directory)) ;; Recurse down the directories. - (nnml-generate-nov-databases-1 nnml-directory) + (nnml-generate-nov-databases-1 nnml-directory nil t) ;; Save the active file. (nnmail-save-active nnml-group-alist nnml-active-file)) -(defun nnml-generate-nov-databases-1 (dir &optional seen) +(defun nnml-generate-nov-databases-1 (dir &optional seen no-active) "Regenerate the NOV database in DIR." (interactive "DRegenerate NOV in: ") (setq dir (file-name-as-directory dir)) @@ -706,7 +704,9 @@ (when files (funcall nnml-generate-active-function dir) ;; Generate the nov file. - (nnml-generate-nov-file dir files))))) + (nnml-generate-nov-file dir files) + (unless no-active + (nnmail-save-active nnml-group-alist nnml-active-file)))))) (defvar files) (defun nnml-generate-active-info (dir)
--- a/lisp/hyperbole/ChangeLog Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/ChangeLog Mon Aug 13 08:53:38 2007 +0200 @@ -1,3 +1,77 @@ +Thu Mar 13 22:01:52 1997 Bob Weiner <weiner@infodock.com> + +* wrolo.el (rolo-toggle-datestamps): Added. +* hui-mini.el (hui:menus): Added Cust/Toggle-Rolodex-Dates entry. +* hui-menu.el (hui-menu-options): Added Customization/Toggle-Rolodex-Dates + item. +* wrolo.el (rolo-add): Added wrolo-add-hook, executed after the record + is added. + (rolo-edit): Added wrolo-edit-hook, executed after point is + successfully moved to the record to edit. These can be used, for + example, to add and update date entries in address records. + (rolo-current-date): Added. + (rolo-set-date): Added and used as default wrolo-add-hook and + wrolo-edit-hook settings. + +Mon Mar 10 12:17:15 1997 Bob Weiner <weiner@infodock.com> + +* hsys-w3.el (www-url): Eliminated call of external Web browser if not + running under a window system. + +Sun Mar 9 01:32:03 1997 Bob Weiner <weiner@infodock.com> + +* hpath.el (hpath:url-at-p): + (hpath:www-at-p): Fixed bug that referred to an optional match + component without checking if it was matched. + (hpath:url-p): Changed doc to reflect that pathname can be optional. + +* hsite-ex.el: Added (require 'hyperbole) to ensure that this file + is loaded if hsite.el is autoloaded, e.g. under XEmacs. + +Thu Mar 6 14:14:05 1997 Bob Weiner <weiner@infodock.com> + +* hui-mini.el (hyperbole): Added autoload special comment. + +Wed Mar 5 01:14:47 1997 Bob Weiner <weiner@infodock.com> + +* kotl/kotl-mode.el (kotl-mode:center-line): +* kotl/kview.el (kcell-view:line): Changed calls to + kotl-mode:beginning-of-line to kotl-mode:start-of-line to avoid an + XEmacs byte compiler bug in some versions. The bug shows up when + kotl-mode:center-line is called on the first line of a cell and the + cell label is centered along with the line (the label should not + move). + +Tue Mar 4 20:45:52 1997 Bob Weiner <weiner@infodock.com> + +* hsite-ex.el (hpath:find-alist): Modified to use `xv' to display xpm + files; it is more robust than `sxpm' in the face of limited colors. + +Mon Mar 3 12:06:49 1997 Bob Weiner <weiner@infodock.com> + +* hui-menu.el (infodock-hyperbole-menu): Added :config 'Hyperbole + configurator to the menu so users can hide the Hyperbole + menu from the menubar if they don't use it, via menubar-configuration, + under XEmacs and InfoDock. + +Sun Mar 2 22:35:26 1997 Bob Weiner <weiner@infodock.com> + +* kotl/kotl-mode.el (kotl-mode:set-cell-attribute): Changed + read-expression to read-minibuffer since GNU Emacs doesn't + have the former. + +Fri Feb 28 23:31:57 1997 Bob Weiner <weiner@infodock.com> + +* kotl/kprop-xe.el (kproperty:put): Fixed problem with internal handling + of text property protocols within newer versions of XEmacs. The + `text-prop' symbol can no longer be set to `t'. It must be set to + a symbol from the property list of the extent that carries + text-properties. + +============================================================================== +V4.023 changes ^^^^: +============================================================================== + Sat Feb 22 14:30:14 1997 Bob Weiner <weiner@infodock.com> * hypb.el (hypb:ida-logo-keymap): Added conditional for Emacs keybinding.
--- a/lisp/hyperbole/Makefile Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/Makefile Mon Aug 13 08:53:38 2007 +0200 @@ -4,7 +4,7 @@ # AUTHOR: Bob Weiner # # ORIG-DATE: 15-Jun-94 at 03:42:38 -# LAST-MOD: 23-Feb-97 at 23:22:48 by Bob Weiner +# LAST-MOD: 18-Mar-97 at 00:45:58 by Bob Weiner # # This file is part of Hyperbole. # Available for use and distribution under the same terms as GNU Emacs. @@ -98,7 +98,7 @@ # NO CHANGES REQUIRED BELOW HERE. # ########################################################################## -HYPB_VERSION = 4.022 +HYPB_VERSION = 4.023 # Libraries that must be pre-loaded before trying to byte-compile anything. PRELOADS = $(SITE_PRELOADS) -l ./hversion.el -l ./hyperbole.el -l ./hsite.el
--- a/lisp/hyperbole/README Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/README Mon Aug 13 08:53:38 2007 +0200 @@ -11,7 +11,7 @@ # Tel: +1 408-243-3300 # # ORIG-DATE: 19-Oct-91 at 03:27:47 -# LAST-MOD: 23-Feb-97 at 23:25:29 by Bob Weiner +# LAST-MOD: 17-Mar-97 at 21:14:10 by Bob Weiner # # See the Copyright section below for license information. @@ -165,13 +165,16 @@ =========================================================================== -* What's New in V4.02-V4.022 +* What's New in V4.02-V4.023 =========================================================================== (See "ChangeLog" for more complete details of changes.) ACTION AND ASSIST KEYS + - Action Key clicks on HTTP URLs use the Emacs internal web browser + if not running under a window system. + - Support for new ID-edit mode (a part of InfoDock) that allows rapid, cutting, copying and yanking of regions plus fast display management. In this mode, the Action and Assist keys yank the previously selected @@ -231,6 +234,14 @@ ROLODEX + - Date stamps are added to each rolodex entry when created and updated + when edited. This feature can be toggled on and off with: + M-x rolo-toggle-datestamps RET, or via the Toggle-Rolodex-Dates menu + item on the Customization menu. + + - wrolo-add-hook is called after a new entry is added. + wrolo-edit-hook is called after an entry is displayed for editing. + - Rolo-edit, bound to {e} in the rolodex match buffer, now works properly if the rolodex is loaded before the rest of the Hyperbole system.
--- a/lisp/hyperbole/hpath.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/hpath.el Mon Aug 13 08:53:38 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 1-Nov-91 at 00:44:23 -;; LAST-MOD: 16-Feb-97 at 02:34:35 by Bob Weiner +;; LAST-MOD: 9-Mar-97 at 01:38:33 by Bob Weiner ;;; ************************************************************************ ;;; Public variables @@ -552,14 +552,14 @@ 4 = optional username 4 = host and domain to connect to 5 = optional port number to use - 6 = pathname to access." - ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>]/<path> - ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>]<path> + 6 = optional pathname to access." + ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>][/<path>] + ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>][<path>] ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or ;; Windows. (if (looking-at "\\(URL:\\)?\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?") (save-excursion - (goto-char (match-end 6)) + (goto-char (match-end 0)) (skip-chars-backward ".?#!*()") (buffer-substring (match-beginning 2) (point))))) @@ -571,9 +571,9 @@ 3 = optional username 4 = host and domain to connect to 5 = optional port number to use - 6 = pathname to access." - ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>]/<path> - ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>]<path> + 6 = optional pathname to access." + ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>][/<path>] + ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>][<path>] ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or ;; Windows. (and (stringp obj) @@ -590,9 +590,9 @@ (cond ((not include-start-and-end-p) (hpath:url-at-p)) ((hpath:url-at-p) - (list (buffer-substring (match-beginning 2) (match-end 6)) + (list (buffer-substring (match-beginning 2) (match-end 0)) (match-beginning 2) - (match-end 6)))))) + (match-end 0)))))) (defun hpath:www-p (path) "Returns non-nil iff PATH is a world-wide-web link reference."
--- a/lisp/hyperbole/hsite-ex.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/hsite-ex.el Mon Aug 13 08:53:38 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 15-Apr-91 at 00:48:49 -;; LAST-MOD: 17-Feb-97 at 18:34:17 by Bob Weiner +;; LAST-MOD: 8-Mar-97 at 22:52:36 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs.
--- a/lisp/hyperbole/hsys-w3.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/hsys-w3.el Mon Aug 13 08:53:38 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: Motorola Inc. ;; ;; ORIG-DATE: 7-Apr-94 at 17:17:39 by Bob Weiner -;; LAST-MOD: 3-Nov-95 at 23:14:34 by Bob Weiner +;; LAST-MOD: 10-Mar-97 at 12:17:08 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -66,7 +66,9 @@ '(highlight-headers-follow-url-netscape highlight-headers-follow-url-mosaic)) (require 'highlight-headers)) - (funcall action-key-url-function url)) + (if window-system + (funcall action-key-url-function url) + (w3-fetch url))) (defun www-url:help (&optional but) "Displays history list of www nodes previously visited with the W3 browser."
--- a/lisp/hyperbole/hui-em19-b.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/hui-em19-b.el Mon Aug 13 08:53:38 2007 +0200 @@ -6,10 +6,10 @@ ;; KEYWORDS: faces, hypermedia ;; ;; AUTHOR: Bob Weiner -;; ORG: Brown U. +;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 21-Aug-92 -;; LAST-MOD: 24-Oct-95 at 19:54:59 by Bob Weiner +;; LAST-MOD: 26-Feb-97 at 01:58:45 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; It is for use with GNU Emacs V19. @@ -75,7 +75,7 @@ (defun hproperty:but-add (start end face) "Add between START and END a button using FACE in current buffer. -If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that +If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that button is selectable whenever the mouse cursor moves over it." (let ((but (make-overlay start end))) (overlay-put but 'face face) @@ -106,7 +106,7 @@ If REGEXP-MATCH is non-nil, only buttons matching this argument are highlighted. -If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that +If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that button is selectable whenever the mouse cursor moves over it." (interactive) (hproperty:but-clear)
--- a/lisp/hyperbole/hui-menu.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/hui-menu.el Mon Aug 13 08:53:38 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 28-Oct-94 at 10:59:44 -;; LAST-MOD: 19-Feb-97 at 10:50:57 by Bob Weiner +;; LAST-MOD: 14-Mar-97 at 01:35:02 by Bob Weiner ;; ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; @@ -117,6 +117,12 @@ ["Scrolls-Proportionally" (setq smart-scroll-proportional t) :style radio :selected smart-scroll-proportional] + ) + '("----" + ["Toggle-Rolodex-Dates" rolo-toggle-datestamps + :style toggle :selected (and (boundp 'wrolo-add-hook) + (listp wrolo-add-hook) + (memq 'rolo-set-date wrolo-add-hook))] )) "Untitled menu of Hyperbole options.") @@ -126,6 +132,7 @@ (delq nil (list "Hyperbole" + :config 'Hyperbole '["About" (hypb:display-file-with-logo (expand-file-name "ABOUT" hyperb:dir)) t] '["Manual" (id-info "(hyperbole.info)Top") t]
--- a/lisp/hyperbole/hui-mini.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/hui-mini.el Mon Aug 13 08:53:38 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 15-Oct-91 at 20:13:17 -;; LAST-MOD: 6-Mar-97 at 14:08:46 by Bob Weiner +;; LAST-MOD: 17-Mar-97 at 21:28:26 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -99,6 +99,16 @@ "Sets where referents are displayed.") ("Smart-Key-at-Eol/" (menu . cust-eol) "Sets how scrolling via end of line presses works.") + ("Toggle-Rolo-Dates" + (if (and (boundp 'wrolo-add-hook) (listp wrolo-add-hook) + (memq 'rolo-set-date wrolo-add-hook)) + (progn (remove-hook 'wrolo-add-hook 'rolo-set-date) + (remove-hook 'wrolo-edit-hook 'rolo-set-date) + (message "Rolodex date stamps are now turned off.")) + (add-hook 'wrolo-add-hook 'rolo-set-date) + (add-hook 'wrolo-edit-hook 'rolo-set-date) + (message "Rolodex date stamps are now turned on.")) + "Toggle whether date stamps are update when rolodex entries are edited.") ("URL-Display/" (menu . cust-urls) "Sets where URLs are displayed."))) '(cust-eol . (("Smart Key press at eol scrolls>") @@ -326,7 +336,6 @@ (progn (beep) nil) (unwind-protect (progn - (require 'hyperbole) (require 'hsite) ;; Since "hui-mini" may be loaded without loading ;; all of Hyperbole. (hyperb:init-menubar)
--- a/lisp/hyperbole/hui-xe-but.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/hui-xe-but.el Mon Aug 13 08:53:38 2007 +0200 @@ -6,10 +6,10 @@ ;; KEYWORDS: faces, hypermedia ;; ;; AUTHOR: Bob Weiner -;; ORG: Brown U. +;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 21-Aug-92 -;; LAST-MOD: 24-Oct-95 at 19:55:08 by Bob Weiner +;; LAST-MOD: 26-Feb-97 at 01:58:01 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; It is for use with XEmacs, a modified version of GNU Emacs V19. @@ -69,7 +69,7 @@ (defun hproperty:but-add (start end face) "Add between START and END a button using FACE in current buffer. -If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that +If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that button is selectable whenever the mouse cursor moves over it." (let ((but (make-extent start end))) (set-extent-face but face) @@ -96,7 +96,7 @@ If REGEXP-MATCH is non-nil, only buttons matching this argument are highlighted. -If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that +If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that button is selectable whenever the mouse cursor moves over it." (interactive) (hproperty:but-clear)
--- a/lisp/hyperbole/hversion.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/hversion.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,6 +1,6 @@ ;;!emacs ;; -;; LCD-ENTRY: hyperbole|Bob Weiner|hyperbole@infodock.com|Everyday Info Manager|23-Feb-97|4.022|ftp://ftp.xemacs.org/pub/infodock +;; LCD-ENTRY: hyperbole|Bob Weiner|hyperbole@infodock.com|Everyday Info Manager|17-Mar-97|4.023|ftp://ftp.xemacs.org/pub/infodock ;; ;; FILE: hversion.el ;; SUMMARY: Hyperbole version, system and load path information. @@ -11,7 +11,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 1-Jan-94 -;; LAST-MOD: 23-Feb-97 at 23:22:37 by Bob Weiner +;; LAST-MOD: 17-Mar-97 at 21:08:15 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -26,7 +26,7 @@ ;;; Public variables ;;; ************************************************************************ -(defconst hyperb:version "04.022" "Hyperbole revision number.") +(defconst hyperb:version "04.023" "Hyperbole revision number.") ;;; Support button highlighting and flashing under XEmacs. ;;;
--- a/lisp/hyperbole/hyperbole.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/hyperbole.el Mon Aug 13 08:53:38 2007 +0200 @@ -11,7 +11,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 6-Oct-92 at 11:52:51 -;; LAST-MOD: 19-Feb-97 at 10:57:44 by Bob Weiner +;; LAST-MOD: 15-Mar-97 at 17:09:40 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -118,7 +118,7 @@ ;;; Provides a site standard way to easily switch between the Hyperbole mouse ;;; bindings and a set of personal mouse bindings. You may instead show -;;; users how to bind this to a key via 'hyperb:init-hook' (see +;;; users how to bind this to a key via `hyperb:init-hook' (see ;;; Hyperbole Manual). ;;; (or (global-key-binding "\C-ct") @@ -130,7 +130,7 @@ (interactive "P") (if arg (assist-key) (action-key))) -;;; A value of t for 'hkey-init' below will cause the Hyperbole +;;; A value of t for `hkey-init' below will cause the Hyperbole ;;; context-sensitive keys to be bound to keyboard keys, in addition to any ;;; mouse key bindings. Comment it out or set it to nil if you don't want ;;; these bindings. Or change the bindings in the succeeding lines. @@ -407,16 +407,17 @@ ) ;;; Hyperbole rolodex main entry points. -(autoload 'rolo-add "wrolo" "Add an entry to rolodex" t) -(autoload 'rolo-display-matches "wrolo" "Redisplay previous rolodex matches" t) -(autoload 'rolo-edit "wrolo" "Edit an existing rolodex entry" t) -(autoload 'rolo-fgrep "wrolo" "Rolodex string search" t) -(autoload 'rolo-grep "wrolo" "Rolodex regexp search" t) -(autoload 'rolo-kill "wrolo" "Delete an existing rolodex entry" t) -(autoload 'rolo-logic "wrolo-logic" "Logical rolodex search filters." t) -(autoload 'rolo-sort "wrolo" "Sort rolodex entries" t) -(autoload 'rolo-word "wrolo" "Rolodex string search for a word" t) -(autoload 'rolo-yank "wrolo" "Insert a rolodex entry into current buffer" t) +(autoload 'rolo-add "wrolo" "Add an entry to rolodex" t) +(autoload 'rolo-display-matches "wrolo" "Redisplay previous rolodex matches" t) +(autoload 'rolo-edit "wrolo" "Edit an existing rolodex entry" t) +(autoload 'rolo-fgrep "wrolo" "Rolodex string search" t) +(autoload 'rolo-grep "wrolo" "Rolodex regexp search" t) +(autoload 'rolo-kill "wrolo" "Delete an existing rolodex entry" t) +(autoload 'rolo-logic "wrolo-logic" "Logical rolodex search filters." t) +(autoload 'rolo-sort "wrolo" "Sort rolodex entries" t) +(autoload 'rolo-toggle-datestamps "wrolo" "Toggle datestamp insertion." t) +(autoload 'rolo-word "wrolo" "Rolodex string search for a word" t) +(autoload 'rolo-yank "wrolo" "Insert a rolodex entry into current buffer" t) ;;; Hyperbole Key autoloads. (autoload 'Info-handle-in-note "hmous-info" @@ -485,14 +486,14 @@ ;;; ;;; Hyperbole mail composer support configuration. ;;; -(var:append 'mail-mode-hook '((lambda () (require 'hsmail)))) -(var:append 'mh-letter-mode-hook '((lambda () (require 'hsmail)))) -(var:append 'vm-mail-mode-hook '((lambda () (require 'hsmail)))) +(var:append 'mail-mode-hook (list (function (lambda () (require 'hsmail))))) +(var:append 'mh-letter-mode-hook (list (function (lambda () (require 'hsmail))))) +(var:append 'vm-mail-mode-hook (list (function (lambda () (require 'hsmail))))) ;;; ************************************************************************ ;;; Frame function aliases. ;;; ************************************************************************ -;; Create all needed 'frame-' aliases for all 'screen-' functions, e.g. +;; Create all needed `frame-' aliases for all `screen-' functions, e.g. ;; screen-width. (if (fboundp 'selected-frame) nil
--- a/lisp/hyperbole/kotl/kfile.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/kotl/kfile.el Mon Aug 13 08:53:38 2007 +0200 @@ -8,7 +8,8 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 10/31/93 -;; LAST-MOD: 1-Nov-95 at 00:46:41 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:17:51 by Bob Weiner + ;;; ************************************************************************ ;;; Other required Elisp libraries ;;; ************************************************************************ @@ -152,13 +153,13 @@ Return the new view." (let (ver-string) (cond ((not (bufferp buffer)) - (error "(kfile:read): Argument must be a buffer, '%s'." buffer)) + (error "(kfile:read): Argument must be a buffer, `%s'." buffer)) ((not existing-file-p) (kfile:create buffer)) ((progn (set-buffer buffer) (not (setq ver-string (kfile:is-p)))) - (error "(kfile:read): '%s' is not a koutline file." buffer)) + (error "(kfile:read): `%s' is not a koutline file." buffer)) ((equal ver-string "Kotl-4.0") (kfile:read-v4-or-v3 buffer nil)) ((equal ver-string "Kotl-3.0") @@ -167,7 +168,7 @@ (kfile:read-v2 buffer)) ((equal ver-string "Kotl-1.0") (error "(kfile:read): V1 koutlines are no longer supported")) - (t (error "(kfile:read): '%s' has unknown kotl version, %s." + (t (error "(kfile:read): `%s' has unknown kotl version, %s." buffer ver-string))))) (defun kfile:read-v2 (buffer) @@ -323,7 +324,7 @@ (set-marker opoint nil) nil))) -;;; Next function is adapted from 'file-write' of GNU Emacs 19, copyright FSF, +;;; Next function is adapted from `file-write' of GNU Emacs 19, copyright FSF, ;;; under the GPL. (defun kfile:write (file) "Write current outline to FILE." @@ -529,6 +530,6 @@ ;;; ************************************************************************ (defvar kfile:escape-newlines t - "Value of print-escape-newlines used by 'kfile:print-to-string' function.") + "Value of print-escape-newlines used by `kfile:print-to-string' function.") (provide 'kfile)
--- a/lisp/hyperbole/kotl/kfill.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/kotl/kfill.el Mon Aug 13 08:53:38 2007 +0200 @@ -7,7 +7,8 @@ ;; ;; AUTHOR: Bob Weiner ;; ORIG-DATE: 23-Jan-94 -;; LAST-MOD: 15-Jan-97 at 11:54:12 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:18:10 by Bob Weiner + ;;; ************************************************************************ ;;; Public variables ;;; ************************************************************************ @@ -103,7 +104,7 @@ (kfill:fill-paragraph arg skip-prefix-remove)))) ;;; -;;; Redefine this function so that it sets 'fill-prefix-prev' also. +;;; Redefine this function so that it sets `fill-prefix-prev' also. ;;; (defun set-fill-prefix (&optional turn-off) "Set the fill-prefix to the current line up to point.
--- a/lisp/hyperbole/kotl/kimport.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/kotl/kimport.el Mon Aug 13 08:53:38 2007 +0200 @@ -8,7 +8,8 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 15-Nov-93 at 11:57:05 -;; LAST-MOD: 1-Nov-95 at 23:19:09 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:18:33 by Bob Weiner + ;;; ************************************************************************ ;;; Other required Elisp libraries ;;; ************************************************************************ @@ -133,7 +134,7 @@ (message "Imported %d of %d Augment statements." count total))) ;;; -;;; Emacs outliner style files, leading '*' cell delimiters +;;; Emacs outliner style files, leading `*' cell delimiters ;;; ;;;###autoload @@ -213,7 +214,7 @@ Text paragraphs are imported as a sequence of same level cells. Koutlines are imported with their structure intact. -The variable, 'paragraph-start,' is used to determine paragraphs." +The variable, `paragraph-start,' is used to determine paragraphs." (interactive "FImport from text/koutline buffer/file: \nFInsert cells into koutline buffer/file: \nP") (let ((klabel "1") (output-level 1) (count 0) initially-empty-output no-renumber orig-point total) @@ -540,7 +541,7 @@ the total number of paragraphs in IMPORT-FROM, used to show a running tally of the imported paragraphs. -The variable, 'paragraph-start' is used to determine paragraphs." +The variable, `paragraph-start' is used to determine paragraphs." (set-buffer import-from) (let* ((count 0) start end contents) ;; Next line is needed when importing into an existing kview.
--- a/lisp/hyperbole/kotl/klabel.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/kotl/klabel.el Mon Aug 13 08:53:38 2007 +0200 @@ -8,7 +8,8 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 17-Apr-94 -;; LAST-MOD: 1-Nov-95 at 02:33:23 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:19:02 by Bob Weiner + ;;; ************************************************************************ ;;; Public variables ;;; ************************************************************************ @@ -47,7 +48,7 @@ ((eq label-type 'partial-alpha) (error "(klabel:level): Can't compute the level of a partial-alpha label")) - (t (error "(klabel:level): Invalid label type setting: '%s'" + (t (error "(klabel:level): Invalid label type setting: `%s'" label-type))))) (defun klabel:parent (label) @@ -69,7 +70,7 @@ (error "(klabel:child-id): Can't compute child of idstamp label")))) (t (error - "(klabel-type:child): Invalid label type setting: '%s'" + "(klabel-type:child): Invalid label type setting: `%s'" label-type)))) (defun klabel-type:increment (label-type) @@ -96,7 +97,7 @@ (error "(klabel:increment-no): 0 cell cannot have a sibling") (error "(klabel:increment-id): Can't compute sibling of idstamp label"))))) (t (error - "(klabel:increment): Invalid label type setting: '%s'" + "(klabel:increment): Invalid label type setting: `%s'" label-type)))) (defun klabel-type:parent (label-type) @@ -127,7 +128,7 @@ (error "(klabel:parent-id): Can't compute parent of idstamp label")))) (t (error - "(klabel-type:parent): Invalid label type setting: '%s'" + "(klabel-type:parent): Invalid label type setting: `%s'" label-type)))) ;;; @@ -211,7 +212,7 @@ (concat (substring label 0 (match-beginning 0)) (int-to-string (1+ (string-to-int (substring label (match-beginning 0))))))) - (t (error "(klabel:increment-legal): Invalid label, '%s'" label)))) + (t (error "(klabel:increment-legal): Invalid label, `%s'" label)))) (defun klabel:level-legal (label) "Return outline level as an integer of legal-style LABEL. @@ -243,10 +244,10 @@ ;; It must be one of the following symbols: ;; no for no labels, ;; id for permanent idstamp labels, e.g. 001, 002, etc. -;; alpha for '1a2' full alphanumeric labels -;; legal for '1.1.2' labels -;; partial-alpha for partial alphanumeric labels, e.g. '2' for node '1a2' -;; star for multi-star labeling, e.g. '***'. +;; alpha for `1a2' full alphanumeric labels +;; legal for `1.1.2' labels +;; partial-alpha for partial alphanumeric labels, e.g. `2' for node `1a2' +;; star for multi-star labeling, e.g. `***'. ;; ;; Functions to compute sibling and child labels for particular label types. @@ -352,7 +353,7 @@ (if (re-search-backward "\\(\\`\\|[\n\r][\n\r]\\)[ \t]*0[0-9]+" nil t) (goto-char (match-end 0))))))))) - (error "(kview:to-label-end): Invalid label type: '%s'" label-type))) + (error "(kview:to-label-end): Invalid label type: `%s'" label-type))) (defun klabel-type:star-label (prev-label &optional child-p) "Return full star label, e.g. ***, for cell following PREV-LABEL's cell. @@ -379,7 +380,7 @@ ((eq label-type 'no) "") ((eq label-type 'star) "*") (t (error - "(klabel-type:set-labels): Invalid label type: '%s'" + "(klabel-type:set-labels): Invalid label type: `%s'" label-type)))) (let ((klabel-type:changing-flag t)) (klabel-type:update-labels-from-point label-type first-label))))) @@ -603,7 +604,7 @@ is signaled." (if (not (kotl-label:is-p label)) (error - "(kotl-label:increment): First arg, '%s', must be a kotl-label." + "(kotl-label:increment): First arg, `%s', must be a kotl-label." label)) (let ((int-p) (val 0)) (if (or (setq int-p (kotl-label:integer-p label)) @@ -613,13 +614,13 @@ (progn (setq int-p (string-to-int label)) (if (> (setq val (+ int-p n)) 0) (kotl-label:create val) - (error "(kotl-label:increment): Decrement of '%s' by '%d' is less than 1." label n))) + (error "(kotl-label:increment): Decrement of `%s' by `%d' is less than 1." label n))) ;; alpha-p (if (<= 0 (setq val (+ n (kotl-label:alpha-to-int label)))) (kotl-label:create (kotl-label:int-to-alpha val)) - (error "(kotl-label:increment): Decrement of '%s' by '%d' is illegal." label n))) - (error "(kotl-label:increment): label, '%s', must be all digits or alpha characters" label)))) + (error "(kotl-label:increment): Decrement of `%s' by `%d' is illegal." label n))) + (error "(kotl-label:increment): label, `%s', must be all digits or alpha characters" label)))) (defun kotl-label:increment-alpha (label) "Return alphabetic LABEL incremented by 1. @@ -694,7 +695,7 @@ For example, the full label \"1a2\" has kotl-label \"2\", as does \"1.1.2\"." (if (string-match "[0-9]+$\\|[a-zA-Z]+$" label) (substring label (match-beginning 0)) - (error "(klabel:to-kotl-label): Invalid label, '%s'" label))) + (error "(klabel:to-kotl-label): Invalid label, `%s'" label))) (defun klabel-type:update-labels-from-point (label-type first-label) (let ((label-sep-len (kview:label-separator-length kview)))
--- a/lisp/hyperbole/kotl/klink.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/kotl/klink.el Mon Aug 13 08:53:38 2007 +0200 @@ -8,7 +8,7 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 15-Nov-93 at 12:15:16 -;; LAST-MOD: 6-Jan-97 at 19:00:58 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:19:19 by Bob Weiner ;; ;; DESCRIPTION: ;; @@ -65,7 +65,7 @@ (defun klink:create (reference) "Insert at point an implicit link to REFERENCE. REFERENCE should be a cell-ref or a string containing \"filename, cell-ref\". -See documentation for 'kcell:ref-to-id' for valid cell-ref formats." +See documentation for `kcell:ref-to-id' for valid cell-ref formats." (interactive ;; Don't change the name or delete default-dir used here. It is referenced ;; in "hargs.el" for argument getting. @@ -98,7 +98,7 @@ (if cell-ref (insert ", " cell-ref)) (insert ">")) (cell-ref (insert "<@ " cell-ref ">")) - (t (error "(klink:create) Invalid reference, '%s'" reference))))) + (t (error "(klink:create) Invalid reference, `%s'" reference))))) (defun klink:at-p () "Return non-nil iff point is within a klink. @@ -161,7 +161,7 @@ < [-!&] pathname > < @ cell-ref > -See documentation for 'kcell:ref-to-id' for valid cell-ref formats." +See documentation for `kcell:ref-to-id' for valid cell-ref formats." (interactive "sKotl link specifier: ") (or (stringp link) (error "(link-to-kotl): Non-string link argument, %s" @@ -216,7 +216,7 @@ |viewspec :augment-viewspec (ignored for now) -See documentation for 'kcell:ref-to-id' for valid cell-ref formats." +See documentation for `kcell:ref-to-id' for valid cell-ref formats." (or (stringp reference) (error "(klink:parse): Non-string reference argument, %s"
--- a/lisp/hyperbole/kotl/kmenu.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/kotl/kmenu.el Mon Aug 13 08:53:38 2007 +0200 @@ -6,12 +6,11 @@ ;; KEYWORDS: mouse, outlines, wp ;; ;; AUTHOR: Bob Weiner -;; ORG: Motorola, Inc., PPG ;; ;; ORIG-DATE: 28-Mar-94 at 11:22:09 -;; LAST-MOD: 22-Oct-96 at 01:30:50 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:20:03 by Bob Weiner ;; -;; Copyright (C) 1994-1995 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc. ;; ;; This file is part of Hyperbole. ;;
--- a/lisp/hyperbole/kotl/kotl-mode.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/kotl/kotl-mode.el Mon Aug 13 08:53:38 2007 +0200 @@ -8,7 +8,7 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 6/30/93 -;; LAST-MOD: 5-Dec-96 at 18:55:22 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:15:42 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -157,7 +157,7 @@ (opoint (point-marker)) (bocp) start) - (setq start (kotl-mode:beginning-of-line)) + (setq start (kotl-mode:start-of-line)) (if (setq bocp (kotl-mode:bocp)) (progn ;; Add a temporary fill-prefix since this is the 1st line of the cell @@ -522,7 +522,7 @@ ((and (markerp val) (marker-position val)) (princ (marker-position val) (current-buffer))) (t - (error "Register '%c' does not contain text" register)))) + (error "Register `%c' does not contain text" register)))) (if (not arg) (exchange-point-and-mark))) (defun kotl-mode:just-one-space () @@ -1296,7 +1296,7 @@ (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. (or arg (setq arg 1)) (or (integer-or-marker-p arg) - (error "(kotl-mode:beginning-of-cell): Wrong type arg, integer-or-marker, '%s'" arg)) + (error "(kotl-mode:beginning-of-cell): Wrong type arg, integer-or-marker, `%s'" arg)) (if (= arg 1) (goto-char (kcell-view:start)) (kotl-mode:backward-cell (1- arg))) @@ -1311,7 +1311,7 @@ (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. (or arg (setq arg 1)) (or (integer-or-marker-p arg) - (error "(kotl-mode:start-of-line): Wrong type arg, integer-or-marker, '%s'" arg)) + (error "(kotl-mode:start-of-line): Wrong type arg, integer-or-marker, `%s'" arg)) (forward-line (1- arg)) (if (eolp) nil @@ -1319,7 +1319,9 @@ (beginning-of-line)))) (point)) -(defalias 'kotl-mode:beginning-of-line 'kotl-mode:start-of-line) +;;; This ensures that the key bound to `beginning-of-line' is replaced in +;;; kotl-mode. +(fset 'kotl-mode:beginning-of-line 'kotl-mode:start-of-line) (defun kotl-mode:beginning-of-tree () "Move point to the level 1 root of the current cell's tree. @@ -1369,7 +1371,7 @@ (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. (or arg (setq arg 1)) (or (integer-or-marker-p arg) - (error "(kotl-mode:end-of-cell): Wrong type arg, integer-or-marker, '%s'" arg)) + (error "(kotl-mode:end-of-cell): Wrong type arg, integer-or-marker, `%s'" arg)) (if (= arg 1) (goto-char (kcell-view:end-contents)) (kotl-mode:forward-cell (1- arg))) @@ -1384,7 +1386,7 @@ (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. (or arg (setq arg 1)) (or (integer-or-marker-p arg) - (error "(kotl-mode:finish-of-line): Wrong type arg, integer-or-marker, '%s'" arg)) + (error "(kotl-mode:finish-of-line): Wrong type arg, integer-or-marker, `%s'" arg)) (forward-line (1- arg)) (end-of-line) ;; May have to move backwards to before label if support labels @@ -1540,7 +1542,7 @@ (point)) (defun kotl-mode:goto-cell (cell-ref &optional error-p) - "Move point to start of cell given by CELL-REF. (See 'kcell:ref-to-id'.) + "Move point to start of cell given by CELL-REF. (See `kcell:ref-to-id'.) Return point iff CELL-REF is found within current view. With a prefix argument, CELL-REF is assigned the argument value for use as an idstamp. @@ -1554,7 +1556,7 @@ (read-string "Goto cell label or id: ")))) (setq cell-ref (or (kcell:ref-to-id cell-ref) - (error "(kotl-mode:goto-cell): Invalid cell reference, '%s'" cell-ref))) + (error "(kotl-mode:goto-cell): Invalid cell reference, `%s'" cell-ref))) (let* ((opoint (point)) (found) cell-id kvspec) @@ -1589,7 +1591,7 @@ (t (goto-char opoint) nil)) (if (and (not found) (or error-p (interactive-p))) - (error "(kotl-mode:goto-cell): No '%s' cell in this view" cell-ref) + (error "(kotl-mode:goto-cell): No `%s' cell in this view" cell-ref) ;; Activate any viewspec associated with cell-ref. (if kvspec (kvspec:activate kvspec)))) found)) @@ -2249,10 +2251,10 @@ (setq attribute (intern attribute) value (kcell-view:get-attr attribute)) (if value - (setq value (read-expression + (setq value (read-minibuffer (format "Change value of \"%s\" to: " attribute) (prin1-to-string value))) - (setq value (read-expression + (setq value (read-minibuffer (format "Set value of \"%s\" to: " attribute)))) (list attribute value nil))) (kcell-view:set-attr attribute value pos) @@ -2558,7 +2560,7 @@ (prog1 (buffer-substring bol eol) (delete-region bol eol))) - (error "(kotl-mode:delete-line): Invalid position, '%d'" (point))))) + (error "(kotl-mode:delete-line): Invalid position, `%d'" (point))))) (defun kotl-mode:indent-line (arg) ;; Disallow the indent-line command. @@ -2619,7 +2621,7 @@ (defun kotl-mode:print-attributes (kview) "Print to the `standard-output' stream the attributes of the current visible kcell. -Takes argument KVIEW (so it can be used with 'kview:map-tree' and so that +Takes argument KVIEW (so it can be used with `kview:map-tree' and so that KVIEW is bound correctly) but always operates upon the current view." ;; Move to start of visible cell to avoid printing attributes for an ;; invisible kcell which point may be over.
--- a/lisp/hyperbole/kotl/kview.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/kotl/kview.el Mon Aug 13 08:53:38 2007 +0200 @@ -8,7 +8,8 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 6/30/93 -;; LAST-MOD: 2-Nov-95 at 00:52:52 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:16:42 by Bob Weiner + ;;; ************************************************************************ ;;; Other required Lisp Libraries ;;; ************************************************************************ @@ -43,10 +44,10 @@ It must be one of the following symbols: no for no labels id for permanent idstamp labels, e.g. 001, 002, etc. - alpha for '1a2' full alphanumeric labels - legal for '1.1.2' labels - partial-alpha for partial alphanumeric labels, e.g. '2' for node '1a2' - star for multi-star labeling, e.g. '***'.") + alpha for `1a2' full alphanumeric labels + legal for `1.1.2' labels + partial-alpha for partial alphanumeric labels, e.g. `2' for node `1a2' + star for multi-star labeling, e.g. `***'.") (defvar kview:default-level-indent 3 "*Default number of spaces to indent each succeeding level in koutlines.") @@ -294,9 +295,9 @@ (if pos (goto-char pos)) (if (kview:valid-position-p) (buffer-substring - (kotl-mode:beginning-of-line) + (kotl-mode:start-of-line) (kotl-mode:end-of-line)) - (error "(kcell-view:line): Invalid position, '%d'" (point))))) + (error "(kcell-view:line): Invalid position, `%d'" (point))))) (defun kcell-view:next (&optional visible-p label-sep-len) "Move to start of next cell within current view. @@ -402,7 +403,7 @@ (defun kcell-view:reference (&optional pos relative-dir) "Return a reference to the kcell at optional POS or point for use in a link. The reference is a string of the form, \"<kcell-file, cell-ref>\" where -cell-ref is as described in the documentation for 'kcell:ref-to-id'. +cell-ref is as described in the documentation for `kcell:ref-to-id'. Kcell-file is made relative to optional RELATIVE-DIR before it is returned." (format "<%s, %s=%s>" (hpath:relative-to buffer-file-name relative-dir) (kcell-view:label pos) (kcell-view:idstamp pos))) @@ -473,21 +474,21 @@ BLANK-LINES, LEVELS-TO-SHOW, and LINES-TO-SHOW may also be given, otherwise default values are used. See documentation of: - 'kview:default-label-type' for LABEL-TYPE, - 'kview:default-level-indent' for LEVEL-INDENT, - 'kview:default-label-separator' for LABEL-SEPARATOR, - 'kview:default-label-min-width' for LABEL-MIN-WIDTH, - 'kview:default-blank-lines' for BLANK-LINES, - 'kview:default-levels-to-show' for LEVELS-TO-SHOW, - 'kview:default-lines-to-show' for LINES-TO-SHOW." + `kview:default-label-type' for LABEL-TYPE, + `kview:default-level-indent' for LEVEL-INDENT, + `kview:default-label-separator' for LABEL-SEPARATOR, + `kview:default-label-min-width' for LABEL-MIN-WIDTH, + `kview:default-blank-lines' for BLANK-LINES, + `kview:default-levels-to-show' for LEVELS-TO-SHOW, + `kview:default-lines-to-show' for LINES-TO-SHOW." (let ((buf (get-buffer buffer-name))) (cond ((null buf) - (error "(kview:create): No such buffer, '%s'." buffer-name)) + (error "(kview:create): No such buffer, `%s'." buffer-name)) ((or (null id-counter) (= id-counter 0)) (setq id-counter 0)) ((not (integerp id-counter)) - (error "(kview:create): 2nd arg, '%s', must be an integer." id-counter))) + (error "(kview:create): 2nd arg, `%s', must be an integer." id-counter))) (set-buffer buf) (if (and (boundp 'kview) (eq (kview:buffer kview) buf)) ;; Don't recreate view if it exists. @@ -731,7 +732,7 @@ FUNC is called so that it may test against this value. `Label-sep-len' contains the label separator length. -See also 'kview:map-siblings' and 'kview:map-tree'." +See also `kview:map-siblings' and `kview:map-tree'." (save-excursion (set-buffer (kview:buffer kview)) (let ((results) @@ -760,7 +761,7 @@ FUNC is called so that it may test against this value. `Label-sep-len' contains the label separator length. -See also 'kview:map-branch' and 'kview:map-tree'." +See also `kview:map-branch' and `kview:map-tree'." (save-excursion (set-buffer (kview:buffer kview)) (let ((results) @@ -787,7 +788,7 @@ FUNC is called so that it may test against this value. `Label-sep-len' contains the label separator length. -See also 'kview:map-branch' and 'kview:map-siblings'." +See also `kview:map-branch' and `kview:map-siblings'." (let ((results) (label-sep-len (kview:label-separator-length kview))) (save-excursion @@ -924,7 +925,7 @@ label-type (intern new-type-str))))) (if (not (memq new-type '(alpha legal id no partial-alpha star))) - (error "(kview:set-label-type): Invalid label type, '%s'." new-type)) + (error "(kview:set-label-type): Invalid label type, `%s'." new-type)) ;; Disable use of partial-alpha for now since it is broken. (if (eq new-type 'partial-alpha) (error "(kview:set-label-type): Partial-alpha labels don't work, choose another type")) @@ -948,9 +949,9 @@ (>= (current-column) (kcell-view:indent))) ((not (integer-or-marker-p pos)) (error "(kview:valid-position-p): Argument POS not an integer -or marker, '%s'" pos)) +or marker, `%s'" pos)) ((or (< pos (point-min)) (> pos (point-max))) - (error "(kview:valid-position-p): Invalid POS argument, '%d'" + (error "(kview:valid-position-p): Invalid POS argument, `%d'" pos)) (t (save-excursion (goto-char pos)
--- a/lisp/hyperbole/kotl/kvspec.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/kotl/kvspec.el Mon Aug 13 08:53:38 2007 +0200 @@ -8,7 +8,7 @@ ;; AUTHOR: Bob Weiner ;; ;; ORIG-DATE: 21-Oct-95 at 15:17:07 -;; LAST-MOD: 4-Dec-96 at 15:36:12 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:17:04 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -122,7 +122,7 @@ "Show NUM lines per cell." (if (and (integerp num) (>= num 0)) nil - (error "(kvspec:show-lines-per-cell): Invalid lines per cell, '%d'" num)) + (error "(kvspec:show-lines-per-cell): Invalid lines per cell, `%d'" num)) (kview:set-attr kview 'lines-to-show num) (let (start end count) (if (zerop num) @@ -181,7 +181,7 @@ ;;; ************************************************************************ (defun kvspec:blank-lines () - "Turn blank lines on or off according to 'kvspec:current'." + "Turn blank lines on or off according to `kvspec:current'." (let ((modified-p (buffer-modified-p)) (buffer-read-only)) (if (string-match "b" kvspec:current) @@ -234,12 +234,12 @@ kvspec:label-type-alist))))))))) (defun kvspec:elide () - "Turn ellipses display following clipped cells on or off according to 'kvspec:current'." + "Turn ellipses display following clipped cells on or off according to `kvspec:current'." (setq selective-display-ellipses (if (string-match "e" kvspec:current) t))) (defun kvspec:hide-levels () - "Show a set number of cell levels according to 'kvspec:current'." + "Show a set number of cell levels according to `kvspec:current'." ;; "l" means use value of kview:default-levels-to-show. ;; "l0" means show all levels. (let (levels) @@ -256,7 +256,7 @@ (kvspec:levels-to-show levels)))) (defun kvspec:lines-to-show () - "Show a set number of lines per cell according to 'kvspec:current'." + "Show a set number of lines per cell according to `kvspec:current'." ;; "c" means use value of kview:default-lines-to-show. ;; "c0" means show all lines. (cond ((not (string-match "c\\([0-9]+\\)?" kvspec:current)) @@ -270,7 +270,7 @@ (t (kvspec:show-lines-per-cell kview:default-lines-to-show)))) (defun kvspec:numbering () - "Set the type of numbering (label) display according to 'kvspec:current'." + "Set the type of numbering (label) display according to `kvspec:current'." (if (not (string-match "n\\([.*~0-2]\\)?" kvspec:current)) nil ;; "n" means use value of kview:default-label-type. @@ -315,7 +315,7 @@ (setq mf (cdr mf))))))))) (defun kvspec:update-view () - "Update view according to current setting of local 'kvspec:current' variable." + "Update view according to current setting of local `kvspec:current' variable." (let ((modified-p (buffer-modified-p)) (buffer-read-only)) (save-excursion @@ -374,7 +374,7 @@ (defvar kvspec:string-format " <|%s>" "Format of the kview spec modeline display. -It must contain a '%s' which is replaced with the current set of view spec +It must contain a `%s' which is replaced with the current set of view spec characters at run-time.") (provide 'kvspec)
--- a/lisp/hyperbole/wrolo.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/hyperbole/wrolo.el Mon Aug 13 08:53:38 2007 +0200 @@ -15,13 +15,12 @@ ;; Tel: +1 408-243-3300 ;; ;; ORIG-DATE: 7-Jun-89 at 22:08:29 -;; LAST-MOD: 17-Feb-97 at 15:32:20 by Bob Weiner +;; LAST-MOD: 14-Mar-97 at 01:32:23 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. ;; -;; Copyright (C) 1989, '90, '91, '92, '95 Free Software Foundation, Inc. -;; Copyright (C) 1996 InfoDock Associates +;; Copyright (C) 1989, '90, '91, '92, '95, '96, '97 Free Software Foundation, Inc. ;; ;; DESCRIPTION: ;; @@ -63,7 +62,7 @@ ;; ;; SETUP: ;; -;; The variable 'rolo-file-list' is a list of files to search for +;; The variable `rolo-file-list' is a list of files to search for ;; matching rolodex entries. To add personal files to rolo-file-list, ;; when you find these functions are useful for any sort of list lookup, ;; add the following to your ~/.emacs file (substituting where you see @@ -71,9 +70,9 @@ ;; ;; (setq rolo-file-list (append rolo-file-list '("<file1>" "<file2>"))) ;; -;; We recommend that entries in 'rolo-file-list' have ".otl" suffixes +;; We recommend that entries in `rolo-file-list' have ".otl" suffixes ;; so that they do not conflict with file names that other rolodex -;; programs might use and so that they are edited in 'outline-mode' by +;; programs might use and so that they are edited in `outline-mode' by ;; default. If you want the latter behavior, uncomment and add something ;; like the following to one of your GNU Emacs initialization files: ;; @@ -98,7 +97,7 @@ ;; message, the rolodex add function will extract the sender's name ;; and e-mail address and prompt you with the name as a default. If ;; you accept it, it will enter the name and the email address using -;; the format given by the 'rolo-email-format' variable. See its +;; the format given by the `rolo-email-format' variable. See its ;; documentation if you want to change its value. ;; ;; @@ -139,8 +138,8 @@ ;; parent/child to locate a child entry below a parent entry, e.g. ;; from the example near the top, we could give Company/Manager/Underlings. ;; -;; Here is a snippet from our group rolodex file. The ';'s should be -;; removed of course and the '*'s should begin at the start of the +;; Here is a snippet from our group rolodex file. The `;'s should be +;; removed of course and the `*'s should begin at the start of the ;; line. If a rolodex file begins with two separator lines whose ;; first three characters are "===", then these lines and any text ;; between them are prepended to the output buffer whenever any @@ -160,43 +159,43 @@ ;; FOR PROGRAMMERS: ;; ;; Entries in rolodex files are separated by patterns matching -;; 'rolo-entry-regexp'. Each entry may have any number of sub-entries +;; `rolo-entry-regexp'. Each entry may have any number of sub-entries ;; which represent the next level down in the entry hierarchy. ;; Sub-entries' separator patterns are always longer than their parents'. -;; For example, if an entry began with '*' then its sub-entries would begin -;; with '**' and so on. Blank lines in rolodex files will not end up where +;; For example, if an entry began with `*' then its sub-entries would begin +;; with `**' and so on. Blank lines in rolodex files will not end up where ;; you want them if you use the rolo-sort commands; therefore, blank lines ;; are not recommended. If you change the value of -;; 'rolo-entry-regexp', you will have to modify 'rolo-sort'. +;; `rolo-entry-regexp', you will have to modify `rolo-sort'. ;; ;; The following additional functions are provided: ;; -;; 'rolo-sort-level' sorts a specific level of entries in a rolodex file; -;; 'rolo-map-level' runs a user specified function on a specific level of +;; `rolo-sort-level' sorts a specific level of entries in a rolodex file; +;; `rolo-map-level' runs a user specified function on a specific level of ;; entries in a rolodex file; -;; 'rolo-fgrep-file', same as 'rolo-fgrep' but operates on a single file; -;; 'rolo-grep-file', same as 'rolo-grep' but operates on a single file; -;; 'rolo-display-matches', display last set of rolodex matches, if any; -;; 'rolo-toggle-narrow-to-entry' toggles between display of current entry +;; `rolo-fgrep-file', same as `rolo-fgrep' but operates on a single file; +;; `rolo-grep-file', same as `rolo-grep' but operates on a single file; +;; `rolo-display-matches', display last set of rolodex matches, if any; +;; `rolo-toggle-narrow-to-entry' toggles between display of current entry ;; and display of all matching entries. ;; ;; ;; MOD HISTORY: ;; ;; 12/17/89 -;; Added internal 'rolo-shrink-window' function for use in +;; Added internal `rolo-shrink-window' function for use in ;; compressing/uncompressing the rolo view window to/from a size just ;; large enough for the selected entry. This is useful when a search ;; turns up more entries than desired. ;; ;; 02/21/90 -;; Modified 'rolo-grep-file' and 'rolo-map-level' so they only set buffers +;; Modified `rolo-grep-file' and `rolo-map-level' so they only set buffers ;; read-only the first time they are read in. This way, if someone edits a ;; rolodex file and then does a rolo-fgrep or other function, the buffer ;; will not be back in read-only mode. ;; ;; 04/18/91 -;; Modified 'rolo-grep-file' to expand any hidden entries in rolo file +;; Modified `rolo-grep-file' to expand any hidden entries in rolo file ;; before doing a search. ;; ;; 12/24/91 @@ -261,6 +260,10 @@ (defvar rolo-save-buffers-after-use t "*Non-nil means save rolodex file after an entry is killed.") +;; Insert or update the entry date each time an entry is added or edited. +(add-hook 'wrolo-add-hook 'rolo-set-date) +(add-hook 'wrolo-edit-hook 'rolo-set-date) + (defvar wrolo-yank-reformat-function nil "*Value is a function of two arguments, START and END, invoked after a rolo-yank. It should reformat the region given by the arguments to some preferred style. @@ -290,19 +293,19 @@ (format rolo-email-format entry email) entry) current-prefix-arg)))) (if (or (not (stringp name)) (string= name "")) - (error "(rolo-add): Invalid name: '%s'" name)) + (error "(rolo-add): Invalid name: `%s'" name)) (if (and (interactive-p) file) (setq file (completing-read "File to add to: " (mapcar 'list rolo-file-list)))) (if (null file) (setq file (car rolo-file-list))) (cond ((and file (or (not (stringp file)) (string= file ""))) - (error "(rolo-add): Invalid file: '%s'" file)) + (error "(rolo-add): Invalid file: `%s'" file)) ((and (file-exists-p file) (not (file-readable-p file))) - (error "(rolo-add): File not readable: '%s'" file)) + (error "(rolo-add): File not readable: `%s'" file)) ((not (file-writable-p file)) - (error "(rolo-add): File not writable: '%s'" file))) + (error "(rolo-add): File not writable: `%s'" file))) (set-buffer (or (get-file-buffer file) (find-file-noselect file))) - (if (interactive-p) (message "Locating insertion point for '%s'..." name)) + (if (interactive-p) (message "Locating insertion point for `%s'..." name)) (let ((parent "") (level "") end) (widen) (goto-char 1) (while (setq end (string-match "/" name)) @@ -313,7 +316,7 @@ (regexp-quote parent)) nil t) (setq level (buffer-substring (match-beginning 1) (match-end 1))) - (error "(rolo-add): '%s' category not found in \"%s\"." + (error "(rolo-add): `%s' category not found in \"%s\"." parent file))) (narrow-to-region (point) (progn (rolo-to-entry-end t level) (point))) @@ -356,13 +359,14 @@ (widen) (rolo-to-buffer (current-buffer)) (goto-char opoint)) + (run-hooks 'wrolo-add-hook) (if (interactive-p) (message "Edit entry at point."))))) ;;;###autoload (defun rolo-display-matches (&optional display-buf return-to-buffer) "Display optional DISPLAY-BUF buffer of previously found rolodex matches. -If DISPLAY-BUF is nil, use the value in 'rolo-display-buffer'. +If DISPLAY-BUF is nil, use the value in `rolo-display-buffer'. Second arg RETURN-TO-BUFFER is the buffer to leave point within after the display." (interactive) (or display-buf (setq display-buf (get-buffer rolo-display-buffer))) @@ -391,15 +395,15 @@ ;;;###autoload (defun rolo-edit (&optional name file) - "Edits a rolodex entry given by optional NAME within 'rolo-file-list'. + "Edits a rolodex entry given by optional NAME within `rolo-file-list'. With prefix argument, prompts for optional FILE to locate entry within. -With no NAME arg, simply displays FILE or first entry in 'rolo-file-list' in an +With no NAME arg, simply displays FILE or first entry in `rolo-file-list' in an editable mode. NAME may be of the form: parent/child to edit child below a parent entry which begins with the parent string." (interactive "sName to edit in rolo: \nP") (if (string-equal name "") (setq name nil)) (and name (not (stringp name)) - (error "(rolo-edit): Invalid name: '%s'" name)) + (error "(rolo-edit): Invalid name: `%s'" name)) (if (and (interactive-p) current-prefix-arg) (if (= (length rolo-file-list) 1) (setq file (car rolo-file-list)) @@ -409,7 +413,7 @@ (or file (setq file (car file-list))) (if (null name) (progn (if (not (file-writable-p file)) - (error "(rolo-edit): File not writable: '%s'" file)) + (error "(rolo-edit): File not writable: `%s'" file)) (find-file-other-window file) (setq buffer-read-only nil)) (if (setq found-point (rolo-to name file-list)) (progn @@ -417,10 +421,10 @@ (if (file-writable-p file) (setq buffer-read-only nil) (message - "(rolo-edit): Entry found but file not writable: '%s'" file) + "(rolo-edit): Entry found but file not writable: `%s'" file) (beep)) (rolo-to-buffer (current-buffer))) - (message "(rolo-edit): '%s' not found." name) + (message "(rolo-edit): `%s' not found." name) (beep) (rolo-to-buffer (or (get-file-buffer (car file-list)) (find-file-noselect (car file-list)))) @@ -428,7 +432,8 @@ (widen) ;; Rolo-to-buffer may have moved point from its desired location, so ;; restore it. - (if found-point (goto-char found-point))))) + (if found-point (goto-char found-point)) + (run-hooks 'wrolo-edit-hook)))) (defun rolo-edit-entry () "Edit the source entry of the rolodex match buffer entry at point. @@ -526,14 +531,14 @@ ;;;###autoload (defun rolo-kill (name &optional file) - "Kills a rolodex entry given by NAME within 'rolo-file-list'. + "Kills a rolodex entry given by NAME within `rolo-file-list'. With prefix argument, prompts for optional FILE to locate entry within. NAME may be of the form: parent/child to kill child below a parent entry which begins with the parent string. Returns t if entry is killed, nil otherwise." (interactive "sName to kill in rolo: \nP") (if (or (not (stringp name)) (string= name "")) - (error "(rolo-kill): Invalid name: '%s'" name)) + (error "(rolo-kill): Invalid name: `%s'" name)) (if (and (interactive-p) current-prefix-arg) (setq file (completing-read "Entry's File: " (mapcar 'list rolo-file-list)))) @@ -572,9 +577,9 @@ (message "Aborted"))) (funcall kill-op start level))) (message - "(rolo-kill): Entry found but file not writable: '%s'" file) + "(rolo-kill): Entry found but file not writable: `%s'" file) (beep))) - (message "(rolo-kill): '%s' not found." name) + (message "(rolo-kill): `%s' not found." name) (beep)) killed)) @@ -630,7 +635,7 @@ ;;;###autoload (defun rolo-sort (&optional rolo-file) "Sorts up to 14 levels of entries in ROLO-FILE (default is personal rolo). -Assumes entries are delimited by one or more '*'characters. +Assumes entries are delimited by one or more `*'characters. Returns list of number of groupings at each entry level." (interactive (list (let ((default "") @@ -682,6 +687,22 @@ level-regexp max-groupings))) +;;;###autoload +(defun rolo-toggle-datestamps (&optional arg) + "Toggle whether datestamps are updated when rolodex entries are modified. +With optional ARG, turn them on iff ARG is positive." + (interactive "P") + (if (or (and arg (<= (prefix-numeric-value arg) 0)) + (and (not (and arg (> (prefix-numeric-value arg) 0))) + (boundp 'wrolo-add-hook) (listp wrolo-add-hook) + (memq 'rolo-set-date wrolo-add-hook))) + (progn (remove-hook 'wrolo-add-hook 'rolo-set-date) + (remove-hook 'wrolo-edit-hook 'rolo-set-date) + (message "Rolodex date stamps are now turned off.")) + (add-hook 'wrolo-add-hook 'rolo-set-date) + (add-hook 'wrolo-edit-hook 'rolo-set-date) + (message "Rolodex date stamps are now turned on."))) + (defun rolo-toggle-narrow-to-entry () "Toggle between display of current entry and display of all matched entries. Useful when bound to a mouse key." @@ -783,7 +804,7 @@ (widen) (goto-char 1) ;; Ensure no entries in outline mode are hidden. - ;; Uses 'show-all' function from outline.el. + ;; Uses `show-all' function from outline.el. (and (search-forward "\C-m" nil t) (show-all)) (if (re-search-forward rolo-hdr-regexp nil t 2) @@ -846,7 +867,7 @@ (outline-regexp rolo-entry-regexp) (buffer-read-only) (level-len)) - ;; Load 'outline' library since its functions are used here. + ;; Load `outline' library since its functions are used here. (if (not (boundp 'outline-mode-map)) (load-library "outline")) (goto-char (point-min)) @@ -890,7 +911,7 @@ rolo-entry-regexp nil t) (progn (beginning-of-line) (point)) (point-max)))) - ;; Remember last expression in 'progn' + ;; Remember last expression in `progn' ;; must always return non-nil. (goto-char start))) (not grouping-end))) @@ -925,6 +946,14 @@ rolo-buf)) (buffer-list)))) +(defun rolo-current-date () + "Return the current date (a string) in a form used for rolodex entry insertion." + (let ((year-month-day (htz:date-parse (current-time-string)))) + (format "\t%02s/%02s/%s" + (aref year-month-day 1) + (aref year-month-day 2) + (aref year-month-day 0)))) + (defun rolo-display-to-entry-end () "Go to end of current entry, ignoring sub-entries." (if (re-search-forward (concat rolo-hdr-regexp "\\|" @@ -952,7 +981,7 @@ hproperty:highlight-face))))))) (defun rolo-kill-buffer (&optional rolo-buf) - "Kills optional ROLO-BUF if unchanged and 'rolo-kill-buffers-after-use' is t. + "Kills optional ROLO-BUF if unchanged and `rolo-kill-buffers-after-use' is t. Default is current buffer." (or rolo-buf (setq rolo-buf (current-buffer))) (and rolo-kill-buffers-after-use (not (buffer-modified-p rolo-buf)) @@ -960,7 +989,7 @@ (defun rolo-name-and-email () "If point is in a mail message, returns list of (name email-addr) of sender. -Name is returned as 'last, first-and-middle'." +Name is returned as `last, first-and-middle'." (let ((email) (name) (from)) (save-window-excursion (if (or (hmail:lister-p) (hnews:lister-p)) @@ -996,7 +1025,7 @@ (list name email)))) (defun rolo-name-at () - "If point is within an entry in 'rolo-display-buffer', returns entry, else nil." + "If point is within an entry in `rolo-display-buffer', returns entry, else nil." (if (string-equal (buffer-name) rolo-display-buffer) (save-excursion (if (or (looking-at rolo-entry-regexp) @@ -1013,12 +1042,28 @@ (or (/= (point-min) 1) (/= (1+ (buffer-size)) (point-max)))) (defun rolo-save-buffer (&optional rolo-buf) - "Saves optional ROLO-BUF if changed and 'rolo-save-buffers-after-use' is t. + "Saves optional ROLO-BUF if changed and `rolo-save-buffers-after-use' is t. Default is current buffer. Used, for example, after a rolo entry is killed." (or rolo-buf (setq rolo-buf (current-buffer))) (and rolo-save-buffers-after-use (buffer-modified-p rolo-buf) (set-buffer rolo-buf) (save-buffer))) +(defun rolo-set-date () + "Add a line with the current date at the end of the current rolodex entry. +Suitable for use as an entry in `wrolo-add-hook' and `wrolo-edit-hook'. +The default date format is MM/DD/YYYY. Rewrite `rolo-current-date' to +return a different format, if you prefer." + (save-excursion + (skip-chars-forward "*") + (rolo-to-entry-end) + (skip-chars-backward " \t\n\r\f") + (skip-chars-backward "^\n\r\f") + (if (looking-at "\\s-+[-0-9./]+\\s-*$") ;; a date + (progn (delete-region (point) (match-end 0)) + (insert (rolo-current-date))) + (end-of-line) + (insert "\n" (rolo-current-date))))) + (defun rolo-shrink-window () (let* ((lines (count-lines (point-min) (point-max))) (height (window-height)) @@ -1034,7 +1079,7 @@ (defun rolo-to (name &optional file-list) "Moves point to entry for NAME within optional FILE-LIST. -'rolo-file-list' is used as default when FILE-LIST is nil. +`rolo-file-list' is used as default when FILE-LIST is nil. Leaves point immediately after match for NAME within entry. Switches internal current buffer but does not alter the frame. Returns point where matching entry begins or nil if not found." @@ -1044,9 +1089,9 @@ (setq file (car file-list) file-list (cdr file-list)) (cond ((and file (or (not (stringp file)) (string= file ""))) - (error "(rolo-to): Invalid file: '%s'" file)) + (error "(rolo-to): Invalid file: `%s'" file)) ((and (file-exists-p file) (not (file-readable-p file))) - (error "(rolo-to): File not readable: '%s'" file))) + (error "(rolo-to): File not readable: `%s'" file))) (set-buffer (or (get-file-buffer file) (find-file-noselect file))) (let ((case-fold-search t) (real-name name) (parent "") (level) end) (widen) (goto-char 1) @@ -1068,7 +1113,7 @@ (t;; Found parent but not child (setq buffer-read-only nil) (rolo-to-buffer (current-buffer)) - (error "(rolo-to): '%s' part of name not found in \"%s\"." + (error "(rolo-to): `%s' part of name not found in \"%s\"." parent file))) (if level (narrow-to-region (point)
--- a/lisp/modes/cc-mode.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/modes/cc-mode.el Mon Aug 13 08:53:38 2007 +0200 @@ -6,8 +6,8 @@ ;; 1987 Dave Detlefs and Stewart Clamen ;; 1985 Richard M. Stallman ;; Created: a long, long, time ago. adapted from the original c-mode.el -;; Version: 4.379 -;; Last Modified: 1997/03/10 00:59:10 +;; Version: 4.381 +;; Last Modified: 1997/03/18 16:43:13 ;; Keywords: c languages oop ;; NOTE: Read the commentary below for the right way to submit bug reports! @@ -1213,7 +1213,7 @@ (defconst c-inher-key (concat "\\(\\<static\\>\\s +\\)?" c-C++-class-key "[ \t]+" c-symbol-key - "\\([ \t]*:[ \t]*\\)?\\s *[^;]") + "\\([ \t]*:[ \t]*\\)\\s *[^;]") "Regexp describing a class inheritance declaration.") (defconst c-switch-label-key "\\(\\(case[( \t]+\\S .*\\)\\|default[ \t]*\\):" @@ -2563,6 +2563,12 @@ (progn (beginning-of-line) (skip-chars-forward " \t*" (c-point 'eol)) + ;; kludge alert, watch out for */, in + ;; which case fill-prefix should *not* + ;; be "*"! + (if (and (= (following-char) ?/) + (= (preceding-char) ?*)) + (forward-char -1)) (point))) ;; If the comment is only one line followed @@ -5199,7 +5205,7 @@ ;; defuns for submitting bug reports -(defconst c-version "4.379" +(defconst c-version "4.381" "CC Mode version number.") (defconst c-mode-help-address "bug-gnu-emacs@prep.ai.mit.edu, cc-mode-help@python.org"
--- a/lisp/packages/balloon-help.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/packages/balloon-help.el Mon Aug 13 08:53:38 2007 +0200 @@ -57,7 +57,7 @@ (provide 'balloon-help) -(defvar balloon-help-version "1.04" +(defvar balloon-help-version "1.05" "Version string for Balloon Help.") (defvar balloon-help-mode t @@ -138,8 +138,6 @@ as the X server gets around to displaying it. Nil means it will be invisible as soon as the X server decides to hide it.") -(defvar balloon-help-bar-cursor nil) - (defun balloon-help-mode (&optional arg) "Toggle Balloon Help mode. With arg, turn Balloon Help mode on iff arg is positive. @@ -183,6 +181,16 @@ (let* ((buffer (event-buffer event)) (frame (event-frame event)) (point (and buffer (event-point event))) + (modeline-point (and buffer (event-modeline-position event))) + (modeline-extent (and modeline-point + (map-extents + (function (lambda (e ignored) e)) + (symbol-value-in-buffer + 'generated-modeline-string + buffer) + modeline-point modeline-point + nil nil + 'balloon-help))) (glyph-extent (event-glyph-extent event)) (glyph-extent (if (and glyph-extent (extent-property glyph-extent @@ -194,7 +202,7 @@ (button (if (and button (toolbar-button-help-string button)) button nil)) - (object (or glyph-extent extent button)) + (object (or modeline-extent glyph-extent extent button)) (id balloon-help-timeout-id)) (if (null object) (if (and balloon-help-frame @@ -278,7 +286,6 @@ (get-buffer-create " *balloon-help*"))) (if (not (frame-live-p balloon-help-frame)) (setq balloon-help-frame (balloon-help-make-help-frame))) - (setq bar-cursor t) (set-buffer balloon-help-buffer) (erase-buffer) (insert help) @@ -309,7 +316,6 @@ (balloon-help-expose-help-frame)))))) (defun balloon-help-undisplay-help () - (setq bar-cursor balloon-help-bar-cursor) (balloon-help-hide-help-frame)) (defun balloon-help-hide-help-frame () @@ -347,11 +353,14 @@ (defun balloon-help-make-junk-frame () (let ((window-min-height 1) (window-min-width 1)) - (make-frame '(minibuffer t initially-unmapped t width 1 height 1)))) + (save-excursion + (set-buffer (generate-new-buffer "*junk-frame-buffer*")) + (prog1 + (make-frame '(minibuffer t initially-unmapped t width 1 height 1)) + (rename-buffer " *junk-frame-buffer*" t))))) (defun balloon-help-make-help-frame () (save-excursion - (setq balloon-help-bar-cursor bar-cursor) (set-buffer balloon-help-buffer) (set-buffer-menubar nil) (let* ((x (balloon-help-compute-help-frame-x-location))
--- a/lisp/packages/gnuserv.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/packages/gnuserv.el Mon Aug 13 08:53:38 2007 +0200 @@ -5,7 +5,7 @@ ; Copying is permitted under those conditions described by the GNU ; General Public License. ; -; Copyright (C) 1989-1994 Free Software Foundation, Inc. +; Copyright (C) 1989-1996 Free Software Foundation, Inc. ; ; Author: Andy Norman (ange@hplb.hpl.hp.com) based on ; 'lisp/server.el' from the 18.52 GNU Emacs distribution. @@ -53,6 +53,12 @@ ; ; Ben Wing <wing@666.com> May/1996 ; patch to get TTY terminal type correct. +; +; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996 +; ported the server-temp-file-regexp feature from server.el +; ported server hooks from server.el +; ported kill-*-query functions from server.el (and made it optional) +; synced other behaviour with server.el @@ -74,11 +80,29 @@ (defvar server-done-function 'kill-buffer "*A function of one argument, a buffer, which removes the buffer after editing. -Functions such as 'kill-buffer' and 'bury-buffer' are good values.") +Functions such as 'kill-buffer' and 'bury-buffer' are good values. See also +`server-done-temp-file-function'") + +(defvar server-done-temp-file-function 'kill-buffer + "*A function of one argument, a buffer, which removes the buffer after editing a +temporary file. Functions such as 'kill-buffer' and 'bury-buffer' are +good values. See also `server-done-function'") (defvar server-program "gnuserv" "*The program to use as the edit server") + + (defvar server-visit-hook nil + "*List of hooks to call when visiting a file for the Emacs server.") + +;; defined by server.el but obsolete? +;; (defvar server-switch-hook nil +;; "*List of hooks to call when switching to a buffer for the Emacs server.") + +(defvar server-done-hook nil + "*List of hooks to call when done editing a buffer for the Emacs server.") + + (defvar server-process nil "The current server process") @@ -97,15 +121,39 @@ that can be given to the server process to identify a client. When a buffer is killed, it is removed from this list.") +(defvar server-kill-quietly nil + "If this variable is set then don't confirm kills of buffers with + clients attached") + + (defvar server-buffer-clients nil "List of client ids for clients requesting editing of the current buffer.") +(defvar server-temp-file-regexp "^/tmp/Re\\|/draft$" + "*Regexp which should match filenames of temporary files +which are deleted and reused after each edit +by the programs that invoke the emacs server.") + +(defvar server-make-temp-file-backup nil + "Non-nil makes the server backup temporary files also") + (make-variable-buffer-local 'server-buffer-clients) (setq-default server-buffer-clients nil) (or (assq 'server-buffer-clients minor-mode-alist) (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist))) +(defun server-temp-file-p (buffer) + "Return non-nil if BUFFER contains a file considered temporary. +These are files whose names suggest they are repeatedly +reused to pass information to another program. + +The variable `server-temp-file-regexp' controls which filenames +are considered temporary." + (and (buffer-file-name buffer) + (string-match server-temp-file-regexp (buffer-file-name buffer)))) + + (defun server-log (string) "If a *server* buffer exists, write STRING to it for logging purposes." (if (get-buffer "*server*") @@ -200,7 +248,7 @@ ;; make gnuserv-start an alias to server-start, for backward compatibility (fset 'server-start (function gnuserv-start)) - +; Can gnuserv handle commands in close succesion? (See server.el line 283) JV (defun server-write-to-client (client form) "Write the given form to the given client via the server process." (if (and client @@ -249,7 +297,8 @@ (select-frame (make-frame nil device)) (if (not file) (switch-to-buffer (get-buffer-create "*scratch*")) - (find-file file)))) + (find-file file))) + (run-hooks 'server-visit-hook)) (defun server-find-file (file) "Edit file FILENAME. @@ -304,7 +353,8 @@ (find-file file)) (select-screen (create-screen (find-file-noselect file))))) - (t (find-file file))))) ;; emacs18+ + (t (find-file file)))) ;; emacs18+ + (run-hooks 'server-visit-hook)) (defun server-edit-files-quickly (list) @@ -414,6 +464,34 @@ (setq old-clients (cdr old-clients)))))))) +;; Ask before killing a server buffer. +;; It was suggested to release its client instead, +;; but I think that is dangerous--the client would proceed +;; using whatever is on disk in that file. -- rms. +(defun server-kill-buffer-query-function () + (or server-kill-quietly + (not server-buffer-clients) + (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " + (buffer-name (current-buffer)))))) + +(add-hook 'kill-buffer-query-functions + 'server-kill-buffer-query-function) + +(defun server-kill-emacs-query-function () + (let (live-client + (tail server-clients)) + ;; See if any clients have any buffers that are still alive. + (while tail + (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail))))) + (setq live-client t)) + (setq tail (cdr tail))) + (or server-kill-quietly + (not live-client) + (yes-or-no-p "Server buffers still have clients; exit anyway? ")))) + +(add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) + + (defun server-kill-all-local-variables () "Eliminate all the buffer-local variable values of the current buffer. This buffer will then see the default values of all variables. @@ -441,6 +519,7 @@ "Mark BUFFER as \"done\" for its client(s). Buries the buffer, and returns another server buffer as a suggestion for the new current buffer." + ; Note we do NOT return a list with a killed flag, doesn't seem usefull to me. JV (let ((next-buffer nil) (old-clients server-clients)) (while old-clients @@ -448,6 +527,13 @@ (or next-buffer (setq next-buffer (nth 1 (memq buffer client)))) (delq buffer client) + ;; Delete all dead buffers from CLIENT. (Why? JV , copyed from server.el) + (let ((tail client)) + (while tail + (and (bufferp (car tail)) + (null (buffer-name (car tail))) + (delq (car tail) client)) + (setq tail (cdr tail)))) ;; If client now has no pending buffers, ;; tell it that it is done, and forget it entirely. (if (cdr client) @@ -455,13 +541,16 @@ (if (buffer-name buffer) (save-excursion (set-buffer buffer) - (setq server-buffer-clients nil))) + (setq server-buffer-clients nil) + (run-hooks 'server-done-hook))) ; Order is important here -- ; server-kill-buffer tries to notify clients that ; they are done, too, but if we try and notify twice, ; we are h0zed -- Hunter Kelly 3/3/97 (setq server-clients (delq client server-clients)) - (funcall server-done-function buffer) + (if (server-temp-file-p buffer) + (funcall server-done-temp-file-function buffer) + (funcall server-done-function buffer)) (server-write-to-client (car client) nil))) (setq old-clients (cdr old-clients))) next-buffer)) @@ -480,22 +569,32 @@ (let ((buffer (current-buffer))) (if server-buffer-clients (progn - (if (mh-draft-p buffer) + (if (mh-draft-p buffer);; Does this comflict with temp-file ? JV (progn (save-buffer) (write-region (point-min) (point-max) (concat buffer-file-name "~")) (kill-buffer buffer)) - (if (and (buffer-modified-p) - (y-or-n-p (concat "Save file " buffer-file-name "? "))) - (save-buffer buffer))) + (if (server-temp-file-p buffer) + ;; For a temp file, save, and do NOT make a non-numeric backup + ;; Why does server.el explicitly back up temporary files? + (let ((version-control nil) + (buffer-backed-up (not server-make-temp-file-backup))) + (save-buffer)) + (if (and (buffer-modified-p) + (y-or-n-p (concat "Save file " buffer-file-name "? "))) + (save-buffer buffer)))) (server-buffer-done buffer))))) (defun server-edit (&optional arg) - "Switch to next server editing buffer and mark current one as \"done\". -If a server buffer is current, it is marked \"done\" and optionally saved. -MH <draft> files are always saved and backed up, no questions asked. -When all of a client's buffers are marked as \"done\", the client is notified. + "Switch to next server editing +buffer and mark current one as \"done\". If a server buffer is +current, it is marked \"done\" and optionally saved. MH <draft> files +are always saved and backed up, no questions asked. Files that match +server-temp-file-regexp are considered temporary and are saved +unconditionally and +backed up if server-make-temp-file-backup is non-nil. When all of a +client's buffers are marked as \"done\", the client is notified. If invoked with a prefix argument, or if there is no server process running, starts server process and that is all. Invoked by \\[server-edit]. @@ -507,7 +606,7 @@ (memq (process-status server-process) '(signal exit))) (server-start nil) (if server-buffer-clients - (progn (server-switch-buffer (server-done)) + (progn (server-done-and-switch) (cond ((fboundp 'console-type) ;; XEmacs 19.14+ (or (and (equal (console-type) 'x) gnuserv-frame @@ -534,10 +633,11 @@ "(server-edit): Use only on buffers created by external programs.") ))) -(defun server-switch-buffer (next-buffer) +(defun server-switch-buffer-internal (next-buffer always) "Switch to NEXT-BUFFER if a live buffer, otherwise switch to another buffer -with gnuserv clients. If no such buffer is available, simply choose another -one." +with gnuserv clients. If no such buffer is available, we switch to +another normal buffer if `always' is non-nil!" + ;; switching (if next-buffer (if (and (bufferp next-buffer) (buffer-name next-buffer)) @@ -545,11 +645,28 @@ ;; If NEXT-BUFFER is a dead buffer, ;; remove the server records for it ;; and try the next surviving server buffer. - (server-switch-buffer - (server-buffer-done next-buffer))) - (if server-clients - (server-switch-buffer (nth 1 (car server-clients))) - (switch-to-buffer (other-buffer))))) + (server-switch-buffer-internal + (server-buffer-done next-buffer) always)) + (if server-clients + (server-switch-buffer-internal (nth 1 (car server-clients)) always) + (if always + (switch-to-buffer (other-buffer)))))) + +;; For compatability +(defun server-switch-buffer (next-buffer) + (server-switch-buffer-internal next-buffer t)) + +;; The below function calles server-done and switches to the next +;; sensible buffer. This implementation works regardless of the values +;; of server-*-function and doens't need the tail recursion +;; variable passing of server.el. It is more transparant too. JV +(defun server-done-and-switch () + "Be done with the current buffer and switch to another server buffer + if there is one, otherwise just switch buffer" + (let ((old-current (current-buffer))) + (server-switch-buffer-internal (server-done) nil) + (if (eq old-current (current-buffer)) + (switch-to-buffer (other-buffer))))) (global-set-key "\C-x#" 'server-edit)
--- a/lisp/prim/auto-autoloads.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 08:53:38 2007 +0200 @@ -2600,7 +2600,7 @@ ;;;*** -;;;### (autoloads (rolo-yank rolo-sort rolo-kill rolo-grep rolo-fgrep rolo-edit rolo-display-matches rolo-add) "wrolo" "hyperbole/wrolo.el") +;;;### (autoloads (rolo-yank rolo-toggle-datestamps rolo-sort rolo-kill rolo-grep rolo-fgrep rolo-edit rolo-display-matches rolo-add) "wrolo" "hyperbole/wrolo.el") (autoload 'rolo-add "wrolo" "\ Adds a new entry in personal rolodex for NAME. @@ -2611,13 +2611,13 @@ (autoload 'rolo-display-matches "wrolo" "\ Display optional DISPLAY-BUF buffer of previously found rolodex matches. -If DISPLAY-BUF is nil, use the value in 'rolo-display-buffer'. +If DISPLAY-BUF is nil, use the value in `rolo-display-buffer'. Second arg RETURN-TO-BUFFER is the buffer to leave point within after the display." t nil) (autoload 'rolo-edit "wrolo" "\ -Edits a rolodex entry given by optional NAME within 'rolo-file-list'. +Edits a rolodex entry given by optional NAME within `rolo-file-list'. With prefix argument, prompts for optional FILE to locate entry within. -With no NAME arg, simply displays FILE or first entry in 'rolo-file-list' in an +With no NAME arg, simply displays FILE or first entry in `rolo-file-list' in an editable mode. NAME may be of the form: parent/child to edit child below a parent entry which begins with the parent string." t nil) @@ -2652,7 +2652,7 @@ rolo-file-list." t nil) (autoload 'rolo-kill "wrolo" "\ -Kills a rolodex entry given by NAME within 'rolo-file-list'. +Kills a rolodex entry given by NAME within `rolo-file-list'. With prefix argument, prompts for optional FILE to locate entry within. NAME may be of the form: parent/child to kill child below a parent entry which begins with the parent string. @@ -2660,9 +2660,13 @@ (autoload 'rolo-sort "wrolo" "\ Sorts up to 14 levels of entries in ROLO-FILE (default is personal rolo). -Assumes entries are delimited by one or more '*'characters. +Assumes entries are delimited by one or more `*'characters. Returns list of number of groupings at each entry level." t nil) +(autoload 'rolo-toggle-datestamps "wrolo" "\ +Toggle whether datestamps are updated when rolodex entries are modified. +With optional ARG, turn them on iff ARG is positive." t nil) + (autoload 'rolo-yank "wrolo" "\ Inserts at point the first rolodex entry matching NAME. With optional prefix arg, REGEXP-P, treats NAME as a regular expression instead @@ -3674,7 +3678,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.14 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.15 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -4946,7 +4950,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.14 $ +vhdl-mode $Revision: 1.15 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the
--- a/lisp/prim/custom-load.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 08:53:38 2007 +0200 @@ -6,6 +6,7 @@ (put 'gnus-message 'custom-loads '("message")) (put 'gnus-summary-sort 'custom-loads '("gnus-sum")) (put 'nnmail-procmail 'custom-loads '("nnmail")) +(put 'ssl 'custom-loads '("ssl")) (put 'widgets 'custom-loads '("wid-browse" "wid-edit")) (put 'environment 'custom-loads '("cus-edit")) (put 'gnus-article-buttons 'custom-loads '("gnus-art")) @@ -20,7 +21,6 @@ (put 'gnus-article-washing 'custom-loads '("gnus-art")) (put 'mail 'custom-loads '("gnus" "message")) (put 'gnus-summary-exit 'custom-loads '("gnus-sum")) -(put 'comint-input-face 'custom-loads '("comint-xemacs")) (put 'gnus-article-saving 'custom-loads '("gnus-art")) (put 'gnus-extract-view 'custom-loads '("gnus-sum" "gnus-uu")) (put 'gnus-group-listing 'custom-loads '("gnus-group")) @@ -28,7 +28,7 @@ (put 'message-headers 'custom-loads '("message")) (put 'gnus-group-select 'custom-loads '("gnus-sum")) (put 'display-time 'custom-loads '("time")) -(put 'hypermedia 'custom-loads '("wid-edit")) +(put 'hypermedia 'custom-loads '("wid-edit" "w3-cus")) (put 'w3-advanced 'custom-loads '("w3-cus")) (put 'w3-menus 'custom-loads '("w3-cus")) (put 'gnus-summary-mail 'custom-loads '("gnus-sum")) @@ -51,7 +51,7 @@ (put 'gnus-treading 'custom-loads '("gnus-sum")) (put 'nnmail 'custom-loads '("nnmail")) (put 'gnus-article-hiding 'custom-loads '("gnus-art" "gnus-sum")) -(put 'customize 'custom-loads '("wid-edit" "custom" "cus-face" "cus-edit")) +(put 'customize 'custom-loads '("wid-edit" "custom" "cus-edit" "cus-face")) (put 'w3-printing 'custom-loads '("w3-cus")) (put 'nnmail-duplicate 'custom-loads '("nnmail")) (put 'gnus-summary-visual 'custom-loads '("gnus-sum" "gnus")) @@ -89,12 +89,13 @@ (put 'faces 'custom-loads '("cus-edit" "wid-edit" "gnus" "message")) (put 'gnus-various 'custom-loads '("gnus-sum")) (put 'gnus-article-highlight 'custom-loads '("gnus-art")) -(put 'emacs 'custom-loads '("cus-edit" "dired-faces")) +(put 'emacs 'custom-loads '("cus-edit" "dired-faces" "ssl")) (put 'news 'custom-loads '("gnus" "message")) (put 'w3-hooks 'custom-loads '("w3-cus")) (put 'message-insertion 'custom-loads '("message")) (put 'wp 'custom-loads '("cus-edit")) (put 'message-faces 'custom-loads '("message")) +(put 'w3 'custom-loads '("w3-cus")) (put 'gnus-score-files 'custom-loads '("gnus-score")) (put 'gnus-summary-marks 'custom-loads '("gnus-sum")) (put 'picons 'custom-loads '("gnus-picon"))
--- a/lisp/prim/glyphs.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/prim/glyphs.el Mon Aug 13 08:53:38 2007 +0200 @@ -465,7 +465,8 @@ (and (image-instance-p object) (eq 'pointer (image-instance-type object)))) (defun subwindow-image-instance-p (object) - "t if OBJECT is an image instance of type `subwindow'." + "t if OBJECT is an image instance of type `subwindow'. +Subwindows are not implemented in this version of XEmacs." (and (image-instance-p object) (eq 'subwindow (image-instance-type object)))) ;;;;;;;;;; the built-in glyphs
--- a/lisp/prim/help.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/prim/help.el Mon Aug 13 08:53:38 2007 +0200 @@ -349,7 +349,8 @@ the window.") (defvar help-window-config nil) - +(defvar help-window-max-height .5 + "*Proportion of frame to use for help windows.") ;; Use this function for displaying help when C-h something is pressed ;; or in similar situations. Do *not* use it when you are displaying ;; a help message and then prompting for input in the minibuffer -- @@ -384,6 +385,11 @@ (message (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help.")))) (when temp-buffer-shrink-to-fit + (let* ((help-window-size (round (* help-window-max-height + (frame-height (window-frame helpwin))))) + (size (window-displayed-height helpwin))) + (if (< size help-window-size) + (enlarge-window (- help-window-size size) nil helpwin))) (shrink-window-if-larger-than-buffer helpwin)))))))) (defun describe-key (key)
--- a/lisp/prim/itimer.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/prim/itimer.el Mon Aug 13 08:53:38 2007 +0200 @@ -22,6 +22,7 @@ ;; `itimer' feature means Emacs-Lisp programmers get: ;; itimerp +;; itimer-live-p ;; itimer-value ;; itimer-restart ;; itimer-function @@ -45,7 +46,7 @@ ;; ;; See the doc strings of these functions for more information. -(defvar itimer-version "1.04" +(defvar itimer-version "1.05" "Version number of the itimer package.") (defvar itimer-list nil @@ -159,6 +160,13 @@ "Returns non-nil iff OBJ is an itimer." (and (consp obj) (eq (length obj) 8))) +(defun itimer-live-p (obj) + "Returns non-nil iff OBJ is an itimer and is active. +``Active'' means Emacs will run it when it expires. +`activate-timer' must be called on a itimer to make it active. +Itimers started with `start-itimer' are automatically active." + (and (itimerp obj) (memq obj itimer-list))) + (defun itimer-name (itimer) "Returns the name of ITIMER." (check-itimer itimer) @@ -268,7 +276,7 @@ (check-itimer itimer) (setcar (nthcdr 5 itimer) flag)) -(defun set-itimer-function-arguments (itimer &rest arguments) +(defun set-itimer-function-arguments (itimer &optional arguments) "Set the function arguments of ITIMER to be ARGUMENTS. The function of ITIMER will be called with ARGUMENTS when itimer expires. Returns ARGUMENTS." @@ -700,6 +708,9 @@ (let* ((current-itimer itimer) (quit-flag nil) (inhibit-quit nil) + ;; for FSF Emacs timer.el emulation under XEmacs. + ;; eldoc expect this to be done, apparently. + (this-command nil) itimer itimers time-elapsed) (if (itimer-uses-arguments current-itimer) (apply (itimer-function current-itimer) @@ -787,10 +798,10 @@ (defun itimer-timer-wakeup () (let ((inhibit-quit t)) - (cond ((fboundp 'cancel-timer) - (cancel-timer itimer-timer)) - ((fboundp 'disable-timeout) - (disable-timeout itimer-timer))) + (cond ((fboundp 'disable-timeout) + (disable-timeout itimer-timer)) + ((fboundp 'cancel-timer) + (cancel-timer itimer-timer))) (setq itimer-timer (add-timeout itimer-short-interval 'itimer-timer-driver nil nil))))
--- a/lisp/utils/floating-toolbar.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/utils/floating-toolbar.el Mon Aug 13 08:53:38 2007 +0200 @@ -86,7 +86,7 @@ (require 'toolbar) (require 'x) -(defvar floating-toolbar-version "1.01" +(defvar floating-toolbar-version "1.02" "Version string for the floating-toolbar package.") (defvar floating-toolbar-use-sound nil @@ -312,7 +312,11 @@ (defun floating-toolbar-make-junk-frame () (let ((window-min-height 1) (window-min-width 1)) - (make-frame '(minibuffer t initially-unmapped t width 1 height 1)))) + (save-excursion + (set-buffer (generate-new-buffer "*junk-frame-buffer*")) + (prog1 + (make-frame '(minibuffer t initially-unmapped t width 1 height 1)) + (rename-buffer " *junk-frame-buffer*" t))))) (defun floating-toolbar-make-toolbar-frame (x y) (save-excursion
--- a/lisp/version.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/version.el Mon Aug 13 08:53:38 2007 +0200 @@ -26,7 +26,7 @@ (defconst emacs-version "19.15" "\ Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta100)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta101)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version)
--- a/lisp/vm/vm-autoload.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-autoload.el Mon Aug 13 08:53:38 2007 +0200 @@ -977,6 +977,8 @@ (autoload (quote vm-parent-of) "vm-message" nil nil (quote macro)) +(autoload (quote vm-references-of) "vm-message" nil nil (quote macro)) + (autoload (quote vm-mirror-data-of) "vm-message" nil nil (quote macro)) (autoload (quote vm-edit-buffer-of) "vm-message" nil nil (quote macro)) @@ -1089,6 +1091,8 @@ (autoload (quote vm-set-parent-of) "vm-message" nil nil (quote macro)) +(autoload (quote vm-set-references-of) "vm-message" nil nil (quote macro)) + (autoload (quote vm-set-mirror-data-of) "vm-message" nil nil (quote macro)) (autoload (quote vm-set-edit-buffer-of) "vm-message" nil nil (quote macro)) @@ -2043,7 +2047,7 @@ Prefix arg N means print the current message and the next N - 1 messages. Prefix arg -N means print the current message and the previous N - 1 messages. -The variables `vm-print-command' controls what command is run to +The variable `vm-print-command' controls what command is run to print the message, and `vm-print-command-switches' is a list of switches to pass to the command. @@ -2188,7 +2192,7 @@ (autoload (quote vm-mode) "vm-startup" "Major mode for reading mail. -This is VM 6.19. +This is VM 6.20. Commands: h - summarize folder contents @@ -2390,10 +2394,12 @@ vm-mime-digest-headers vm-mime-display-function vm-mime-external-content-types-alist + vm-mime-ignore-mime-version vm-mime-internal-content-types vm-mime-max-message-size vm-mode-hook vm-mosaic-program + vm-mosaic-program-switches vm-move-after-deleting vm-move-after-killing vm-move-after-undeleting @@ -2401,6 +2407,7 @@ vm-mutable-frames vm-mutable-windows vm-netscape-program + vm-netscape-program-switches vm-pop-bytes-per-session vm-pop-max-message-size vm-pop-md5-program @@ -2630,6 +2637,8 @@ (autoload (quote vm-unthread-message) "vm-thread" nil nil nil) +(autoload (quote vm-th-references) "vm-thread" nil nil nil) + (autoload (quote vm-th-parent) "vm-thread" nil nil nil) (autoload (quote vm-th-thread-indentation) "vm-thread" nil nil nil)
--- a/lisp/vm/vm-folder.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-folder.el Mon Aug 13 08:53:38 2007 +0200 @@ -2738,77 +2738,88 @@ (vm-pop-ok-to-ask interactive) crash in maildrop popdrop (got-mail nil)) - (while triples - (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) - maildrop (nth 1 (car triples)) - crash (nth 2 (car triples))) - (if (eq (current-buffer) (vm-get-file-buffer in)) - (let (retrieval-function) - (if (file-exists-p crash) - (progn - (message "Recovering messages from %s..." crash) - (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) - (message "Recovering messages from %s... done" crash))) - (setq popdrop (and vm-recognize-pop-maildrops - (string-match vm-recognize-pop-maildrops - maildrop) - ;; maildrop with password clipped - (vm-safe-popdrop-string maildrop))) - (if (or popdrop - (and (not (equal 0 (nth 7 (file-attributes maildrop)))) - (file-readable-p maildrop))) - (progn - (setq crash (expand-file-name crash vm-folder-directory)) - (if (not popdrop) - (setq maildrop (expand-file-name maildrop) - retrieval-function 'vm-spool-move-mail) - (setq retrieval-function 'vm-pop-move-mail)) - (if (if got-mail - ;; don't allow errors to be signaled unless no - ;; mail has been appended to the incore - ;; copy of the folder. otherwise the - ;; user will wonder where the mail is, - ;; since it is not in the crash box or - ;; the spool file and doesn't _appear_ to - ;; be in the folder either. - (condition-case error-data - (funcall retrieval-function maildrop crash) - (error (message "%s signaled: %s" - (if popdrop - 'vm-pop-move-mail - 'vm-spool-move-mail) - error-data) - (sleep-for 2) - ;; we don't know if mail was - ;; put into the crash box or - ;; not, so return t just to be - ;; safe. - t ) - (quit (message "quitting from %s..." - (if popdrop - 'vm-pop-move-mail - 'vm-spool-move-mail)) - (sleep-for 1) - ;; we don't know if mail was - ;; put into the crash box or - ;; not, so return t just to be - ;; safe. - t )) - (funcall retrieval-function maildrop crash)) - (if (vm-gobble-crash-box crash) - (progn - (setq got-mail t) - (message "Got mail from %s." - (or popdrop maildrop))))))))) - (setq triples (cdr triples))) - ;; not really correct, but it is what the user expects to see. - (if got-mail - (setq vm-spooled-mail-waiting nil)) - (intern (buffer-name) vm-buffers-needing-display-update) - (vm-update-summary-and-mode-line) - (if got-mail - (run-hooks 'vm-retrieved-spooled-mail-hook)) - got-mail )) + (if (and (not (verify-visited-file-modtime (current-buffer))) + (or (null interactive) + (not (yes-or-no-p + (format + "Folder %s changed on disk, discard those changes? " + (buffer-name (current-buffer))))))) + (progn + (message "Folder %s changed on disk, consider M-x revert-buffer" + (buffer-name (current-buffer))) + (sleep-for 1) + nil ) + (while triples + (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) + maildrop (nth 1 (car triples)) + crash (nth 2 (car triples))) + (if (eq (current-buffer) (vm-get-file-buffer in)) + (let (retrieval-function) + (if (file-exists-p crash) + (progn + (message "Recovering messages from %s..." crash) + (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) + (message "Recovering messages from %s... done" crash))) + (setq popdrop (and vm-recognize-pop-maildrops + (string-match vm-recognize-pop-maildrops + maildrop) + ;; maildrop with password clipped + (vm-safe-popdrop-string maildrop))) + (if (or popdrop + (and (not (equal 0 (nth 7 (file-attributes maildrop)))) + (file-readable-p maildrop))) + (progn + (setq crash (expand-file-name crash vm-folder-directory)) + (if (not popdrop) + (setq maildrop (expand-file-name maildrop) + retrieval-function 'vm-spool-move-mail) + (setq retrieval-function 'vm-pop-move-mail)) + (if (if got-mail + ;; don't allow errors to be signaled unless no + ;; mail has been appended to the incore + ;; copy of the folder. otherwise the + ;; user will wonder where the mail is, + ;; since it is not in the crash box or + ;; the spool file and doesn't _appear_ to + ;; be in the folder either. + (condition-case error-data + (funcall retrieval-function maildrop crash) + (error (message "%s signaled: %s" + (if popdrop + 'vm-pop-move-mail + 'vm-spool-move-mail) + error-data) + (sleep-for 2) + ;; we don't know if mail was + ;; put into the crash box or + ;; not, so return t just to be + ;; safe. + t ) + (quit (message "quitting from %s..." + (if popdrop + 'vm-pop-move-mail + 'vm-spool-move-mail)) + (sleep-for 1) + ;; we don't know if mail was + ;; put into the crash box or + ;; not, so return t just to be + ;; safe. + t )) + (funcall retrieval-function maildrop crash)) + (if (vm-gobble-crash-box crash) + (progn + (setq got-mail t) + (message "Got mail from %s." + (or popdrop maildrop))))))))) + (setq triples (cdr triples))) + ;; not really correct, but it is what the user expects to see. + (if got-mail + (setq vm-spooled-mail-waiting nil)) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line) + (if got-mail + (run-hooks 'vm-retrieved-spooled-mail-hook)) + got-mail ))) (defun vm-safe-popdrop-string (drop) (or (and (string-match "^\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop)
--- a/lisp/vm/vm-message.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-message.el Mon Aug 13 08:53:38 2007 +0200 @@ -139,10 +139,15 @@ ;; sortable subject, re: garbage removed (defmacro vm-sortable-subject-of (message) (list 'aref (list 'aref message 3) 17)) +;; tokenized summary entry (defmacro vm-summary-of (message) (list 'aref (list 'aref message 3) 18)) +;; parent of this message, as determined by threading (defmacro vm-parent-of (message) (list 'aref (list 'aref message 3) 19)) +;; message IDs parsed from References header +(defmacro vm-references-of (message) + (list 'aref (list 'aref message 3) 20)) ;; extra data shared by virtual messages if vm-virtual-mirror is non-nil (defmacro vm-mirror-data-of (message) (list 'aref message 4)) ;; if message is being edited, this is the buffer being used. @@ -262,6 +267,8 @@ (list 'aset (list 'aref message 3) 18 val)) (defmacro vm-set-parent-of (message val) (list 'aset (list 'aref message 3) 19 val)) +(defmacro vm-set-references-of (message val) + (list 'aset (list 'aref message 3) 20 val)) (defmacro vm-set-mirror-data-of (message data) (list 'aset message 4 data)) (defmacro vm-set-edit-buffer-of (message buf)
--- a/lisp/vm/vm-mime.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-mime.el Mon Aug 13 08:53:38 2007 +0200 @@ -48,7 +48,7 @@ m (condition-case data (vm-mime-parse-entity m) - (vm-mime-error (apply 'message (cdr data))))) + (vm-mime-error (message "%s" (car (cdr data)))))) (vm-mime-layout-of m)))) (defun vm-mm-encoded-header (m) @@ -418,7 +418,6 @@ (defun vm-decode-mime-message-headers (m) (let ((case-fold-search t) (buffer-read-only nil) - (did-decode nil) charset encoding match-start match-end start end) (save-excursion (goto-char (vm-headers-of m)) @@ -433,7 +432,6 @@ ;; character set properly. (if (not (vm-mime-charset-internally-displayable-p charset)) nil - (setq did-decode t) (delete-region end match-end) (condition-case data (cond ((string-match "B" encoding) @@ -447,16 +445,7 @@ (insert "**invalid encoded word**") (delete-region (point) end))) (vm-mime-charset-decode-region charset start end) - (delete-region match-start start))) - ;; if we did some decoding, re-electrify the headers since - ;; some of the extents might have been wiped by the - ;; decoding process. - (if did-decode - (save-restriction - (narrow-to-region (vm-headers-of m) (vm-text-of m)) - (vm-energize-urls) - (vm-highlight-headers-maybe) - (vm-energize-headers-and-xfaces)))))) + (delete-region match-start start)))))) (defun vm-decode-mime-encoded-words () (let ((case-fold-search t) @@ -632,8 +621,6 @@ (let ((case-fold-search t) version type qtype encoding id description disposition qdisposition boundary boundary-regexp start multipart-list c-t c-t-e done p returnval) - (and m (message "Parsing MIME message...")) - (prog1 (catch 'return-value (save-excursion (if m @@ -701,7 +688,7 @@ (cond ((null m) t) ((null version) (throw 'return-value 'none)) - ((string= version "1.0") t) + ((or vm-mime-ignore-mime-version (string= version "1.0")) t) (t (vm-mime-error "Unsupported MIME version: %s" version))) (cond ((and m (null type)) (throw 'return-value @@ -814,9 +801,7 @@ (vm-marker (point)) (vm-marker (point-max)) (nreverse multipart-list) - nil ))))) - (and m (message "Parsing MIME message... done")) - ))) + nil ))))))) (defun vm-mime-parse-entity-safe (&optional m c-t c-t-e) (or c-t (setq c-t '("text/plain" "charset=us-ascii"))) @@ -930,7 +915,8 @@ (and (vm-toolbar-support-possible-p) vm-use-toolbar (vm-toolbar-install-toolbar)) (and (vm-menu-support-possible-p) - (vm-menu-install-menus))) + (vm-menu-install-menus)) + (run-hooks 'vm-presentation-mode-hook)) (setq vm-presentation-buffer-handle b))) (setq b vm-presentation-buffer-handle vm-presentation-buffer vm-presentation-buffer-handle @@ -1080,9 +1066,7 @@ (let ((charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) (vm-mime-charset-internally-displayable-p charset))) -;; commented out until I decide whether W3 is safe to use in -;; light of the porposed javascript extension and the possibility -;; of executing arbitrary Emacs-Lisp code embedded in a page. +;; commented out until w3-region behavior gets worked out ;; ;; ((vm-mime-types-match "text/html" type) ;; (condition-case () @@ -1276,7 +1260,10 @@ (if (vectorp layout) (progn (vm-decode-mime-layout layout) - (delete-region (point) (point-max))))) + (delete-region (point) (point-max)))) + (vm-energize-urls) + (vm-highlight-headers-maybe) + (vm-energize-headers-and-xfaces)) (set-buffer-modified-p modified)))) (save-excursion (set-buffer vm-mail-buffer) (setq vm-mime-decoded 'decoded)) @@ -1348,9 +1335,7 @@ (defun vm-mime-display-button-text (layout) (vm-mime-display-button-xxxx layout t)) -;; commented out until I decide whether W3 is safe to use in -;; light of the proposed javascript extension and the possibility -;; of executing arbitrary Emacs-Lisp code embedded in a page. +;; commented out until w3-region behavior is worked out ;; ;;(defun vm-mime-display-internal-text/html (layout) ;; (let ((buffer-read-only nil) @@ -1373,7 +1358,7 @@ ;; (message "Inlining text/html... done") ;; t )) -(defun vm-mime-display-internal-text/plain (layout &optional ignore-urls) +(defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) (let ((start (point)) end old-size (buffer-read-only nil) (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) @@ -1388,7 +1373,7 @@ (setq old-size (buffer-size)) (vm-mime-charset-decode-region charset start end) (set-marker end (+ end (- (buffer-size) old-size))) - (or ignore-urls (vm-energize-urls-in-message-region start end)) + (or no-highlighting (vm-energize-urls-in-message-region start end)) (goto-char end) t ))) @@ -1593,7 +1578,8 @@ (vm-mode)) ;; temp buffer, don't offer to save it. (setq buffer-offer-save nil) - (vm-display nil nil (list this-command) '(vm-mode startup))) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup))) t ) (fset 'vm-mime-display-button-multipart/digest 'vm-mime-display-internal-multipart/digest) @@ -2894,7 +2880,7 @@ (vm-insert-region-from-buffer mail-buffer) (goto-char (point-min)) (or (vm-mail-mode-get-header-contents "From") - (insert "From: " (or user-mail-address (user-login-name)) "\n")) + (insert "From: " (user-login-name) "\n")) (or (vm-mail-mode-get-header-contents "Message-ID") (insert "Message-ID: <fake@fake.fake>\n")) (or (vm-mail-mode-get-header-contents "Date")
--- a/lisp/vm/vm-minibuf.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-minibuf.el Mon Aug 13 08:53:38 2007 +0200 @@ -181,8 +181,10 @@ (while keymaps (setq keymap (car keymaps)) (cond ((vm-mouse-xemacs-mouse-p) - (define-key keymap 'button1 command) - (define-key keymap 'button2 command)) + (define-key keymap 'button1 'ignore) + (define-key keymap 'button2 'ignore) + (define-key keymap 'button1up command) + (define-key keymap 'button2up command)) ((vm-mouse-fsfemacs-mouse-p) (define-key keymap [down-mouse-1] 'ignore) (define-key keymap [drag-mouse-1] 'ignore)
--- a/lisp/vm/vm-misc.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-misc.el Mon Aug 13 08:53:38 2007 +0200 @@ -376,6 +376,7 @@ (defun vm-menu-support-possible-p () (or (and (boundp 'window-system) (or (eq window-system 'x) + (eq window-system 'ns) ;; NextStep (eq window-system 'win32))) (and (fboundp 'device-type) (eq (device-type) 'x))))
--- a/lisp/vm/vm-mouse.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-mouse.el Mon Aug 13 08:53:38 2007 +0200 @@ -191,11 +191,13 @@ (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window) (message "Sending URL to Netscape...") (if new-netscape - (vm-run-background-command vm-netscape-program url) - (or (equal 0 (vm-run-command vm-netscape-program "-remote" - (concat "openURL(" url - (if new-window ", new-window" "") - ")"))) + (apply 'vm-run-background-command vm-netscape-program + (append vm-netscape-program-switches (list url))) + (or (equal 0 (apply 'vm-run-command vm-netscape-program "-remote" + (append (list (concat "openURL(" url + (if new-window ", new-window" "") + ")")) + vm-netscape-program-switches))) (vm-mouse-send-url-to-netscape url t new-window))) (message "Sending URL to Netscape... done")) @@ -227,10 +229,10 @@ (not (equal 0 (vm-run-command "kill" "-USR1" pid)))) (setq new-mosaic t))))) (if new-mosaic - (vm-run-background-command vm-mosaic-program url)) + (apply 'vm-run-background-command vm-mosaic-program + (append vm-mosaic-program-switches (list url)))) (message "Sending URL to Mosaic... done")) - (defun vm-mouse-install-mouse () (cond ((vm-mouse-xemacs-mouse-p) (if (null (lookup-key vm-mode-map 'button2))
--- a/lisp/vm/vm-page.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-page.el Mon Aug 13 08:53:38 2007 +0200 @@ -164,7 +164,7 @@ ;; answer about where the end of the message is going to be ;; visible when redisplay finally does occur. (defun vm-howl-if-eom () - (let ((w (vm-get-visible-buffer-window (current-buffer)))) + (let ((w (get-buffer-window (current-buffer)))) (and w (save-excursion (save-window-excursion @@ -450,8 +450,7 @@ (if (or vm-highlight-url-face vm-url-browser) (save-restriction (widen) - (narrow-to-region start - end) + (narrow-to-region start end) (vm-energize-urls))))) (defun vm-highlight-headers-maybe () @@ -499,7 +498,8 @@ (defun vm-preview-current-message () (vm-save-buffer-excursion - (setq vm-system-state 'previewing) + (setq vm-system-state 'previewing + vm-mime-decoded nil) (if vm-real-buffers (vm-make-virtual-copy (car vm-message-pointer))) @@ -562,7 +562,11 @@ (not (vm-buffer-variable-value vm-mail-buffer 'vm-mime-decoded)) (not vm-mime-decoded)) (not (vm-mime-plain-message-p (car vm-message-pointer))) - (vm-decode-mime-message)) + (condition-case data + (vm-decode-mime-message) + (vm-mime-error (vm-set-mime-layout-of (car vm-message-pointer) + (car (cdr data))) + (message "%s" (car (cdr data)))))) (vm-save-buffer-excursion (save-excursion (save-excursion
--- a/lisp/vm/vm-reply.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-reply.el Mon Aug 13 08:53:38 2007 +0200 @@ -130,8 +130,10 @@ (concat "^" (regexp-quote mail-header-separator) "$") nil 0)) (forward-char 1) (while mlist - (vm-yank-message (car mlist)) - (goto-char (point-max)) + (save-restriction + (narrow-to-region (point) (point)) + (vm-yank-message (car mlist)) + (goto-char (point-max))) (setq mlist (cdr mlist))))) (run-hooks 'vm-reply-hook) (run-hooks 'vm-mail-mode-hook))) @@ -576,7 +578,15 @@ "Like vm-forward-message but always forwards all the headers." (interactive) (let ((vm-forwarded-headers nil) - (vm-unforwarded-header-regexp "only-drop-this-header")) + (vm-unforwarded-header-regexp "only-drop-this-header") + ;; set these because vm-forward-message calls vm-send-digest + ;; if there is more than one message to be forwarded. + (vm-rfc934-digest-headers nil) + (vm-rfc934-digest-discard-header-regexp "only-drop-this-header") + (vm-rfc1153-digest-headers nil) + (vm-rfc1153-digest-discard-header-regexp "only-drop-this-header") + (vm-mime-digest-headers nil) + (vm-mime-digest-discard-header-regexp "only-drop-this-header")) (vm-forward-message))) (defun vm-forward-message () @@ -991,6 +1001,9 @@ (and newsgroups (insert "Newsgroups: " newsgroups "\n")) (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n")) (and references (insert "References: " references "\n")) + (insert "X-Mailer: VM " vm-version " under " + (if (vm-fsfemacs-19-p) "Emacs " "") + emacs-version "\n") ;; REPLYTO support for FSF Emacs v19.29 (and (eq mail-default-reply-to t) (setq mail-default-reply-to (getenv "REPLYTO")))
--- a/lisp/vm/vm-save.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-save.el Mon Aug 13 08:53:38 2007 +0200 @@ -501,7 +501,7 @@ Prefix arg N means print the current message and the next N - 1 messages. Prefix arg -N means print the current message and the previous N - 1 messages. -The variables `vm-print-command' controls what command is run to +The variable `vm-print-command' controls what command is run to print the message, and `vm-print-command-switches' is a list of switches to pass to the command.
--- a/lisp/vm/vm-startup.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-startup.el Mon Aug 13 08:53:38 2007 +0200 @@ -275,7 +275,7 @@ (defun vm-mode (&optional read-only) "Major mode for reading mail. -This is VM 6.19. +This is VM 6.20. Commands: h - summarize folder contents @@ -477,10 +477,12 @@ vm-mime-digest-headers vm-mime-display-function vm-mime-external-content-types-alist + vm-mime-ignore-mime-version vm-mime-internal-content-types vm-mime-max-message-size vm-mode-hook vm-mosaic-program + vm-mosaic-program-switches vm-move-after-deleting vm-move-after-killing vm-move-after-undeleting @@ -488,6 +490,7 @@ vm-mutable-frames vm-mutable-windows vm-netscape-program + vm-netscape-program-switches vm-pop-bytes-per-session vm-pop-max-message-size vm-pop-md5-program @@ -922,11 +925,13 @@ 'vm-mime-digest-headers 'vm-mime-display-function 'vm-mime-external-content-types-alist + 'vm-mime-ignore-mime-version 'vm-mime-internal-content-types 'vm-mime-max-message-size 'vm-mode-hook 'vm-mode-hooks 'vm-mosaic-program + 'vm-mosaic-program-switches 'vm-move-after-deleting 'vm-move-after-undeleting 'vm-move-messages-physically @@ -934,6 +939,7 @@ 'vm-mutable-frames 'vm-mutable-windows 'vm-netscape-program + 'vm-netscape-program-switches 'vm-pop-bytes-per-session 'vm-pop-max-message-size 'vm-pop-messages-per-session @@ -946,7 +952,8 @@ 'vm-quit-hook 'vm-recognize-pop-maildrops 'vm-reply-hook - 'vm-reply-ignored-addresses +;; don't feed the spammers or crackers +;; 'vm-reply-ignored-addresses 'vm-reply-ignored-reply-tos 'vm-reply-subject-prefix 'vm-resend-bounced-discard-header-regexp @@ -1059,6 +1066,10 @@ (or (vm-load-window-configurations vm-window-configuration-file) (setq vm-window-configurations vm-default-window-configuration))) (setq vm-buffers-needing-display-update (make-vector 29 0)) + ;; default value of vm-mime-button-face is 'gui-button-face + ;; this face doesn't exist by default in FSF Emacs 19.34. + ;; Create it. + (and (fboundp 'make-face) (make-face 'gui-button-face)) (and (vm-mouse-support-possible-p) (vm-mouse-install-mouse)) (and (vm-menu-support-possible-p)
--- a/lisp/vm/vm-thread.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-thread.el Mon Aug 13 08:53:38 2007 +0200 @@ -42,7 +42,7 @@ ;; no need to schedule reindents of reparented messages ;; unless there were already messages present. (schedule-reindents message-list) - parent parent-sym id id-sym date) + parent parent-sym id id-sym date refs old-parent-sym) (while mp (setq parent (vm-th-parent (car mp)) id (vm-su-message-id (car mp)) @@ -55,25 +55,69 @@ (if parent (progn (setq parent-sym (intern parent vm-thread-obarray)) - (if (not (boundp id-sym)) - (set id-sym parent-sym)) + (cond ((or (not (boundp id-sym)) + (null (symbol-value id-sym)) + (eq (symbol-value id-sym) parent-sym)) + (set id-sym parent-sym)) + (t + (setq old-parent-sym (symbol-value id-sym)) + (put old-parent-sym 'children + (let ((kids (get old-parent-sym 'children)) + (msgs (get id-sym 'messages))) + (while msgs + (setq kids (delq (car msgs) kids) + msgs (cdr msgs))) + kids )) + (set id-sym parent-sym) + (if schedule-reindents + (vm-thread-mark-for-summary-update + (get id-sym 'messages))))) (put parent-sym 'children (cons (car mp) (get parent-sym 'children)))) - (set id-sym nil)) - ;; we need to make sure the asets below are an atomic group. + (if (not (boundp id-sym)) + (set id-sym nil))) + ;; use the references header to set parenting information + ;; for ancestors of this message. This does not override + ;; a parent pointer for a message if it already exists. + (if (cdr (setq refs (vm-th-references (car mp)))) + (let (parent-sym id-sym msgs) + (setq parent-sym (intern (car refs) vm-thread-obarray) + refs (cdr refs)) + (while refs + (setq id-sym (intern (car refs) vm-thread-obarray)) + (if (and (boundp id-sym) (symbol-value id-sym)) + nil + (set id-sym parent-sym) + (if (setq msgs (get id-sym 'messages)) + (put parent-sym 'children + (append msgs (get parent-sym 'children)))) + (if schedule-reindents + (vm-thread-mark-for-summary-update msgs))) + (setq parent-sym id-sym + refs (cdr refs))))) (if vm-thread-using-subject + ;; inhibit-quit because we need to make sure the asets + ;; below are an atomic group. (let* ((inhibit-quit t) (subject (vm-so-sortable-subject (car mp))) (subject-sym (intern subject vm-thread-subject-obarray))) + ;; if this subject never seen before create the + ;; information vector. (if (not (boundp subject-sym)) (set subject-sym (vector id-sym (vm-so-sortable-datestring (car mp)) nil (list (car mp)))) + ;; this subject seen before (aset (symbol-value subject-sym) 3 (cons (car mp) (aref (symbol-value subject-sym) 3))) (if (string< date (aref (symbol-value subject-sym) 1)) (let* ((vect (symbol-value subject-sym)) (i-sym (aref vect 0))) + ;; optimization: if we know that this message + ;; already has a parent, then don't bother + ;; adding it to the list of child messages + ;; since we know that it will be threaded and + ;; unthreaded using the parent information. (if (or (not (boundp i-sym)) (null (symbol-value i-sym))) (aset vect 2 (append (get i-sym 'messages) @@ -88,6 +132,11 @@ (if schedule-reindents (let ((inhibit-quit nil)) (vm-thread-mark-for-summary-update (aref vect 2))))) + ;; optimization: if we know that this message + ;; already has a parent, then don't bother adding + ;; it to the list of child messages, since we + ;; know that it will be threaded and unthreaded + ;; using the parent information. (if (null parent) (aset (symbol-value subject-sym) 2 (cons (car mp) @@ -152,9 +201,9 @@ ;; remove message struct from thread data. ;; ;; optional second arg non-nil means forget information that -;; might be different if the mesage contents changed. +;; might be different if the message contents changed. ;; -;; message must be a real message +;; message must be a real (non-virtual) message (defun vm-unthread-message (message &optional message-changing) (save-excursion (let ((mp (cons message (vm-virtual-messages-of message))) @@ -206,15 +255,19 @@ (vm-thread-mark-for-summary-update children)))))))) (setq mp (cdr mp)))))) +(defun vm-th-references (m) + (or (vm-references-of m) + (vm-set-references-of + m + (let (references) + (setq references (vm-get-header-contents m "References:" " ")) + (and references (vm-parse references "[^<]*\\(<[^>]+>\\)")))))) + (defun vm-th-parent (m) (or (vm-parent-of m) (vm-set-parent-of m - (or (let (references) - (setq references (vm-get-header-contents m "References:" " ")) - (and references - (car (vm-last - (vm-parse references "[^<]*\\(<[^>]+>\\)"))))) + (or (car (vm-last (vm-th-references m))) (let (in-reply-to) (setq in-reply-to (vm-get-header-contents m "In-Reply-To:" " ")) (and in-reply-to
--- a/lisp/vm/vm-vars.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-vars.el Mon Aug 13 08:53:38 2007 +0200 @@ -381,7 +381,7 @@ MIME (Multipurpose Internet Mail Extensions) is a set of extensions to the standard Internet message format that allows reliable tranmission and reception of arbitrary data including -images, audio and video as well as traditional text. +images, audio and video as well as ordinary text. A non-nil value for this variable means that VM will recognize MIME encoded messages and display them as specified by the @@ -390,6 +390,14 @@ A nil value means VM will not display MIME messages any differently than any other message.") +(defvar vm-mime-ignore-mime-version nil + "*Non-nil value means ignore the version number in the MIME-Version +header. VM only knows how to decode and display MIME version 1.0 +messages. Some systems scramble the MIME-Version header, causing +VM to believe that it cannot display a message that it actually +can display. You can set vm-mime-ignore-mime-version non-nil if +you use such systems.") + ;; try to avoid bad interaction with TM (defvar vm-send-using-mime (not (featurep 'mime-setup)) "*Non-nil value means VM should support sending messages using MIME. @@ -576,7 +584,7 @@ (setq vm-mime-charset-font-alist '( - (\"iso-8859-7\" . \"-*-*-medium-r-normal--16-160-72-72-c-80-iso8859-7\") + (\"iso-8859-7\" . \"-*-*-medium-r-normal-*-16-160-72-72-c-80-iso8859-7\") ) ) @@ -589,14 +597,7 @@ Note that under FSF Emacs any fonts you use must be the same size as your default font. XEmacs does not have this limitation.") -(defvar vm-mime-button-face - (cond ((fboundp 'find-face) - (or (and (not (eq (device-type) 'tty)) (find-face 'gui-button-face) - 'gui-button-face) - (and (find-face 'bold-italic) 'bold-italic))) - ((fboundp 'facep) - (or (and (facep 'gui-button-face) 'gui-button-face) - (and (facep 'bold-italic) 'bold-italic)))) +(defvar vm-mime-button-face 'gui-button-face "*Face used for text in buttons that trigger the display of MIME objects.") (defvar vm-mime-8bit-composition-charset "iso-8859-1" @@ -1201,7 +1202,9 @@ (defvar vm-digest-identifier-header-format "X-Digest: %s\n" "*Header to insert into messages burst from a digest. -Value should be a format string of the same type as vm-summary-format that describes a header to be inserted into each message burst from a digest. The format string must end with a newline.") +Value should be a format string of the same type as vm-summary-format +that describes a header to be inserted into each message burst from a +digest. The format string must end with a newline.") (defvar vm-digest-burst-type "guess" "*Value specifies the default digest type offered by vm-burst-digest @@ -1219,7 +1222,7 @@ rfc934 digests separate messages on any line that begins with a few dashes, but doesn't require lines with only dashes or lines with a specific number of dashes. In the text of the message, any line -beginning with dashes is textually modified to be preceeded by a dash +beginning with dashes is textually modified to be preceded by a dash and a space to prevent confusion with message separators. MIME digests use whatever boundary that is specified by the @@ -2191,6 +2194,12 @@ "*List of hook functions to run when a VM virtual folder buffer is created. The current buffer will be that buffer when the hooks are run.") +(defvar vm-presentation-mode-hook nil + "*List of hook functions to run when a VM presentation buffer is created. +The current buffer will be that buffer when the hooks are run. +Presentation buffers are used to display messages when some type of decoding +must be done to the message to make it presentable. E.g. MIME decoding.") + (defvar vm-quit-hook nil "*List of hook functions to run when you quit VM. This applies to any VM quit command.") @@ -2288,10 +2297,16 @@ "*Name of program to use to run Netscape. vm-mouse-send-url-to-netscape uses this.") +(defvar vm-netscape-program-switches nil + "*List of command line switches to pass to Netscape.") + (defvar vm-mosaic-program "Mosaic" "*Name of program to use to run Mosaic. vm-mouse-send-url-to-mosaic uses this.") +(defvar vm-mosaic-program-switches nil + "*List of command line switches to pass to Mosaic.") + (defvar vm-temp-file-directory "/tmp" "*Name of a directory where VM can put temporary files. This name must not end with a slash.") @@ -2767,7 +2782,7 @@ "Non-nil value means that vm-minibuffer-complete-word should automatically append a space to words that complete unambiguously.") (defconst vm-attributes-vector-length 9) -(defconst vm-cache-vector-length 20) +(defconst vm-cache-vector-length 21) (defconst vm-softdata-vector-length 18) (defconst vm-location-data-vector-length 6) (defconst vm-mirror-data-vector-length 5)
--- a/lisp/vm/vm-version.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-version.el Mon Aug 13 08:53:38 2007 +0200 @@ -2,7 +2,7 @@ (provide 'vm-version) -(defconst vm-version "6.19" +(defconst vm-version "6.20" "Version number of VM.") (defun vm-version ()
--- a/lisp/vm/vm-virtual.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/vm/vm-virtual.el Mon Aug 13 08:53:38 2007 +0200 @@ -509,7 +509,9 @@ ;; set the message pointer to a new value if it is ;; now invalid. (cond - ((equal "Q" (vm-message-id-number-of (car vm-message-pointer))) + ((and vm-message-pointer + (equal "Q" (vm-message-id-number-of + (car vm-message-pointer)))) (vm-garbage-collect-message) (setq vmp vm-message-pointer) (while (and vm-message-pointer
--- a/lisp/w3/ChangeLog Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 08:53:38 2007 +0200 @@ -1,5 +1,60 @@ +Mon Mar 17 08:44:46 1997 William M. Perry <wmperry@aventail.com> + +* w3-sysdp.el (buffer-substring-no-properties): Added stub + +* url-gopher.el (url-gopher-retrieve): Ditto. + +* url.el: Ditto + +* w3-parse.el: Removed all sorts of fun (following-char) commands that can + cause ebola warnings under XEmacs 20.x + +* w3.el (w3-popup-info): Default to the URL under point instead of the + documents URL + +* w3-auto.el: updated autoloads - made sure everything was interactive if + appropriate. + +* w3-menu.el (w3-popup-menu): If w3-popup-menu-on-mouse-3 is nil, call + whatever button3 is bound to in global-map + +* w3-display.el: Added XEmacs version of frame-char-height and + frame-char-width + (w3-frames): If w3-display-frames is non-nil, then do a refresh with it + bound locally, so everything should just work. + +* url.el (url-do-setup): Global history file now defaults to ~/.w3/history + (url-do-setup): Cookie storage now defaults to ~/.w3/cookies + +Mon Mar 17 06:51:07 1997 Paul Stodghill <stodghil@CS.Cornell.EDU> + +* mm.el (mm-temporary-directory): Initialize variable from TMPDIR + environment variable + +Fri Mar 14 13:35:56 1997 William M. Perry <wmperry@aventail.com> + +* w3-forms.el (w3-form-create-custom): Fixed the 'custom' input type for + new filenames in the widget/custom package. + +* ssl.el (ssl-certificate-verification-depth): New variable to control how + far up a cert chain to look. + (ssl-view-certificate-program-name): New variable. + (ssl-view-certificate-program-arguments): New variable. + (ssl-certificate-directory-style): New variable. + (ssl-rehash-program-name): New variable. + (ssl-certificate-directory): New variable. + (ssl-program-arguments): Use some of them. + (ssl-accept-ca-certificate): Use the rest. + +* css.el (css-parse-args): Removed old code that could cause infinite loop + in stylesheet parsing on bad things like "foo=bar" instead of "foo:bar" + +* w3-cus.el: Added better groupings for the customization stuff. + Thu Mar 13 19:54:50 1997 William M. Perry <wmperry@aventail.com> +* Emacs-W3 3.0.68 released + * w3-cus.el: Added customization support for Emacs-W3 * w3.el (w3-mail-current-document): Use url-mail-command instead of
--- a/lisp/w3/Makefile Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/Makefile Mon Aug 13 08:53:38 2007 +0200 @@ -61,7 +61,7 @@ .el.elc: $(EMACS) $(BATCHFLAGS) $(DEPS) -f batch-byte-compile $< -w3: docomp.el $(OBJECTS) +w3: check-custom docomp.el $(OBJECTS) @echo Build of w3 complete... all: w3.info w3 @@ -80,6 +80,9 @@ clean: $(RM) $(OBJECTS) +check-custom: + @./custom-check $(EMACS) + w3.info: w3.txi @$(MAKEINFO) w3.txi
--- a/lisp/w3/css.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/css.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; css.el -- Cascading Style Sheet parser ;; Author: wmperry -;; Created: 1997/03/07 01:12:31 -;; Version: 1.29 +;; Created: 1997/03/14 22:02:39 +;; Version: 1.30 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -621,7 +621,7 @@ (while (not (eobp)) (skip-chars-forward ";, \n\t") (setq name-pos (point)) - (skip-chars-forward "^ \n\t:=,;") + (skip-chars-forward "^ \n\t:,;") (downcase-region name-pos (point)) (setq name (intern (buffer-substring name-pos (point)))) (skip-chars-forward " \t\n")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/custom-check Mon Aug 13 08:53:38 2007 +0200 @@ -0,0 +1,26 @@ +#!/bin/sh +EMACS=${1:-emacs} +if [ -z "$HOME" ]; then + HOME=`(cd ; pwd)` +fi + +if [ -n "$WIDGETDIR" ]; then + echo "WIDGETDIR environment variable set, good good" + exit 0 +fi + +WITH=`${EMACS} -batch -l ${HOME}/.emacs -eval '(princ (locate-library "custom"))' | cut -f3- |xargs dirname` +WITHOUT=`${EMACS} -batch -eval '(princ (locate-library "custom"))' | cut -f3- |xargs dirname` + +if [ "${WITH}" = "${WITHOUT}" ]; then + exit 0 +else + echo "WARNING -- WARNING -- WARNING" + echo "Found custom in different places with and without ${HOME}/.emacs" + echo + echo "This could cause potential problems. Please recompile with" + echo "the environment variable WIDGETDIR set correctly. Try this" + echo "command:" + echo "make WIDGETDIR=${WITH}" + exit 1 +fi
--- a/lisp/w3/mm.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/mm.el Mon Aug 13 08:53:38 2007 +0200 @@ -305,7 +305,7 @@ (defvar mm-download-directory nil "*Where downloaded files should go by default.") -(defvar mm-temporary-directory "/tmp" +(defvar mm-temporary-directory (or (getenv "TMPDIR") "/tmp") "*Where temporary files go.")
--- a/lisp/w3/ssl.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/ssl.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; ssl.el,v --- ssl functions for emacsen without them builtin ;; Author: wmperry -;; Created: 1997/03/09 23:02:56 -;; Version: 1.8 +;; Created: 1997/03/15 00:29:34 +;; Version: 1.11 ;; Keywords: comm ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -26,16 +26,118 @@ ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar ssl-program-name "ssl" - "*The program to run in a subprocess to open an SSL connection.") +(require 'cl) +(require 'base64) + +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(defgroup ssl nil + "Support for `Secure Sockets Layer' encryption." + :group 'emacs) + +(defcustom ssl-certificate-directory "~/.w3/certs/" + "*Directory to store CA certificates in" + :group 'ssl + :type 'directory) + +(defcustom ssl-rehash-program-name "c_rehash" + "*Program to run after adding a cert to a directory . +Run with one argument, the directory name." + :group 'ssl + :type 'string) -(defvar ssl-program-arguments '(host port) +(defcustom ssl-view-certificate-program-name "x509" + "*The program to run to provide a human-readable view of a certificate." + :group 'ssl + :type 'string) + +(defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER") + "*Arguments that should be passed to the certificate viewing program. +The certificate is piped to it. +Maybe a way of passing a file should be implemented" + :group 'ssl + :type 'list) + +(defcustom ssl-certificate-directory-style 'ssleay + "*Style of cert database to use, the only valid value right now is `ssleay'. +This means a directory of pem encoded certificates with hash symlinks." + :group 'ssl + :type '(choice (const :tag "SSLeay" :value ssleay))) + +(defcustom ssl-certificate-verification-depth 0 + "*How far up the certificate chain we should verify." + :group 'ssl + :type 'integer) + +(defcustom ssl-program-name "s_client" + "*The program to run in a subprocess to open an SSL connection." + :group 'ssl + :type 'string) + +(defcustom ssl-program-arguments + '("-quiet" + "-host" host + "-port" service + "-verify" ssl-certificate-verification-depth + "-CApath" ssl-certificate-directory + ) "*Arguments that should be passed to the program `ssl-program-name'. This should be used if your SSL program needs command line switches to specify any behaviour (certificate file locations, etc). The special symbols 'host and 'port may be used in the list of arguments and will be replaced with the hostname and service/port that will be connected -to.") +to." + :group 'ssl + :type 'list) + +(defun ssl-accept-ca-certificate () + "Ask if the user is willing to accept a new CA certificate. The buffer-name +should be the intended name of the certificate, and the buffer should probably +be in DER encoding" + ;; TODO, check if it is really new or if we already know it + (let* ((process-connection-type nil) + (tmpbuf (generate-new-buffer "X509 CA Certificate Information")) + (response (save-excursion + (and (eq 0 + (apply 'call-process-region + (point-min) (point-max) + ssl-view-certificate-program-name + nil tmpbuf t + ssl-view-certificate-program-arguments)) + (switch-to-buffer tmpbuf) + (goto-char (point-min)) + (or (recenter) t) + (yes-or-no-p + "Accept this CA to vouch for secure server identities? ") + (kill-buffer tmpbuf))))) + (if (not response) + nil + (if (not (file-directory-p ssl-certificate-directory)) + (make-directory ssl-certificate-directory)) + (case ssl-certificate-directory-style + (ssleay + (base64-encode-region (point-min) (point-max)) + (goto-char (point-min)) + (insert "-----BEGIN CERTIFICATE-----\n") + (goto-char (point-max)) + (insert "-----END CERTIFICATE-----\n") + (let ((f (expand-file-name + (concat (file-name-sans-extension (buffer-name)) ".pem") + ssl-certificate-directory))) + (write-file f) + (call-process ssl-rehash-program-name + nil nil nil + (expand-file-name ssl-certificate-directory)))))))) (defun open-ssl-stream (name buffer host service) "Open a SSL connection for a service to a host.
--- a/lisp/w3/url-gopher.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/url-gopher.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/02/18 23:34:30 -;; Version: 1.6 +;; Created: 1997/03/18 01:02:58 +;; Version: 1.7 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -456,8 +456,7 @@ (nth 1 descr)))) (if url-use-hypertext-gopher (url-do-gopher descr) - (gopher-dispatch-object (vector (if (= 0 - (string-to-char (nth 2 descr))) + (gopher-dispatch-object (vector (if (= 0 (length (nth 2 descr))) ?1 (string-to-char (nth 2 descr))) (nth 2 descr) (nth 2 descr)
--- a/lisp/w3/url-vars.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool ;; Author: wmperry -;; Created: 1997/03/14 06:51:57 -;; Version: 1.35 +;; Created: 1997/03/18 01:10:34 +;; Version: 1.36 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -26,7 +26,7 @@ ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst url-version (let ((x "p3.0.68")) +(defconst url-version (let ((x "p3.0.69")) (if (string-match "State: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/url.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/03/09 06:19:51 -;; Version: 1.62 +;; Created: 1997/03/18 01:08:13 +;; Version: 1.65 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/03/09 06:19:51|1.62|Location Undetermined +;;; 1997/03/18 01:08:13|1.65|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -922,7 +922,7 @@ (setq url-cookie-file (or url-cookie-file - (expand-file-name "~/.w3cookies"))) + (expand-file-name "~/.w3/cookies"))) (setq url-global-history-file (or url-global-history-file @@ -931,7 +931,7 @@ (and (memq system-type '(axp-vms vax-vms)) (expand-file-name "~/mosaic.global-history")) (condition-case () - (expand-file-name "~/.mosaic-global-history") + (expand-file-name "~/.w3/history") (error nil)))) ;; Parse the global history file if it exists, so that it can be used @@ -1020,6 +1020,9 @@ (run-hooks 'url-load-hook) (setq url-setup-done t))) +(defvar url-get-url-filename-chars "%.?@a-zA-Z0-9---()_/:~=&" + "Valid characters in a URL") + ;;;###autoload (defun url-get-url-at-point (&optional pt) "Get the URL closest to point, but don't change your @@ -1028,7 +1031,7 @@ ;; Not at all perfect - point must be right in the name. (save-excursion (if pt (goto-char pt)) - (let ((filename-chars "%.?@a-zA-Z0-9---()_/:~=&") start url) + (let (start url) (save-excursion ;; first see if you're just past a filename (if (not (eobp)) @@ -1037,16 +1040,16 @@ (skip-chars-backward " \n\t\r({[]})") (if (not (bobp)) (backward-char 1))))) - (if (string-match (concat "[" filename-chars "]") - (char-to-string (following-char))) + (if (and (char-after (point)) + (string-match (eval-when-compile + (concat "[" url-get-url-filename-chars "]")) + (char-to-string (char-after (point))))) (progn - (skip-chars-backward filename-chars) + (skip-chars-backward url-get-url-filename-chars) (setq start (point)) - (skip-chars-forward filename-chars)) + (skip-chars-forward url-get-url-filename-chars)) (setq start (point))) - (setq url (if (fboundp 'buffer-substring-no-properties) - (buffer-substring-no-properties start (point)) - (buffer-substring start (point))))) + (setq url (buffer-substring-no-properties start (point)))) (if (string-match "^URL:" url) (setq url (substring url 4 nil))) (if (string-match "\\.$" url)
--- a/lisp/w3/w3-auto.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3-auto.el Mon Aug 13 08:53:38 2007 +0200 @@ -4,26 +4,26 @@ (autoload 'w3-about "w3-about") ;; Hotlist handling -(autoload 'w3-read-html-bookmarks "w3-hot") -(autoload 'w3-hotlist-apropos "w3-hot") -(autoload 'w3-hotlist-refresh "w3-hot") -(autoload 'w3-hotlist-delete "w3-hot") -(autoload 'w3-hotlist-rename-entry "w3-hot") -(autoload 'w3-hotlist-append "w3-hot") +(autoload 'w3-read-html-bookmarks "w3-hot" nil t) +(autoload 'w3-hotlist-apropos "w3-hot" nil t) +(autoload 'w3-hotlist-refresh "w3-hot" nil t) +(autoload 'w3-hotlist-delete "w3-hot" nil t) +(autoload 'w3-hotlist-rename-entry "w3-hot" nil t) +(autoload 'w3-hotlist-append "w3-hot" nil t) (autoload 'w3-parse-hotlist "w3-hot") (autoload 'w3-use-hotlist "w3-hot" nil t) -(autoload 'w3-hotlist-add-document-at-point "w3-hot") -(autoload 'w3-hotlist-add-document "w3-hot") +(autoload 'w3-hotlist-add-document-at-point "w3-hot" nil t) +(autoload 'w3-hotlist-add-document "w3-hot" nil t) ;; Printing -(autoload 'w3-print-this-url "w3-print") -(autoload 'w3-print-url-under-point "w3-print") +(autoload 'w3-print-this-url "w3-print" nil t) +(autoload 'w3-print-url-under-point "w3-print" nil t) (autoload 'w3-parse-tree-to-latex "w3-latex") -(autoload 'w3-show-dvi "w3-latex") +(autoload 'w3-show-dvi "w3-latex" nil t) ;; Stylesheet stuff (autoload 'w3-handle-style "w3-style") -(autoload 'w3-display-stylesheet "w3-style" "" t) +(autoload 'w3-display-stylesheet "w3-style" nil t) ;; Setup stuff (autoload 'url-do-setup "url") @@ -46,7 +46,7 @@ (autoload 'widget-at "wid-edit") ;; Preferences -(autoload 'w3-preferences-edit "w3-prefs" "" t) +(autoload 'w3-preferences-edit "w3-prefs" nil t) (defvar widget-field-new nil)
--- a/lisp/w3/w3-cus.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3-cus.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-cus.el --- Customization support for Emacs-W3 ;; Author: wmperry -;; Created: 1997/03/14 06:51:36 -;; Version: 1.3 +;; Created: 1997/03/14 21:35:54 +;; Version: 1.4 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -32,9 +32,43 @@ (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) nil ;; We've got what we needed ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) (defmacro defcustom (var value doc &rest args) (` (defvar (, var) (, value) (, doc)))))) +(defgroup w3 nil + "Emacs-W3 - the web browser of choice." + :group 'hypermedia) + +(defgroup w3-files nil + "Emacs-W3 configuration files." + :group 'w3) + +(defgroup w3-images nil + "Controlling image handling." + :group 'w3) + +(defgroup w3-printing nil + "Various options for hardcopy from web pages." + :group 'w3) + +(defgroup w3-menus nil + "The look of menus in Emacs-W3" + :group 'w3) + +(defgroup w3-parsing nil + "Options relating to HTML parsing" + :group 'w3) + +(defgroup w3-display nil + "Variables relating to how web pages are displayed." + :group 'w3) + +(defgroup w3-hooks nil + "Hooks relating to Emacs-W3." + :group 'w3) + ;;; File related variables (defcustom w3-configuration-directory "~/.w3/" "*Directory where Emacs-w3 can find its configuration files"
--- a/lisp/w3/w3-display.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3-display.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-display.el --- display engine v99999 ;; Author: wmperry -;; Created: 1997/03/14 06:33:15 -;; Version: 1.147 +;; Created: 1997/03/17 20:09:50 +;; Version: 1.148 ;; Keywords: faces, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2124,6 +2124,9 @@ (defun w3-frames (&optional new-frame) "Set up and fetch W3 frames. With optional prefix, do so in a new frame." (interactive "P") + (if (not w3-display-frames) + (let ((w3-display-frames t)) + (w3-refresh-buffer))) (let* ((old-asynch url-be-asynchronous) (structure (reverse w3-frameset-structure)) (dims (or (reverse w3-frameset-dimensions) @@ -2204,6 +2207,20 @@ (setq stop t))) window-distances)) +(if (not (fboundp 'frame-char-height)) + (defun frame-char-height (&optional frame) + "Height in pixels of a line in the font in frame FRAME. +If FRAME is omitted, the selected frame is used. +For a terminal frame, the value is always 1." + (font-height (face-font 'default frame)))) + +(if (not (fboundp 'frame-char-width)) + (defun frame-char-width (&optional frame) + "Width in pixels of characters in the font in frame FRAME. +If FRAME is omitted, the selected frame is used. +For a terminal screen, the value is always 1." + (font-width (face-font 'default frame)))) + (defun w3-decode-frameset-dimensions (dims available-dimension) "Returns numbers of lines or columns in Emacs, computed from specified frameset dimensions" (let ((dimensions nil))
--- a/lisp/w3/w3-forms.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3-forms.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine ;; Author: wmperry -;; Created: 1997/03/07 14:26:02 -;; Version: 1.77 +;; Created: 1997/03/15 00:31:11 +;; Version: 1.78 ;; Keywords: faces, help, comm, data, languages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -249,7 +249,9 @@ (make-variable-buffer-local 'w3-custom-options) (defun w3-form-create-custom (el face) - (require 'custom-edit) + (condition-case () + (require 'cus-edit) + (error (require 'custom-edit))) (let* ((name (w3-form-element-name el)) (var-name (w3-form-element-value el)) (type (plist-get (w3-form-element-plist el) 'custom-type))
--- a/lisp/w3/w3-menu.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3-menu.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-menu.el --- Menu functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/03/13 19:25:10 -;; Version: 1.32 +;; Created: 1997/03/18 00:45:01 +;; Version: 1.34 ;; Keywords: menu, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -27,6 +27,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'w3-vars) +(require 'w3-mouse) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Spiffy new menus (for both Emacs and XEmacs) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -676,47 +677,49 @@ (defun w3-popup-menu (e) "Pop up a menu of common w3 commands" (interactive "e") - (mouse-set-point e) - (let* ((glyph (event-glyph e)) - (widget (or (and glyph (glyph-property glyph 'widget)) - (widget-at (point)))) - (parent (and widget (widget-get widget :parent))) - (href (or (and widget (widget-get widget 'href)) - (and parent (widget-get parent 'href)))) - (imag (or (and widget (widget-get widget 'src)) - (and parent (widget-get parent 'src)))) - (menu (copy-tree w3-popup-menu)) - url val trunc-url) - (if href - (progn - (setq url href) - (if url (setq trunc-url (url-truncate-url-for-viewing - url - w3-max-menu-width))) + (if (not w3-popup-menu-on-mouse-3) + (call-interactively (lookup-key global-map (vector w3-mouse-button3))) + (mouse-set-point e) + (let* ((glyph (event-glyph e)) + (widget (or (and glyph (glyph-property glyph 'widget)) + (widget-at (point)))) + (parent (and widget (widget-get widget :parent))) + (href (or (and widget (widget-get widget 'href)) + (and parent (widget-get parent 'href)))) + (imag (or (and widget (widget-get widget 'src)) + (and parent (widget-get parent 'src)))) + (menu (copy-tree w3-popup-menu)) + url val trunc-url) + (if href + (progn + (setq url href) + (if url (setq trunc-url (url-truncate-url-for-viewing + url + w3-max-menu-width))) + (setcdr menu (append (cdr menu) + '("---") + (mapcar + (function + (lambda (x) + (vector (format (car x) trunc-url) + (list (cdr x) url) t))) + w3-hyperlink-menu))))) + (if imag + (progn + (setq url imag + trunc-url (url-truncate-url-for-viewing url + w3-max-menu-width)) + (setcdr menu (append (cdr menu) + '("---") + (mapcar + (function + (lambda (x) + (vector (format (car x) trunc-url) + (list (cdr x) url) t))) + w3-graphlink-menu))))) + (if (not (w3-menubar-active)) (setcdr menu (append (cdr menu) - '("---") - (mapcar - (function - (lambda (x) - (vector (format (car x) trunc-url) - (list (cdr x) url) t))) - w3-hyperlink-menu))))) - (if imag - (progn - (setq url imag - trunc-url (url-truncate-url-for-viewing url - w3-max-menu-width)) - (setcdr menu (append (cdr menu) - '("---") - (mapcar - (function - (lambda (x) - (vector (format (car x) trunc-url) - (list (cdr x) url) t))) - w3-graphlink-menu))))) - (if (not (w3-menubar-active)) - (setcdr menu (append (cdr menu) - '("---" ["Show Menubar" w3-toggle-menubar t])))) - (popup-menu menu))) + '("---" ["Show Menubar" w3-toggle-menubar t])))) + (popup-menu menu)))) (provide 'w3-menu)
--- a/lisp/w3/w3-parse.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3-parse.el Mon Aug 13 08:53:38 2007 +0200 @@ -264,11 +264,11 @@ (while (progn (skip-chars-forward "^\"\\\t\n\r") (not (eobp))) - (insert "\\" (cdr (assq (following-char) '((?\" . "\"") - (?\\ . "\\") - (?\t . "t") - (?\n . "n") - (?\r . "r"))))) + (insert "\\" (cdr (assq (char-after (point)) '((?\" . "\"") + (?\\ . "\\") + (?\t . "t") + (?\n . "n") + (?\r . "r"))))) (delete-char 1)) (insert "\"") (buffer-string))) @@ -450,7 +450,7 @@ ;; is not a function character in the SGML declaration. ) - ((eq ?& (following-char)) + ((eq ?& (char-after (point))) ;; We are either looking at an undefined reference or a & that does ;; not start a reference (in which case we should not have been called). ;; Skip over the &. @@ -2116,7 +2116,7 @@ ;; character, or end of buffer. (cond - ((= ?< (following-char)) + ((= ?< (char-after (point))) ;; We are looking at a tag, comment, markup declaration, SGML marked ;; section, SGML processing instruction, or non-markup "<". @@ -2131,8 +2131,8 @@ (setq w3-p-d-tag-name (intern (buffer-substring (match-beginning 1) (match-end 1)))) - (setq w3-p-d-end-tag-p (= ?/ (following-char))) - (setq between-tags-end (1- (point))) + (setq w3-p-d-end-tag-p (eq ?/ (char-after (point))) + between-tags-end (1- (point))) (goto-char (match-end 0)) ;; Read the attributes from a start-tag. @@ -2244,7 +2244,7 @@ (buffer-substring (point-min) (point-max))))) (t (error "impossible attribute value")))) - ((memq (following-char) '(?\" ?')) + ((memq (char-after (point)) '(?\" ?')) ;; Missing terminating quote character. (narrow-to-region (point) (progn @@ -2348,15 +2348,15 @@ ;; Process the end of the tag. (skip-chars-forward " \t\n\r") - (cond ((= ?> (following-char)) + (cond ((eq ?> (char-after (point))) ;; Ordinary tag end. (forward-char 1)) - ((and (= ?/ (following-char)) + ((and (eq ?/ (char-after (point))) (not w3-p-d-end-tag-p)) ;; This is a NET-enabling start-tag. (setq net-tag-p t) (forward-char 1)) - ((= ?< (following-char)) + ((eq ?< (char-after (point))) ;; *** Strictly speaking, the following text has to ;; lexically be STAGO or ETAGO, which means that it ;; can't match some other lexical unit. @@ -2373,7 +2373,7 @@ ((looking-at "/?>") ;; We are looking at an empty tag (<>, </>). - (setq w3-p-d-end-tag-p (= ?/ (following-char))) + (setq w3-p-d-end-tag-p (eq ?/ (char-after (point)))) (setq w3-p-d-tag-name (if w3-p-d-end-tag-p (w3-element-name w3-p-d-current-element) ;; *** Strictly speaking, if OMITTAG NO, then @@ -2435,7 +2435,7 @@ ;; declarations, a goal for the future. (w3-debug-html "Bad <! syntax.") (skip-chars-forward "^>") - (if (= ?> (following-char)) + (if (eq ?> (char-after (point))) (forward-char)))) (point)))) @@ -2462,7 +2462,7 @@ ((memq 'RCDATA keywords)) ((memq 'INCLUDE keywords)) ((memq 'TEMP keywords)))))) - (or (= ?\[ (following-char)) + (or (eq ?\[ (char-after (point))) ;; I probably shouldn't even check this, since it is so ;; impossible. (error "impossible ??")) @@ -2503,7 +2503,7 @@ (point) (progn (skip-chars-forward "^>") - (if (= ?> (following-char)) + (if (eq ?> (char-after (point))) (forward-char)) (point)))) (t @@ -2512,16 +2512,16 @@ ;; again. ))) - ((= ?& (following-char)) + ((eq ?& (char-after (point))) (w3-expand-entity-at-point-maybe)) - ((and (= ?\] (following-char)) + ((and (eq ?\] (char-after (point))) w3-p-d-in-parsed-marked-section (looking-at "]]>")) ;; *** handle the end of a parsed marked section. (error "***unimplemented***")) - ((and (= ?/ (following-char)) + ((and (eq ?/ (char-after (point))) w3-p-d-null-end-tag-enabled) ;; We are looking at a null end tag. (setq w3-p-d-end-tag-p t) @@ -2554,8 +2554,8 @@ ((looking-at (eval-when-compile (concat "[" (w3-invalid-sgml-chars) "]"))) (w3-debug-html - (format "Invalid SGML character: %c" (following-char))) - (insert (or (cdr-safe (assq (following-char) + (format "Invalid SGML character: %c" (char-after (point)))) + (insert (or (cdr-safe (assq (char-after (point)) ;; These characters are apparently ;; from a Windows character set. '((146 . "'") @@ -2739,7 +2739,7 @@ "</[a-z>]\\|&") nil 'move) (goto-char (match-beginning 0))) - (= ?& (following-char))) + (eq ?& (char-after (point)))) (w3-expand-entity-at-point-maybe))))))) (t ;; The element is illegal here. We'll just discard the start
--- a/lisp/w3/w3-prefs.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3-prefs.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-prefs.el --- Preferences panels for Emacs-W3 ;; Author: wmperry -;; Created: 1997/03/14 06:31:17 -;; Version: 1.19 +;; Created: 1997/03/14 23:49:47 +;; Version: 1.20 ;; Keywords: hypermedia, preferences ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -219,7 +219,7 @@ (while todo (setq cur (car todo) todo (cdr todo) - doc (documentation-property cur 'variable-documentation)) ;; (get cur 'variable-documentation)) + doc (documentation-property cur 'variable-documentation)) (if (string-match "^\\*" doc) (setq doc (substring doc 1 nil))) (setq pt (point))
--- a/lisp/w3/w3-sysdp.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3-sysdp.el Mon Aug 13 08:53:38 2007 +0200 @@ -420,6 +420,12 @@ object) (setq start next)))) +(sysdep-defun buffer-substring-no-properties (st nd) + "Return the characters of part of the buffer, without the text properties. +The two arguments START and END are character positions; +they can be in either order." + (buffer-substring st nd)) + ;; Property list functions ;; (sysdep-defun plist-put (plist prop val)
--- a/lisp/w3/w3-vars.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/03/14 06:51:56 -;; Version: 1.108 +;; Created: 1997/03/18 01:10:33 +;; Version: 1.109 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -33,7 +33,7 @@ (require 'w3-cus) ; Grab everything that is customized (defconst w3-version-number - (let ((x "p3.0.68")) + (let ((x "p3.0.69")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -41,7 +41,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1997/03/14 06:51:56")) +(defconst w3-version-date (let ((x "1997/03/18 01:10:33")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/w3.el Mon Aug 13 08:53:21 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/03/14 06:39:41 -;; Version: 1.98 +;; Created: 1997/03/18 00:47:35 +;; Version: 1.99 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1226,7 +1226,8 @@ (defun w3-popup-info (&optional url) "Show information about the link under point. (All SGML attributes)" - (interactive (list (w3-read-url-with-default))) + (interactive (list (or (w3-view-this-url t) + (w3-read-url-with-default)))) (let (dat widget) (if (interactive-p) nil
--- a/man/custom.texi Mon Aug 13 08:53:21 2007 +0200 +++ b/man/custom.texi Mon Aug 13 08:53:38 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Customization Library -Version: 1.64 +Version: 1.65 @menu * Introduction::
--- a/man/gnus.texi Mon Aug 13 08:53:21 2007 +0200 +++ b/man/gnus.texi Mon Aug 13 08:53:38 2007 +0200 @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Gnus 5.4.28 Manual +@settitle Gnus 5.4.30 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -287,7 +287,7 @@ @tex @titlepage -@title Gnus 5.4.28 Manual +@title Gnus 5.4.30 Manual @author by Lars Magne Ingebrigtsen @page @@ -323,7 +323,7 @@ spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Gnus 5.4.28 +This manual corresponds to Gnus 5.4.30 @end ifinfo @@ -6030,6 +6030,12 @@ Do all the three commands above (@code{gnus-article-strip-blank-lines}). +@item W E s +@kindex W E s (Summary) +@findex gnus-article-strip-leading-space +Remove all white space from the beginning of all lines of the article +body (@code{gnus-article-strip-leading-space}). + @end table
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/man/hypb-mouse.txt Mon Aug 13 08:53:38 2007 +0200 @@ -0,0 +1,69 @@ +============================================================================== + Smart Keys +Context Action Key Assist Key +============================================================================== +Hyperbole + On a menu item Item is activated Item help + On an explicit button Button is activated Button help + Reading argument + 1st press at an arg value Value copied to minibuffer <- same + 2nd press at an arg value Value used as argument <- same + In minibuffer Minibuf arg is applied Completion help + On an implicit button Button is activated Button help + Within an outline cell Collapses and expands Shows tree props + Left of an outline cell Creates a klink Moves a tree + Wrolo Match Buffer Edits entries and mails to e-mail addresses + +Mouse or Keyboard Display Control + Line end, not end of buffer + smart-scroll-proportional + = t (default) Makes curr line top line Bottom line + = nil Scrolls up a windowful Scrolls down + End of Any Help buffer Screen restored to previous state + +Mouse-only Control + Modeline down & wind release Resize window height <- same + Drag from shared window side + or from left of scroll bar Resize window width <- same + Drag between windows Create/modify a link but Swap window buffers + Horizontal drag within window + Left to right Scroll to buffer end Split window across + Right to left Scroll to buffer begin Delete window + Vertical drag within window Split window sideways <- same + Diagonal drag within window Save ring screen-config Restore ring config + Click in modeline + Left window edge Bury buffer Unbury bottom buf + Right window edge Info Smart Key summary + Otherwise Action Key Hook Assist Key Hook + +Special Modes + C,C++,Objective-C,Java Modes Jumps to id/include def Jumps to next def + Java Cross-Reference Tag Jumps to identifier def Jumps to next def + Assembly Language Mode Jumps to id/include def Jumps to next def + Any Lisp or Fortran Mode Jumps to id def Jumps to next def + Emacs Lisp Compiler Error Jumps to def with error <- same + Grep or Occur Match Jumps to match source line <- same + Multi-buffer Occur Match Jumps to match source line <- same + Outline Major/Minor Modes Collapses, expands, and moves outline entries + Man Apropos Displays man page entry <- same + Man Pages Follows cross refs, file refs and C code refs + Buffer Menu Saves, deletes and displays buffers + +Emacs Info Reader + Menu Entry or Cross Ref Jumps to referent <- same + Up, Next or Prev Header Jumps to referent Jumps to prior node + File entry of Header Jumps to top node Jumps to (DIR) node + End of current node Jumps to next node Jumps to prev node + Anywhere else Scrolls up a windowful Scrolls down a wind + +Subsystems + Calendar Scrolls or shows appts Scrolls/marks dates + Dired Mode Views and deletes files from directory listing + GNUS News Reader Toggles group subscriptions, gets new news, + and browses articles + Mail reader and Summaries Browses, deletes and expunges messages + OO-Browser Browses classes and elements + Tar Mode Views and edits files from tar archive files + +Any other context (defaults) Hyperbole top menu Smart Key summary +==============================================================================
--- a/man/hyperbole.texi Mon Aug 13 08:53:21 2007 +0200 +++ b/man/hyperbole.texi Mon Aug 13 08:53:38 2007 +0200 @@ -12,7 +12,7 @@ @c Tel: +1 408-243-3300 @c @c ORIG-DATE: 6-Nov-91 at 11:18:03 -@c LAST-MOD: 20-Feb-97 at 12:36:16 by Bob Weiner +@c LAST-MOD: 17-Mar-97 at 21:36:15 by Bob Weiner @c %**start of header (This is for running Texinfo on a region.) @setfilename ../info/hyperbole.info @@ -35,9 +35,9 @@ @sp 1 @center E-mail: <hyperbole@@infodock.com> (This is a mailing list.) @sp 2 -@center Edition 4.02 +@center Edition 4.023 @sp 2 -@center February 19, 1997 +@center March 17, 1997 @page @vskip 0pt plus 1filll @@ -2222,8 +2222,9 @@ @item Cust/ Customizes Hyperbole by setting major options. This includes where Hyperbole link referents are displayed, where URLs -are displayed and whether to use proportional or windowful scrolling -when a Smart Key is pressed at the end of a line. @xref{Configuring}. +are displayed, whether the date stamps are added to rolodex entries, and +whether to use proportional or windowful scrolling when a Smart Key is +pressed at the end of a line. @xref{Configuring}. @cindex menu, EBut @item Ebut/ @@ -3378,17 +3379,19 @@ @end group @end example -We call rolodex records, @dfn{entries}. Entries begin with a delimiter, -some number of `*' characters at the beginning of a line. Entries may +We call rolodex records, @dfn{entries}. Entries begin with a delimiter +of one or more `*' characters at the beginning of a line. Entries may be arranged in a hierarchy, where child entries begin with one more `*' -characters than do their parents. Top level entries begin with a single +character than do their parents. Top level entries begin with a single `*'. Beyond this initial delimiter, entries are completely free-form text. It is best to use a "lastname, firstname" format, however, when adding contact entries into a rolodex. Then the rolodex system will automatically keep your entries alphabetized as you enter them. You'll -also be able to sort them whenever you desire. +also be able to sort them whenever you desire. This is what the +rolodex will use if you accept the default entry that it prompts you +with when adding a new entry. Any search done on the rolodex scans the full text of each entry. During a search, the rolodex file header separator lines and anything in @@ -3491,9 +3494,23 @@ @section Rolo Keys @kindex e -@cindex rolodex, editing an entry +@cindex rolodex, editing +@cindex datestamps +@cindex rolodex, datestamps +@cindex customization, rolodex datestamps +@cindex menu, Toggle-Rolo-Dates +@cindex customization, rolodex edits +@cindex customization, rolodex additions +@vindex wrolo-edit-hook +@vindex wrolo-add-hook Use the @{@kbd{e}@} key to edit the entry at point within the rolodex -source file. +source file. A datestamp will be automatically added or updated at the +end of the entry, unless this feature has been turned off via the +Cust/Toggle-Rolo-Dates menu item. The variable, @var{wrolo-edit-hook}, +is evaluated after the update of the entry datestamp. This allows +programmed modification of the way rolodex edits work. The variable, +@var{wrolo-add-hook}, works the same way but is evaluated when a new +entry is first added. @cindex wrolo menu @cindex rolodex keys @@ -3602,8 +3619,8 @@ setting: @code{(setq rolo-save-buffers-after-use nil)}. @vindex rolo-email-format -When adding an entry from within a buffer containing a mail message, the -rolodex add function will extract the sender's name and e-mail address +When adding an entry from within a buffer that contains a mail message, +the rolodex add function will extract the sender's name and e-mail address and prompt you with the name as a default. If you accept it, it will enter the name and the email address using the format given by the @var{rolo-email-format} variable. See its documentation if you want to
--- a/man/widget.texi Mon Aug 13 08:53:21 2007 +0200 +++ b/man/widget.texi Mon Aug 13 08:53:38 2007 +0200 @@ -1,6 +1,6 @@ \input texinfo.tex -@c $Id: widget.texi,v 1.9 1997/03/18 04:23:28 steve Exp $ +@c $Id: widget.texi,v 1.10 1997/03/19 06:12:09 steve Exp $ @c %**start of header @setfilename widget @@ -15,7 +15,7 @@ @comment node-name, next, previous, up @top The Emacs Widget Library -Version: 1.64 +Version: 1.65 @menu * Introduction::
--- a/src/Makefile.in.in Mon Aug 13 08:53:21 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 08:53:38 2007 +0200 @@ -1070,6 +1070,9 @@ ${lispdir}eos/sun-eos-toolbar.elc \ ${lispdir}eos/sun-eos-menubar.elc \ ${lispdir}utils/annotations.elc \ + ${lispdir}modes/cc-mode.elc \ + ${lispdir}modes/imenu.elc \ + ${lispdir}utils/reporter.elc \ ${lispdir}prim/loaddefs.elc #else #define SUNPRO_LISP ${lispdir}prim/loaddefs.elc @@ -1264,7 +1267,7 @@ ${libsrc}DOC: ${libsrc}make-docfile ${obj_src} ${lisp} #endif rm -f ${libsrc}DOC - ${libsrc}make-docfile -d ${srcdir} -i ../site-packages \ + ${libsrc}make-docfile -d ${srcdir} -i ${libsrc}../site-packages \ ${obj_src} \ ${mallocdocsrc} ${rallocdocsrc} ${lispdir}version.el \ ${lisp} > ${libsrc}DOC
--- a/src/dgif_lib.c Mon Aug 13 08:53:21 2007 +0200 +++ b/src/dgif_lib.c Mon Aug 13 08:53:38 2007 +0200 @@ -915,6 +915,7 @@ SavedImage *sp; ExtensionBlock *ep; GifByteType *ExtData; + int ExtCode; /* Some versions of malloc dislike 0-length requests */ GifFile->SavedImages = (SavedImage *)xmalloc(sizeof(SavedImage)); @@ -941,7 +942,12 @@ break; case EXTENSION_RECORD_TYPE: - + /* This code fails if no image_desc record has been read + yet. I don't know if that's legal, but I've seen GIFs + that start with an extension record. XEmacs doesn't use + the extension records anyway, so we'll just ignore them. + - dkindred@cs.cmu.edu */ +#if 0 if (DGifGetExtension(GifFile,&sp->Function,&ExtData)==GIF_ERROR) return(GIF_ERROR); else @@ -965,6 +971,17 @@ memcpy(ep->Bytes,ExtData,ep->ByteCount * sizeof(char)); } } +#else + /* Skip any extension blocks in the file. */ + if (DGifGetExtension (GifFile, &ExtCode, &ExtData) + == GIF_ERROR) + return GIF_ERROR; + + while (ExtData != NULL) { + if (DGifGetExtensionNext (GifFile, &ExtData) == GIF_ERROR) + return GIF_ERROR; + } +#endif break; case TERMINATE_RECORD_TYPE:
--- a/src/glyphs-x.c Mon Aug 13 08:53:21 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 08:53:38 2007 +0200 @@ -59,6 +59,9 @@ #include <setjmp.h> +/* Set to 1 if you wish to implement this feature */ +# define HAVE_SUBWINDOWS 0 + #define LISP_DEVICE_TO_X_SCREEN(dev) \ XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev))) @@ -140,8 +143,10 @@ } write_c_string (")", printcharfun); break; +#if HAVE_SUBWINDOWS case IMAGE_SUBWINDOW: /* #### implement me */ +#endif default: break; } @@ -202,8 +207,10 @@ if (IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2)) return 0; break; +#if HAVE_SUBWINDOWS case IMAGE_SUBWINDOW: /* #### implement me */ +#endif break; default: break; @@ -221,8 +228,10 @@ case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: return IMAGE_INSTANCE_X_NPIXELS (p); +#if HAVE_SUBWINDOWS case IMAGE_SUBWINDOW: /* #### implement me */ +#endif return 0; default: return 0; @@ -1604,6 +1613,7 @@ return Qnil; } +#if 0 /* We provide our own version of DGifSlurp() because the standardly provided one doesn't handle interlaced GIFs. This is based on code in gif2x11.c. */ @@ -1710,6 +1720,7 @@ return GIF_OK; } +#endif static void gif_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, @@ -1759,10 +1770,12 @@ signal_simple_error ("Unable to decode GIF", build_string (EmacsPrintGifError ())); } -#if 1 +#if 0 if (our_own_dgif_slurp_from_gif2x11_c(unwind.giffile) != GIF_OK) #else - /* DGifSlurp() doesn't handle interlaced files. */ + /* DGifSlurp() doesn't handle interlaced files. */ + /* Actually, it does, sort of. It just sets the Interlace flag + and stores RasterBits in interlaced order. We handle that below. */ if (DGifSlurp (unwind.giffile) != GIF_OK) #endif goto gif_decode_error; @@ -1801,7 +1814,12 @@ int width = unwind.giffile->SWidth; int depth; int bitmap_pad; - int i, j; + int i, j, row, pass, interlace; + /* interlaced gifs have rows in this order: + 0, 8, 16, ..., 4, 12, 20, ..., 2, 6, 10, ..., 1, 3, 5, ... */ + static int InterlacedOffset[] = { 0, 4, 2, 1 }; + static int InterlacedJumps[] = { 8, 8, 4, 2 }; + depth = DefaultDepthOfScreen (scr); @@ -1834,14 +1852,35 @@ optimization routines from XPM (they're in turn mostly copied from the Xlib source code). */ + /* Note: We just use the first image in the file and ignore the rest. + We check here that that image covers the full "screen" size. + I don't know whether that's always the case. + -dkindred@cs.cmu.edu */ + if (unwind.giffile->SavedImages[0].ImageDesc.Height != height + || unwind.giffile->SavedImages[0].ImageDesc.Width != width + || unwind.giffile->SavedImages[0].ImageDesc.Left != 0 + || unwind.giffile->SavedImages[0].ImageDesc.Top != 0) + signal_simple_error ("First image in GIF file is not full size", + instantiator); + + interlace = unwind.giffile->SavedImages[0].ImageDesc.Interlace; + pass = 0; + row = interlace ? InterlacedOffset[pass] : 0; for (i = 0; i < height; i++) - for (j = 0; j < width; j++) - XPutPixel (unwind.ximage, j, i, - unwind.pixels[(unsigned char) - /* incorrect signed declaration - of RasterBits[] */ - (unwind.giffile->SavedImages-> - RasterBits[i * width + j])]); + { + if (interlace && row >= height) + row = InterlacedOffset[++pass]; + + for (j = 0; j < width; j++) + XPutPixel (unwind.ximage, j, row, + unwind.pixels[(unsigned char) + /* incorrect signed declaration + of RasterBits[] */ + (unwind.giffile->SavedImages[0]. + RasterBits[i * width + j])]); + + row += interlace ? InterlacedJumps[pass] : 1; + } } /* 4. Now create the pixmap and set up the image instance */ @@ -3432,6 +3471,7 @@ } +#if HAVE_SUBWINDOWS /************************************************************************/ /* subwindows */ /************************************************************************/ @@ -3707,7 +3747,7 @@ return subwindow; } - +#endif /************************************************************************/ /* initialization */ @@ -3716,6 +3756,7 @@ void syms_of_glyphs_x (void) { +#if HAVE_SUBWINDOWS defsymbol (&Qsubwindowp, "subwindowp"); DEFSUBR (Fmake_subwindow); @@ -3726,6 +3767,7 @@ DEFSUBR (Fsubwindow_xid); DEFSUBR (Fresize_subwindow); DEFSUBR (Fforce_subwindow_map); +#endif defkeyword (&Q_mask_file, ":mask-file"); defkeyword (&Q_mask_data, ":mask-data");
--- a/src/process.c Mon Aug 13 08:53:21 2007 +0200 +++ b/src/process.c Mon Aug 13 08:53:38 2007 +0200 @@ -2152,6 +2152,8 @@ int i; struct Lisp_Process *p; + if (exited_processes_index <= 0) + return; EMACS_BLOCK_SIGNAL (SIGCHLD); for (i = 0; i < exited_processes_index; i++) { @@ -2232,6 +2234,8 @@ static void record_exited_processes (int block_sigchld) { + if (!sigchld_happened) + return; if (block_sigchld) EMACS_BLOCK_SIGNAL (SIGCHLD);