*** pub/rgnus/lisp/cus-edit.el Sun Mar 23 02:58:21 1997 --- rgnus/lisp/cus-edit.el Sun Apr 6 21:51:33 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.70 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *************** *** 456,462 **** (mapcar (lambda (symbol) (setq found (cons (list symbol 'custom-face) found))) (face-list)) - (message "Creating customization buffer...") (custom-buffer-create found)) (if (stringp symbol) (setq symbol (intern symbol))) --- 456,461 ---- *************** *** 512,546 **** OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where SYMBOL is a customization option, and WIDGET is a widget for editing that option." (kill-buffer (get-buffer-create "*Customization*")) (switch-to-buffer (get-buffer-create "*Customization*")) (custom-mode) (widget-insert "This is a customization buffer. Push RET or click mouse-2 on the word ") (widget-create 'info-link :tag "help" :help-echo "Read the online help." "(custom)The Customization Buffer") (widget-insert " for more information.\n\n") (setq custom-options ! (mapcar (lambda (entry) ! (prog1 ! (if (> (length options) 1) ! (widget-create (nth 1 entry) :tag (custom-unlispify-tag-name (nth 0 entry)) :value (nth 0 entry)) ! ;; If there is only one entry, don't hide it! ! (widget-create (nth 1 entry) ! :custom-state 'unknown ! :tag (custom-unlispify-tag-name ! (nth 0 entry)) ! :value (nth 0 entry))) ! (unless (eq (preceding-char) ?\n) ! (widget-insert "\n")) ! (widget-insert "\n"))) ! options)) (mapcar 'custom-magic-reset custom-options) (widget-create 'push-button :tag "Set" :help-echo "Set all modifications for this session." --- 511,558 ---- OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where SYMBOL is a customization option, and WIDGET is a widget for editing that option." + (message "Creating customization buffer...") (kill-buffer (get-buffer-create "*Customization*")) (switch-to-buffer (get-buffer-create "*Customization*")) (custom-mode) (widget-insert "This is a customization buffer. Push RET or click mouse-2 on the word ") + ;; (put-text-property 1 2 'start-open nil) (widget-create 'info-link :tag "help" :help-echo "Read the online help." "(custom)The Customization Buffer") (widget-insert " for more information.\n\n") (setq custom-options ! (if (= (length options) 1) ! (mapcar (lambda (entry) ! (widget-create (nth 1 entry) ! :custom-state 'unknown ! :tag (custom-unlispify-tag-name ! (nth 0 entry)) ! :value (nth 0 entry))) ! options) ! (let ((count 0) ! (length (length options))) ! (mapcar (lambda (entry) ! (prog2 ! (message "Creating customization items %2d%%..." ! (/ (* 100.0 count) length)) ! (widget-create (nth 1 entry) :tag (custom-unlispify-tag-name (nth 0 entry)) :value (nth 0 entry)) ! (setq count (1+ count)) ! (unless (eq (preceding-char) ?\n) ! (widget-insert "\n")) ! (widget-insert "\n"))) ! options)))) ! (unless (eq (preceding-char) ?\n) ! (widget-insert "\n")) ! (widget-insert "\n") ! (message "Creating customization magic...") (mapcar 'custom-magic-reset custom-options) + (message "Creating customization buttons...") (widget-create 'push-button :tag "Set" :help-echo "Set all modifications for this session." *************** *** 576,583 **** (when (memq 'down (event-modifiers event)) (read-event))))) (widget-insert "\n") (widget-setup) ! (goto-char (point-min))) ;;; Modification of Basic Widgets. ;; --- 588,597 ---- (when (memq 'down (event-modifiers event)) (read-event))))) (widget-insert "\n") + (message "Creating customization setup...") (widget-setup) ! (goto-char (point-min)) ! (message "Creating customization buffer...done")) ;;; Modification of Basic Widgets. ;; *************** *** 1309,1314 **** --- 1323,1329 ---- (face-doc-string face)) :value-create 'custom-face-value-create :action 'custom-face-action + :custom-form 'selected :custom-set 'custom-face-set :custom-save 'custom-face-save :custom-reset-current 'custom-redraw *************** *** 1336,1366 **** (widget-put widget :buttons (cons child (widget-get widget :buttons)))))) (defun custom-face-value-create (widget) ;; Create a list of the display specifications. (unless (eq (preceding-char) ?\n) (insert "\n")) (when (not (eq (widget-get widget :custom-state) 'hidden)) (custom-load-widget widget) (let* ((symbol (widget-value widget)) (edit (widget-create-child-and-convert ! widget 'editable-list ! :entry-format "%i %d %v" ! :value (or (get symbol 'saved-face) ! (get symbol 'factory-face)) ! :insert-button-args '(:help-echo "\ ! Insert new display specification here.") ! :append-button-args '(:help-echo "\ ! Append new display specification here.") ! :delete-button-args '(:help-echo "\ ! Delete this display specification.") ! '(group :format "%v" ! custom-display custom-face-edit)))) (custom-face-state-set widget) ! (widget-put widget :children (list edit))))) (defvar custom-face-menu ! '(("Set" . custom-face-set) ("Save" . custom-face-save) ("Reset to Saved" . custom-face-reset-saved) ("Reset to Factory Setting" . custom-face-reset-factory)) --- 1351,1427 ---- (widget-put widget :buttons (cons child (widget-get widget :buttons)))))) + (define-widget 'custom-face-all 'editable-list + "An editable list of display specifications and attributes." + :entry-format "%i %d %v" + :insert-button-args '(:help-echo "Insert new display specification here.") + :append-button-args '(:help-echo "Append new display specification here.") + :delete-button-args '(:help-echo "Delete this display specification.") + :args '((group :format "%v" custom-display custom-face-edit))) + + (defconst custom-face-all (widget-convert 'custom-face-all) + "Converted version of the `custom-face-all' widget.") + + (define-widget 'custom-display-unselected 'item + "A display specification that doesn't match the selected display." + :match 'custom-display-unselected-match) + + (defun custom-display-unselected-match (widget value) + "Non-nil if VALUE is an unselected display specification." + (and (listp value) + (eq (length value) 2) + (not (custom-display-match-frame value (selected-frame))))) + + (define-widget 'custom-face-selected 'group + "Edit the attributes of the selected display in a face specification." + :args '((repeat :format "" + :inline t + (group custom-display-unselected sexp)) + (group (sexp :format "") custom-face-edit) + (repeat :format "" + :inline t + sexp))) + + (defconst custom-face-selected (widget-convert 'custom-face-selected) + "Converted version of the `custom-face-selected' widget.") + (defun custom-face-value-create (widget) ;; Create a list of the display specifications. (unless (eq (preceding-char) ?\n) (insert "\n")) (when (not (eq (widget-get widget :custom-state) 'hidden)) + (message "Creating face editor...") (custom-load-widget widget) (let* ((symbol (widget-value widget)) + (spec (or (get symbol 'saved-face) + (get symbol 'factory-face) + ;; Attempt to construct it. + (list (list t (custom-face-attributes-get + symbol (selected-frame)))))) + (form (widget-get widget :custom-form)) + (indent (widget-get widget :indent)) (edit (widget-create-child-and-convert ! widget ! (cond ((and (eq form 'selected) ! (widget-apply custom-face-selected :match spec)) ! (when indent (insert-char ?\ indent)) ! 'custom-face-selected) ! ((and (not (eq form 'lisp)) ! (widget-apply custom-face-all :match spec)) ! 'custom-face-all) ! (t ! (when indent (insert-char ?\ indent)) ! 'sexp)) ! :value spec))) (custom-face-state-set widget) ! (widget-put widget :children (list edit))) ! (message "Creating face editor...done"))) (defvar custom-face-menu ! '(("Edit Selected" . custom-face-edit-selected) ! ("Edit All" . custom-face-edit-all) ! ("Edit Lisp" . custom-face-edit-lisp) ! ("Set" . custom-face-set) ("Save" . custom-face-save) ("Reset to Saved" . custom-face-reset-saved) ("Reset to Factory Setting" . custom-face-reset-factory)) *************** *** 1369,1374 **** --- 1430,1453 ---- lisp function taking the widget as an element which will be called when the action is chosen.") + (defun custom-face-edit-selected (widget) + "Edit selected attributes of the value of WIDGET." + (widget-put widget :custom-state 'unknown) + (widget-put widget :custom-form 'selected) + (custom-redraw widget)) + + (defun custom-face-edit-all (widget) + "Edit all attributes of the value of WIDGET." + (widget-put widget :custom-state 'unknown) + (widget-put widget :custom-form 'all) + (custom-redraw widget)) + + (defun custom-face-edit-lisp (widget) + "Edit the lisp representation of the value of WIDGET." + (widget-put widget :custom-state 'unknown) + (widget-put widget :custom-form 'lisp) + (custom-redraw widget)) + (defun custom-face-state-set (widget) "Set the state of WIDGET." (let ((symbol (widget-value widget))) *************** *** 1537,1548 **** :group 'customize) (defface custom-group-tag-face-1 '((((class color) ! (background dark)) ! (:foreground "pink" :underline t)) ! (((class color) ! (background light)) ! (:foreground "red" :underline t)) ! (t (:underline t))) "Face used for group tags.") (defface custom-group-tag-face '((((class color) --- 1616,1627 ---- :group 'customize) (defface custom-group-tag-face-1 '((((class color) ! (background dark)) ! (:foreground "pink" :underline t)) ! (((class color) ! (background light)) ! (:foreground "red" :underline t)) ! (t (:underline t))) "Face used for group tags.") (defface custom-group-tag-face '((((class color) *************** *** 1578,1591 **** --- 1657,1676 ---- (defun custom-group-value-create (widget) (let ((state (widget-get widget :custom-state))) (unless (eq state 'hidden) + (message "Creating group...") (custom-load-widget widget) (let* ((level (widget-get widget :custom-level)) (symbol (widget-value widget)) (members (get symbol 'custom-group)) (prefixes (widget-get widget :custom-prefixes)) (custom-prefix-list (custom-prefix-add symbol prefixes)) + (length (length members)) + (count 0) (children (mapcar (lambda (entry) (widget-insert "\n") + (message "Creating group members... %2d%%" + (/ (* 100.0 count) length)) + (setq count (1+ count)) (prog1 (widget-create-child-and-convert widget (nth 1 entry) *************** *** 1598,1606 **** (unless (eq (preceding-char) ?\n) (widget-insert "\n")))) members))) (mapcar 'custom-magic-reset children) (widget-put widget :children children) ! (custom-group-state-update widget))))) (defvar custom-group-menu '(("Set" . custom-group-set) --- 1683,1694 ---- (unless (eq (preceding-char) ?\n) (widget-insert "\n")))) members))) + (message "Creating group magic...") (mapcar 'custom-magic-reset children) + (message "Creating group state...") (widget-put widget :children children) ! (custom-group-state-update widget) ! (message "Creating group... done"))))) (defvar custom-group-menu '(("Set" . custom-group-set) *************** *** 1736,1742 **** (princ ")") (princ " t)")))))) (princ ")") ! (unless (eolp) (princ "\n"))))) (defun custom-save-faces () --- 1824,1830 ---- (princ ")") (princ " t)")))))) (princ ")") ! (unless (looking-at "\n") (princ "\n"))))) (defun custom-save-faces () *************** *** 1760,1768 **** (princ ")") (princ " t)")))))) (princ ")") ! (unless (eolp) (princ "\n"))))) (defun custom-save-all () "Save all customizations in `custom-file'." (custom-save-variables) --- 1848,1857 ---- (princ ")") (princ " t)")))))) (princ ")") ! (unless (looking-at "\n") (princ "\n"))))) + ;;;###autoload (defun custom-save-all () "Save all customizations in `custom-file'." (custom-save-variables) *** pub/rgnus/lisp/cus-face.el Sun Mar 23 02:58:21 1997 --- rgnus/lisp/cus-face.el Sun Apr 6 21:51:34 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.70 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *************** *** 19,24 **** --- 19,38 ---- ;;; Compatibility. + (if (string-match "XEmacs" emacs-version) + (defun custom-face-background (face &optional frame) + ;; Specifiers suck! + "Return the background color name of face FACE, or nil if unspecified." + (color-instance-name (specifier-instance (face-background face) frame))) + (defalias 'custom-face-background 'face-background)) + + (if (string-match "XEmacs" emacs-version) + (defun custom-face-foreground (face &optional frame) + ;; Specifiers suck! + "Return the background color name of face FACE, or nil if unspecified." + (color-instance-name (specifier-instance (face-foreground face) frame))) + (defalias 'custom-face-foreground 'face-foreground)) + (eval-and-compile (unless (fboundp 'frame-property) ;; XEmacs function missing in Emacs 19.34. *************** *** 37,43 **** ;; XEmacs function missing in Emacs. (defun set-face-doc-string (face string) "Set the documentation string for FACE to STRING." ! (put face 'face-doc-string string)))) (unless (fboundp 'x-color-values) ;; Emacs function missing in XEmacs 19.14. --- 51,88 ---- ;; XEmacs function missing in Emacs. (defun set-face-doc-string (face string) "Set the documentation string for FACE to STRING." ! (put face 'face-doc-string string))) ! ! (when (and (not (fboundp 'set-face-stipple)) ! (fboundp 'set-face-background-pixmap)) ! ;; Emacs function missing in XEmacs 19.15. ! (defun set-face-stipple (face pixmap &optional frame) ! ;; Written by Kyle Jones. ! "Change the stipple pixmap of face FACE to PIXMAP. ! PIXMAP should be a string, the name of a file of pixmap data. ! The directories listed in the `x-bitmap-file-path' variable are searched. ! ! Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA) ! where WIDTH and HEIGHT are the size in pixels, ! and DATA is a string, containing the raw bits of the bitmap. ! ! If the optional FRAME argument is provided, change only ! in that frame; otherwise change each frame." ! (while (not (find-face face)) ! (setq face (signal 'wrong-type-argument (list 'facep face)))) ! (while (cond ((stringp pixmap) ! (unless (file-readable-p pixmap) ! (setq pixmap (vector 'xbm ':file pixmap))) ! nil) ! ((and (consp pixmap) (= (length pixmap) 3)) ! (setq pixmap (vector 'xbm ':data pixmap)) ! nil) ! (t t)) ! (setq pixmap (signal 'wrong-type-argument ! (list 'stipple-pixmap-p pixmap)))) ! (while (and frame (not (framep frame))) ! (setq frame (signal 'wrong-type-argument (list 'framep frame)))) ! (set-face-background-pixmap face pixmap frame)))) (unless (fboundp 'x-color-values) ;; Emacs function missing in XEmacs 19.14. *************** *** 162,170 **** (or (frame-property frame 'background-color) ! (color-instance-name ! (specifier-instance ! (face-background 'default)))) (error nil))) (or (string-match "XEmacs" emacs-version) window-system) --- 207,214 ---- (or (frame-property frame 'background-color) ! (custom-face-background ! 'default)) (error nil))) (or (string-match "XEmacs" emacs-version) window-system) *************** *** 240,254 **** (:underline (toggle :format "Underline: %[%v%]\n" :help-echo "\ Control whether the text should be underlined.") ! set-face-underline-p) (:foreground (color :tag "Foreground" :value "black" :help-echo "Set foreground color.") ! set-face-foreground) (:background (color :tag "Background" :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. --- 284,301 ---- (:underline (toggle :format "Underline: %[%v%]\n" :help-echo "\ Control whether the text should be underlined.") ! set-face-underline-p ! face-underline-p) (:foreground (color :tag "Foreground" :value "black" :help-echo "Set foreground color.") ! set-face-foreground ! custom-face-foreground) (:background (color :tag "Background" :value "white" :help-echo "Set background color.") ! set-face-background ! custom-face-background) ;; (:invert (const :format "Invert Face\n" ;; :sibling-args (:help-echo " ;;Reverse the foreground and background color. *************** *** 262,274 **** set-face-stipple)) "Alist of face attributes. ! The elements are of the form (KEY TYPE SET) where KEY is a symbol identifying the attribute, TYPE is a widget type for editing the ! attibute, SET is a function for setting the attribute value. The SET function should take three arguments, the face to modify, the value of the attribute, and optionally the frame where the face should ! be changed.") (defun custom-face-attributes-set (face frame &rest atts) "For FACE on FRAME set the attributes [KEYWORD VALUE].... --- 309,324 ---- set-face-stipple)) "Alist of face attributes. ! The elements are of the form (KEY TYPE SET GET) where KEY is a symbol identifying the attribute, TYPE is a widget type for editing the ! attibute, SET is a function for setting the attribute value, and GET is a function for getiing the attribute value. The SET function should take three arguments, the face to modify, the value of the attribute, and optionally the frame where the face should ! be changed. ! ! The GET function should take two arguments, the face to examine, and ! optonally the frame where the face should be examined.") (defun custom-face-attributes-set (face frame &rest atts) "For FACE on FRAME set the attributes [KEYWORD VALUE].... *************** *** 284,289 **** --- 334,357 ---- (funcall fun face value frame) (error nil))))) + (defun custom-face-attributes-get (face frame) + "For FACE on FRAME get the attributes [KEYWORD VALUE].... + Each keyword should be listed in `custom-face-attributes'. + + If FRAME is nil, use the default face." + (let ((atts custom-face-attributes) + att result get) + (while atts + (setq att (car atts) + atts (cdr atts) + get (nth 3 att)) + (when get + (let ((answer (funcall get face frame))) + (unless (equal answer (funcall get 'default frame)) + (when (widget-apply (nth 1 att) :match answer) + (setq result (cons (nth 0 att) (cons answer result)))))))) + result)) + (defun custom-set-face-bold (face value &optional frame) "Set the bold property of FACE to VALUE." (if value *************** *** 427,433 **** (defun custom-initialize-frame (&optional frame) "Initialize local faces for FRAME if necessary. ! If FRAME is missing or nil, the first member (frame-list) is used." (unless frame (setq frame (car (frame-list)))) (unless (equal (custom-get-frame-properties) --- 495,501 ---- (defun custom-initialize-frame (&optional frame) "Initialize local faces for FRAME if necessary. ! If FRAME is missing or nil, the first member of (frame-list) is used." (unless frame (setq frame (car (frame-list)))) (unless (equal (custom-get-frame-properties) *** pub/rgnus/lisp/custom.el Sun Mar 23 02:58:21 1997 --- rgnus/lisp/custom.el Sun Apr 6 21:51:35 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.70 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *************** *** 129,141 **** The ATTS of the first entry in SPEC where the DISPLAY matches the frame should take effect in that frame. DISPLAY can either be the ! symbol `t', which will match all frames, or an alist of the form \((REQ ITEM...)...) For the DISPLAY to match a FRAME, the REQ property of the frame must match one of the ITEM. The following REQ are defined: ! `type' (the value of (window-system)) Should be one of `x' or `tty'. `class' (the frame's color support) --- 129,141 ---- The ATTS of the first entry in SPEC where the DISPLAY matches the frame should take effect in that frame. DISPLAY can either be the ! symbol t, which will match all frames, or an alist of the form \((REQ ITEM...)...) For the DISPLAY to match a FRAME, the REQ property of the frame must match one of the ITEM. The following REQ are defined: ! `type' (the value of `window-system') Should be one of `x' or `tty'. `class' (the frame's color support) *************** *** 198,204 **** `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) (defun custom-add-to-group (group option widget) ! "To existing GROUP add a new OPTION of type WIDGET, If there already is an entry for that option, overwrite it." (let* ((members (get group 'custom-group)) (old (assq option members))) --- 198,204 ---- `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) (defun custom-add-to-group (group option widget) ! "To existing GROUP add a new OPTION of type WIDGET. If there already is an entry for that option, overwrite it." (let* ((members (get group 'custom-group)) (old (assq option members))) *** pub/rgnus/lisp/gnus-art.el Wed Apr 2 14:21:03 1997 --- rgnus/lisp/gnus-art.el Sun Apr 6 21:51:35 1997 *************** *** 527,533 **** (defvar gnus-number-of-articles-to-be-saved nil) (defvar gnus-inhibit-hiding nil) - (defvar gnus-newsgroup-name) (defsubst gnus-article-hide-text (b e props) "Set text PROPS on the B to E region, extending `intangible' 1 past B." --- 527,532 ---- *************** *** 744,749 **** --- 743,750 ---- "Translate overstrikes into bold text." (interactive) (save-excursion + (goto-char (point-min)) + (re-search-forward "\n\n") (let ((buffer-read-only nil)) (while (search-forward "\b" nil t) (let ((next (following-char)) *************** *** 1147,1157 **** (defun gnus-article-hidden-text-p (type) "Say whether the current buffer contains hidden text of type TYPE." ! (let ((pos (text-property-any (point-min) (point-max) 'article-type type))) ! (when pos ! (if (get-text-property pos 'invisible) ! 'hidden ! 'shown)))) (defun gnus-article-show-hidden-text (type &optional hide) "Show all hidden text of type TYPE. --- 1148,1162 ---- (defun gnus-article-hidden-text-p (type) "Say whether the current buffer contains hidden text of type TYPE." ! (let ((start (point-min)) ! (pos (text-property-any (point-min) (point-max) 'article-type type))) ! (while (and pos ! (not (get-text-property pos 'invisible))) ! (setq pos ! (text-property-any (1+ pos) (point-max) 'article-type type))) ! (if pos ! 'hidden ! 'shown))) (defun gnus-article-show-hidden-text (type &optional hide) "Show all hidden text of type TYPE. *************** *** 1796,1801 **** --- 1801,1807 ---- (use-local-map gnus-article-mode-map) (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) + (set (make-local-variable 'gnus-page-broken) nil) (set (make-local-variable 'gnus-button-marker-list) nil) (gnus-set-default-directory) (buffer-disable-undo (current-buffer)) *************** *** 1970,1977 **** (run-hooks 'gnus-article-display-hook)) ;; Do page break. (goto-char (point-min)) ! (when gnus-break-pages ! (gnus-narrow-to-page))) (gnus-set-mode-line 'article) (gnus-configure-windows 'article) (goto-char (point-min)) --- 1976,1985 ---- (run-hooks 'gnus-article-display-hook)) ;; Do page break. (goto-char (point-min)) ! (setq gnus-page-broken ! (when gnus-break-pages ! (gnus-narrow-to-page) ! t))) (gnus-set-mode-line 'article) (gnus-configure-windows 'article) (goto-char (point-min)) *************** *** 2081,2087 **** (and (pos-visible-in-window-p) ;Not continuation line. (eobp))) ;; Nothing in this page. ! (if (or (not gnus-break-pages) (save-excursion (save-restriction (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? --- 2089,2095 ---- (and (pos-visible-in-window-p) ;Not continuation line. (eobp))) ;; Nothing in this page. ! (if (or (not gnus-page-broken) (save-excursion (save-restriction (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? *************** *** 2103,2109 **** Argument LINES specifies lines to be scrolled down." (interactive "p") (move-to-window-line 0) ! (if (and gnus-break-pages (bobp) (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? (progn --- 2111,2117 ---- Argument LINES specifies lines to be scrolled down." (interactive "p") (move-to-window-line 0) ! (if (and gnus-page-broken (bobp) (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? (progn *** pub/rgnus/lisp/gnus-group.el Mon Mar 31 16:40:55 1997 --- rgnus/lisp/gnus-group.el Sun Apr 6 21:51:36 1997 *************** *** 2178,2184 **** (interactive (list gnus-group-sort-function current-prefix-arg)) (funcall gnus-group-sort-alist-function (gnus-make-sort-function func) reverse) ! (gnus-group-list-groups)) (defun gnus-group-sort-flat (func reverse) ;; We peel off the dummy group from the alist. --- 2178,2185 ---- (interactive (list gnus-group-sort-function current-prefix-arg)) (funcall gnus-group-sort-alist-function (gnus-make-sort-function func) reverse) ! (gnus-group-list-groups) ! (gnus-dribble-touch)) (defun gnus-group-sort-flat (func reverse) ;; We peel off the dummy group from the alist. *** pub/rgnus/lisp/gnus-picon.el Fri Mar 7 23:51:20 1997 --- rgnus/lisp/gnus-picon.el Sun Apr 6 21:51:36 1997 *************** *** 218,224 **** (if gnus-local-domain (nreverse (message-tokenize-header gnus-local-domain ".")) ! '("")) (nreverse (message-tokenize-header (substring from (1+ at-idx)) "."))))) (set-buffer (get-buffer-create --- 218,224 ---- (if gnus-local-domain (nreverse (message-tokenize-header gnus-local-domain ".")) ! '(".")) (nreverse (message-tokenize-header (substring from (1+ at-idx)) "."))))) (set-buffer (get-buffer-create *************** *** 347,353 **** (domainp (and gnus-picons-display-as-address dots)) picons found bar-ann cur first) (when (string-match "/MISC" database) ! (setq addrs '(""))) (while (and addrs (file-accessible-directory-p path)) (setq cur (pop addrs) --- 347,353 ---- (domainp (and gnus-picons-display-as-address dots)) picons found bar-ann cur first) (when (string-match "/MISC" database) ! (setq addrs '("."))) (while (and addrs (file-accessible-directory-p path)) (setq cur (pop addrs) *** pub/rgnus/lisp/gnus-score.el Wed Apr 2 14:21:04 1997 --- rgnus/lisp/gnus-score.el Sun Apr 6 21:51:37 1997 *************** *** 353,359 **** :group 'gnus-score-default :type '(choice (const :tag "temporary" t) (const :tag "permanent" p) ! (const :tag "immediate" i))) (defcustom gnus-score-after-write-file-function nil "Function called with the name of the score file just written to disk." --- 353,360 ---- :group 'gnus-score-default :type '(choice (const :tag "temporary" t) (const :tag "permanent" p) ! (const :tag "immediate" i) ! (const :tag "ask" nil))) (defcustom gnus-score-after-write-file-function nil "Function called with the name of the score file just written to disk." *** pub/rgnus/lisp/gnus-srvr.el Sat Mar 22 15:55:08 1997 --- rgnus/lisp/gnus-srvr.el Sun Apr 6 21:51:37 1997 *************** *** 678,684 **** (save-excursion (beginning-of-line) (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) ! (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method)))) (defun gnus-browse-unsubscribe-group () "Toggle subscription of the current group in the browse buffer." --- 678,687 ---- (save-excursion (beginning-of-line) (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) ! (gnus-group-prefixed-name ! ;; Remove text props. ! (format "%s" (match-string 1)) ! gnus-browse-current-method)))) (defun gnus-browse-unsubscribe-group () "Toggle subscription of the current group in the browse buffer." *** pub/rgnus/lisp/gnus-sum.el Wed Apr 2 14:21:07 1997 --- rgnus/lisp/gnus-sum.el Sun Apr 6 21:51:39 1997 *************** *** 714,719 **** --- 714,720 ---- ;;; Internal variables (defvar gnus-scores-exclude-files nil) + (defvar gnus-page-broken nil) (defvar gnus-original-article nil) (defvar gnus-article-internal-prepare-hook nil) *************** *** 5127,5134 **** (progn (gnus-message 5 "Returning to the group buffer") (setq entered t) ! (set-buffer current-buffer) ! (gnus-summary-exit) (run-hooks 'gnus-group-no-more-groups-hook)) ;; We try to enter the target group. (gnus-group-jump-to-group target-group) --- 5128,5136 ---- (progn (gnus-message 5 "Returning to the group buffer") (setq entered t) ! (when (buffer-live-p current-buffer) ! (set-buffer current-buffer) ! (gnus-summary-exit)) (run-hooks 'gnus-group-no-more-groups-hook)) ;; We try to enter the target group. (gnus-group-jump-to-group target-group) *************** *** 6428,6434 **** (gnus-eval-in-buffer-window gnus-article-buffer (widen) (goto-char (point-min)) ! (when gnus-break-pages (gnus-narrow-to-page)))) (defun gnus-summary-end-of-article () --- 6430,6436 ---- (gnus-eval-in-buffer-window gnus-article-buffer (widen) (goto-char (point-min)) ! (when gnus-page-broken (gnus-narrow-to-page)))) (defun gnus-summary-end-of-article () *************** *** 6441,6447 **** (widen) (goto-char (point-max)) (recenter -3) ! (when gnus-break-pages (gnus-narrow-to-page)))) (defun gnus-summary-print-article (&optional filename) --- 6443,6449 ---- (widen) (goto-char (point-max)) (recenter -3) ! (when gnus-page-broken (gnus-narrow-to-page)))) (defun gnus-summary-print-article (&optional filename) *************** *** 6481,6487 **** gnus-visual) (gnus-summary-select-article nil 'force))) (gnus-summary-goto-subject gnus-current-article) - ; (gnus-configure-windows 'article) (gnus-summary-position-point)) (defun gnus-summary-verbose-headers (&optional arg) --- 6483,6488 ---- *************** *** 6753,6759 **** ;; Copy the marks to other group. (gnus-add-marked-articles to-group (cdar marks) (list to-article) info)) ! (setq marks (cdr marks))))) ;; Update the Xref header in this article to point to ;; the new crossposted article we have just created. --- 6754,6765 ---- ;; Copy the marks to other group. (gnus-add-marked-articles to-group (cdar marks) (list to-article) info)) ! (setq marks (cdr marks))) ! ! (gnus-dribble-enter ! (concat "(gnus-group-set-info '" ! (gnus-prin1-to-string (gnus-get-info to-group)) ! ")")))) ;; Update the Xref header in this article to point to ;; the new crossposted article we have just created. *** pub/rgnus/lisp/gnus-topic.el Wed Apr 2 14:21:07 1997 --- rgnus/lisp/gnus-topic.el Sun Apr 6 21:51:40 1997 *************** *** 572,577 **** --- 572,578 ---- (forward-line 1) (setq unfound nil))) (when (and unfound + topic (not (gnus-topic-goto-missing-topic topic))) (gnus-topic-insert-topic-line topic t t (car (gnus-topic-find-topology topic)) nil 0))))) *** pub/rgnus/lisp/gnus-util.el Mon Mar 31 16:40:59 1997 --- rgnus/lisp/gnus-util.el Sun Apr 6 21:51:40 1997 *************** *** 525,531 **** (defun gnus-kill-all-overlays () "Delete all overlays in the current buffer." ! (when (fboundp 'overlay-lists) (let* ((overlayss (overlay-lists)) (buffer-read-only nil) (overlays (nconc (car overlayss) (cdr overlayss)))) --- 525,531 ---- (defun gnus-kill-all-overlays () "Delete all overlays in the current buffer." ! (unless gnus-xemacs (let* ((overlayss (overlay-lists)) (buffer-read-only nil) (overlays (nconc (car overlayss) (cdr overlayss)))) *** pub/rgnus/lisp/gnus-xmas.el Wed Apr 2 14:21:08 1997 --- rgnus/lisp/gnus-xmas.el Sun Apr 6 21:51:40 1997 *************** *** 183,190 **** --- 183,193 ---- (defun gnus-xmas-summary-set-display-table () ;; Setup the display table -- like gnus-summary-setup-display-table, + ;; Setup the display table -- like `gnus-summary-setup-display-table', ;; but done in an XEmacsish way. (let ((table (make-display-table)) + ;; Nix out all the control chars... + (default-table (specifier-instance current-display-table)) (i 32)) ;; Nix out all the control chars... (while (>= (setq i (1- i)) 0) *************** *** 197,204 **** (let ((i 256)) (while (>= (setq i (1- i)) 127) ;; Only modify if the entry is nil. ! (unless (aref table i) ! (aset table i [??])))) (add-spec-to-specifier current-display-table table (current-buffer) nil))) (defun gnus-xmas-add-hook (hook function &optional append local) --- 200,210 ---- (let ((i 256)) (while (>= (setq i (1- i)) 127) ;; Only modify if the entry is nil. ! (or (aref table i) ! ;; Only modify if the default entry is nil. ! (or (aref default-table i) ! (aset table i [??])))) ! ;; Can't use `set-specifier' because of a bug in 19.14 and earlier (add-spec-to-specifier current-display-table table (current-buffer) nil))) (defun gnus-xmas-add-hook (hook function &optional append local) *** pub/rgnus/lisp/gnus.el Wed Apr 2 14:21:09 1997 --- rgnus/lisp/gnus.el Sun Apr 6 21:51:42 1997 *************** *** 226,232 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.4.40" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) --- 226,232 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.4.41" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) *** pub/rgnus/lisp/pop3.el Thu Mar 20 17:38:43 1997 --- rgnus/lisp/pop3.el Sun Apr 6 21:51:42 1997 *************** *** 4,10 **** ;; Author: Richard L. Pieri ;; Keywords: mail, pop3 ! ;; Version: 1.3c ;; This file is part of GNU Emacs. --- 4,10 ---- ;; Author: Richard L. Pieri ;; Keywords: mail, pop3 ! ;; Version: 1.3e ;; This file is part of GNU Emacs. *************** *** 229,235 **** (nth 1 date) (nth 0 date) (nth 3 date) (nth 2 date))) )) ! (setq From_ (format "From %s %s\n" from date)) (while (string-match "," From_) (setq From_ (concat (substring From_ 0 (match-beginning 0)) (substring From_ (match-end 0))))) --- 229,235 ---- (nth 1 date) (nth 0 date) (nth 3 date) (nth 2 date))) )) ! (setq From_ (format "\nFrom %s %s\n" from date)) (while (string-match "," From_) (setq From_ (concat (substring From_ 0 (match-beginning 0)) (substring From_ (match-end 0))))) *************** *** 308,318 **** ;; bill@att.com (goto-char start)) (setq pop3-read-point (point-marker)) ! (goto-char (match-beginning 0)) ! (backward-char 2) ! (if (not (looking-at "\r\n")) ! (insert "\r\n")) ! (re-search-forward "\\.\r\n") (goto-char (match-beginning 0)) (setq end (point-marker)) (pop3-clean-region start end) --- 308,320 ---- ;; bill@att.com (goto-char start)) (setq pop3-read-point (point-marker)) ! ;; this code does not seem to work for some POP servers... ! ;; and I cannot figure out why not. ! ; (goto-char (match-beginning 0)) ! ; (backward-char 2) ! ; (if (not (looking-at "\r\n")) ! ; (insert "\r\n")) ! ; (re-search-forward "\\.\r\n") (goto-char (match-beginning 0)) (setq end (point-marker)) (pop3-clean-region start end) *** pub/rgnus/lisp/wid-browse.el Sun Mar 23 02:58:25 1997 --- rgnus/lisp/wid-browse.el Sun Apr 6 21:51:44 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: extensions ! ;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: extensions ! ;; Version: 1.70 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *** pub/rgnus/lisp/wid-edit.el Sun Mar 23 02:58:26 1997 --- rgnus/lisp/wid-edit.el Sun Apr 6 21:51:44 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: extensions ! ;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: extensions ! ;; Version: 1.70 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *************** *** 24,29 **** --- 24,34 ---- (autoload 'pp-to-string "pp") (autoload 'Info-goto-node "info") + (when (string-match "XEmacs" emacs-version) + (condition-case nil + (require 'overlay) + (error (load-library "x-overlay")))) + (if (string-match "XEmacs" emacs-version) ;; XEmacs spell `intangible' as `atomic'. (defun widget-make-intangible (from to side) *************** *** 380,385 **** --- 385,425 ---- (goto-char (point-max)) result))) + (defface widget-inactive-face '((((class grayscale color) + (background dark)) + (:foreground "light gray")) + (((class grayscale color) + (background light)) + (:foreground "dark gray")) + (t + (:italic t))) + "Face used for inactive widgets." + :group 'widgets) + + (defun widget-specify-inactive (widget from to) + "Make WIDGET inactive for user modifications." + (unless (widget-get widget :inactive) + (let ((overlay (make-overlay from to nil t nil))) + (overlay-put overlay 'face 'widget-inactive-face) + (overlay-put overlay 'evaporate 't) + (overlay-put overlay (if (string-match "XEmacs" emacs-version) + 'read-only + 'modification-hooks) '(widget-overlay-inactive)) + (widget-put widget :inactive overlay)))) + + (defun widget-overlay-inactive (&rest junk) + "Ignoring the arguments, signal an error." + (unless inhibit-read-only + (error "Attempt to modify inactive widget"))) + + + (defun widget-specify-active (widget) + "Make WIDGET active for user modifications." + (let ((inactive (widget-get widget :inactive))) + (when inactive + (delete-overlay inactive) + (widget-put widget :inactive nil)))) + ;;; Widget Properties. (defsubst widget-type (widget) *************** *** 415,420 **** --- 455,461 ---- (widget-member (get (car widget) 'widget-type) property)) (t nil))) + ;;;###autoload (defun widget-apply (widget property &rest args) "Apply the value of WIDGET's PROPERTY to the widget itself. ARGS are passed as extra arguments to the function." *************** *** 440,445 **** --- 481,492 ---- (cons (list (car vals)) (cdr vals))) (t nil))) + (defun widget-apply-action (widget &optional event) + "Apply :action in WIDGET in response to EVENT." + (if (widget-apply widget :active) + (widget-apply widget :action event) + (error "Attempt to perform action on inactive widget"))) + ;;; Glyphs. (defcustom widget-glyph-directory (concat data-directory "custom/") *************** *** 459,467 **** IMAGE should either be a glyph, or a name sans extension of an xpm or xbm file located in `widget-glyph-directory'. ! WARNING: If you call this with a glyph, and you want theuser to be able to activate the glyph, make sure it is unique. If you use the ! same glyph for multiple widgets, " (cond ((not (and (string-match "XEmacs" emacs-version) widget-glyph-enable (fboundp 'make-glyph) --- 506,515 ---- IMAGE should either be a glyph, or a name sans extension of an xpm or xbm file located in `widget-glyph-directory'. ! WARNING: If you call this with a glyph, and you want the user to be able to activate the glyph, make sure it is unique. If you use the ! same glyph for multiple widgets, activating any of the glyphs will ! cause the last created widget to be activated." (cond ((not (and (string-match "XEmacs" emacs-version) widget-glyph-enable (fboundp 'make-glyph) *************** *** 659,665 **** (interactive "@d") (let ((field (get-text-property pos 'field))) (if field ! (widget-apply field :action event) (call-interactively (lookup-key widget-global-map (this-command-keys)))))) --- 707,713 ---- (interactive "@d") (let ((field (get-text-property pos 'field))) (if field ! (widget-apply-action field event) (call-interactively (lookup-key widget-global-map (this-command-keys)))))) *************** *** 670,681 **** (event-glyph event)) (let ((widget (glyph-property (event-glyph event) 'widget))) (if widget ! (widget-apply widget :action event) (message "You clicked on a glyph.")))) ((event-point event) (let ((button (get-text-property (event-point event) 'button))) (if button ! (widget-apply button :action event) (call-interactively (or (lookup-key widget-global-map [ button2 ]) (lookup-key widget-global-map [ down-mouse-2 ]) --- 718,729 ---- (event-glyph event)) (let ((widget (glyph-property (event-glyph event) 'widget))) (if widget ! (widget-apply-action widget event) (message "You clicked on a glyph.")))) ((event-point event) (let ((button (get-text-property (event-point event) 'button))) (if button ! (widget-apply-action button event) (call-interactively (or (lookup-key widget-global-map [ button2 ]) (lookup-key widget-global-map [ down-mouse-2 ]) *************** *** 690,696 **** (event-glyph event)) (let ((widget (glyph-property (event-glyph event) 'widget))) (if widget ! (widget-apply widget :action event) (message "You clicked on a glyph."))) (call-interactively (lookup-key widget-global-map (this-command-keys))))) --- 738,744 ---- (event-glyph event)) (let ((widget (glyph-property (event-glyph event) 'widget))) (if widget ! (widget-apply-action widget event) (message "You clicked on a glyph."))) (call-interactively (lookup-key widget-global-map (this-command-keys))))) *************** *** 699,705 **** (interactive "@d") (let ((button (get-text-property pos 'button))) (if button ! (widget-apply button :action event) (let ((command (lookup-key widget-global-map (this-command-keys)))) (when (commandp command) (call-interactively command)))))) --- 747,753 ---- (interactive "@d") (let ((button (get-text-property pos 'button))) (if button ! (widget-apply-action button event) (let ((command (lookup-key widget-global-map (this-command-keys)))) (when (commandp command) (call-interactively command)))))) *************** *** 947,952 **** --- 995,1003 ---- :value-inline 'widget-default-value-inline :menu-tag-get 'widget-default-menu-tag-get :validate (lambda (widget) nil) + :active 'widget-default-active + :activate 'widget-specify-active + :deactivate 'widget-default-deactivate :action 'widget-default-action :notify 'widget-default-notify) *************** *** 1077,1083 **** (inhibit-read-only t) after-change-functions) (widget-apply widget :value-delete) ! (delete-region from to) (set-marker from nil) (set-marker to nil))) --- 1128,1136 ---- (inhibit-read-only t) after-change-functions) (widget-apply widget :value-delete) ! (when (< from to) ! ;; Kludge: this doesn't need to be true for empty formats. ! (delete-region from to)) (set-marker from nil) (set-marker to nil))) *************** *** 1101,1106 **** --- 1154,1172 ---- (widget-get widget :tag) (widget-princ-to-string (widget-get widget :value)))) + (defun widget-default-active (widget) + "Return t iff this widget active (user modifiable)." + (and (not (widget-get widget :inactive)) + (let ((parent (widget-get widget :parent))) + (or (null parent) + (widget-apply parent :active))))) + + (defun widget-default-deactivate (widget) + "Make WIDGET inactive for user modifications." + (widget-specify-inactive widget + (widget-get widget :from) + (widget-get widget :to))) + (defun widget-default-action (widget &optional event) ;; Notify the parent when a widget change (let ((parent (widget-get widget :parent))) *************** *** 1196,1202 **** (defun widget-gui-action (widget) "Apply :action for WIDGET." ! (widget-apply widget :action (this-command-keys))) ;;; The `link' Widget. --- 1262,1268 ---- (defun widget-gui-action (widget) "Apply :action for WIDGET." ! (widget-apply-action widget (this-command-keys))) ;;; The `link' Widget. *************** *** 1492,1498 **** :on "[X]" :on-glyph "check1" :off "[ ]" ! :off-glyph "check0") ;;; The `checklist' Widget. --- 1558,1574 ---- :on "[X]" :on-glyph "check1" :off "[ ]" ! :off-glyph "check0" ! :action 'widget-checkbox-action) ! ! (defun widget-checkbox-action (widget &optional event) ! "Toggle checkbox, notify parent, and set active state of sibling." ! (widget-toggle-action widget event) ! (let ((sibling (widget-get-sibling widget))) ! (when sibling ! (if (widget-value widget) ! (widget-apply sibling :activate) ! (widget-apply sibling :deactivate))))) ;;; The `checklist' Widget. *************** *** 1549,1555 **** ((eq escape ?v) (setq child (cond ((not chosen) ! (widget-create-child widget type)) ((widget-get type :inline) (widget-create-child-value widget type (cdr chosen))) --- 1625,1633 ---- ((eq escape ?v) (setq child (cond ((not chosen) ! (let ((child (widget-create-child widget type))) ! (widget-apply child :deactivate) ! child)) ((widget-get type :inline) (widget-create-child-value widget type (cdr chosen))) *************** *** 1735,1741 **** (setq child (if chosen (widget-create-child-value widget type value) ! (widget-create-child widget type)))) (t (error "Unknown escape `%c'" escape))))) ;; Update properties. --- 1813,1821 ---- (setq child (if chosen (widget-create-child-value widget type value) ! (widget-create-child widget type))) ! (unless chosen ! (widget-apply child :deactivate))) (t (error "Unknown escape `%c'" escape))))) ;; Update properties. *************** *** 1795,1801 **** (widget-apply current :match value)))) (widget-value-set button match) (if match ! (widget-value-set current value)) (setq found (or found match)))))) (defun widget-radio-validate (widget) --- 1875,1884 ---- (widget-apply current :match value)))) (widget-value-set button match) (if match ! (progn ! (widget-value-set current value) ! (widget-apply current :activate)) ! (widget-apply current :deactivate)) (setq found (or found match)))))) (defun widget-radio-validate (widget) *************** *** 1822,1830 **** children (cdr children)) (let* ((button (widget-get current :button))) (cond ((eq child button) ! (widget-value-set button t)) ((widget-value button) ! (widget-value-set button nil))))))) ;; Pass notification to parent. (widget-apply widget :notify child event)) --- 1905,1915 ---- children (cdr children)) (let* ((button (widget-get current :button))) (cond ((eq child button) ! (widget-value-set button t) ! (widget-apply current :activate)) ((widget-value button) ! (widget-value-set button nil) ! (widget-apply current :deactivate))))))) ;; Pass notification to parent. (widget-apply widget :notify child event)) *************** *** 1967,1973 **** (setq children (cdr children))) (setcdr children (cons child (cdr children))))))) (widget-setup) ! (widget-apply widget :notify widget)) (defun widget-editable-list-delete-at (widget child) ;; Delete child from list of children. --- 2052,2058 ---- (setq children (cdr children))) (setcdr children (cons child (cdr children))))))) (widget-setup) ! widget (widget-apply widget :notify widget)) (defun widget-editable-list-delete-at (widget child) ;; Delete child from list of children. *** pub/rgnus/lisp/widget.el Sun Mar 23 02:58:26 1997 --- rgnus/lisp/widget.el Sun Apr 6 21:51:44 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: help, extensions, faces, hypermedia ! ;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: help, extensions, faces, hypermedia ! ;; Version: 1.70 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *************** *** 27,33 **** (set (car keywords) (car keywords))) (setq keywords (cdr keywords))))))) ! (define-widget-keywords :sibling-args :delete-button-args :insert-button-args :append-button-args :button-args :tag-glyph :off-glyph :on-glyph :valid-regexp :secret :sample-face :sample-face-get :case-fold :widget-doc --- 27,34 ---- (set (car keywords) (car keywords))) (setq keywords (cdr keywords))))))) ! (define-widget-keywords :deactivate :active :inactive :activate ! :sibling-args :delete-button-args :insert-button-args :append-button-args :button-args :tag-glyph :off-glyph :on-glyph :valid-regexp :secret :sample-face :sample-face-get :case-fold :widget-doc *************** *** 45,50 **** --- 46,52 ---- ;; These autoloads should be deleted when the file is added to Emacs. (unless (fboundp 'load-gc) + (autoload 'widget-apply "wid-edit") (autoload 'widget-create "wid-edit") (autoload 'widget-insert "wid-edit") (autoload 'widget-browse "wid-browse" nil t) *** pub/rgnus/lisp/ChangeLog Wed Apr 2 14:21:01 1997 --- rgnus/lisp/ChangeLog Sun Apr 6 21:51:32 1997 *************** *** 1,3 **** --- 1,64 ---- + Sun Apr 6 21:46:05 1997 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.41 is released. + + Thu Apr 3 21:08:57 1997 Hrvoje Niksic + + * gnus-xmas.el (gnus-xmas-summary-set-display-table): Don't change + the values that are non-nil in the default table. + + Sun Apr 6 20:58:38 1997 Kim-Minh Kaplan + + * gnus-picon.el (gnus-picons-insert-face-if-exists): "." instead + of "". + + Sun Apr 6 20:19:49 1997 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-sort-groups): Touch dribble. + + Sun Apr 6 19:28:19 1997 Stainless Steel Rat + + * pop3.el (pop3-quit): New version. + + Fri Apr 4 21:46:34 1997 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-page-broken): New variable. + (gnus-article-prepare): Use it. + + Fri Apr 4 05:08:00 1997 Gunnar Horrigmo + + * gnus-art.el (article-treat-overstrike): Search from beginning of + article. + + Thu Apr 3 15:16:05 1997 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-hidden-text-p): Be more thorough. + + Thu Apr 3 12:23:44 1997 Per Abrahamsen + + * gnus-score.el: (gnus-score-default-duration): Accept nil in + :type. + + Thu Apr 3 05:49:56 1997 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-next-group): Make sure buffer is alive + before switching to it. + + Wed Apr 2 12:39:15 1997 Steven L Baur + + * gnus-util.el (gnus-kill-all-overlays): Force Gnus to use extents + even when overlays are available. (From a patch by MORIOKA + Tomohiko). + + Thu Apr 3 05:28:03 1997 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-goto-missing-group): Make sure topic + exists. + + * gnus-srvr.el (gnus-browse-group-name): Remove text props. + + * gnus-sum.el (gnus-summary-move-article): Enter into dribble. + Wed Apr 2 14:12:45 1997 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.4.40 is released. *** pub/rgnus/texi/custom.texi Sun Mar 23 02:58:26 1997 --- rgnus/texi/custom.texi Sun Apr 6 21:51:45 1997 *************** *** 13,19 **** @comment node-name, next, previous, up @top The Customization Library ! Version: 1.65 @menu * Introduction:: --- 13,19 ---- @comment node-name, next, previous, up @top The Customization Library ! Version: 1.70 @menu * Introduction:: *************** *** 272,278 **** It is possible to specify that a face should have different attributes on different device types. For example, a face may make text red on a ! color device, and bold on a monochrome device. The way this is presented in the customization buffer is to have a list of display specifications, and for each display specification a list of --- 272,279 ---- It is possible to specify that a face should have different attributes on different device types. For example, a face may make text red on a ! color device, and bold on a monochrome device. You do this by ! activating `Edit All' in the state menu. The way this is presented in the customization buffer is to have a list of display specifications, and for each display specification a list of *************** *** 282,289 **** @example *** custom-invalid-face: (sample) [ ] Face used when the customize item is invalid. ! [INS] [DEL] Display: [ ] Type: [ ] X [ ] TTY [X] Class: [X] Color [ ] Grayscale [ ] Monochrome [ ] Background: [ ] Light [ ] Dark Attributes: [ ] Bold: off --- 283,291 ---- @example *** custom-invalid-face: (sample) + State: this item is unchanged from its factory setting. [ ] Face used when the customize item is invalid. ! [INS] [DEL] Display: [ ] Type: [ ] X [ ] PM [ ] Win32 [ ] DOS [ ] TTY [X] Class: [X] Color [ ] Grayscale [ ] Monochrome [ ] Background: [ ] Light [ ] Dark Attributes: [ ] Bold: off *************** *** 303,309 **** @end example This has two display specifications. The first will match all color ! displays, independently on whether the device is X11 or a tty, and whether background color is dark or light. For devices matching this specification, @samp{custom-invalid-face} will force text to be displayed in yellow on red, but leave all other attributes alone. --- 305,311 ---- @end example This has two display specifications. The first will match all color ! displays, independently on what window system the device belongs to, and whether background color is dark or light. For devices matching this specification, @samp{custom-invalid-face} will force text to be displayed in yellow on red, but leave all other attributes alone. *************** *** 318,325 **** the check boxes. The first checkbox in each line in the display specification is special. It specify whether this particular property will even be relevant. By not checking the box in the first display, we ! match all device types, also device types other than X11 and tty, for ! example ms-windows, nextstep, and mac os. After modifying the face, you can activate the state button to make the changes take effect. The menu items in the state button menu is similar --- 320,326 ---- the check boxes. The first checkbox in each line in the display specification is special. It specify whether this particular property will even be relevant. By not checking the box in the first display, we ! match all device types, also device types other than those listed. After modifying the face, you can activate the state button to make the changes take effect. The menu items in the state button menu is similar *************** *** 620,627 **** When you save the customizations, call to @code{custom-set-variables}, @code{custom-set-faces} are inserted into the file specified by @code{custom-file}. By default @code{custom-file} is your @file{.emacs} ! file. The two functions will initialize variables and faces as you have ! specified. @node Wishlist, , The Init File, Top @comment node-name, next, previous, up --- 621,629 ---- When you save the customizations, call to @code{custom-set-variables}, @code{custom-set-faces} are inserted into the file specified by @code{custom-file}. By default @code{custom-file} is your @file{.emacs} ! file. If you use another file, you must explicitly load it yourself. ! The two functions will initialize variables and faces as you have ! specified. @node Wishlist, , The Init File, Top @comment node-name, next, previous, up *************** *** 634,641 **** should not be allowed to select the @samp{Factory} menu item. @item ! We need @strong{much} better support for keyboard operations in the ! customize buffer. @item Integrate with @file{w3} so you can customization buffers with much --- 636,642 ---- should not be allowed to select the @samp{Factory} menu item. @item ! Better support for keyboard operations in the customize buffer. @item Integrate with @file{w3} so you can customization buffers with much *************** *** 652,661 **** variable. @item - There should be a way to see only the "current" display when editing a - face, and that should be "on" by default. - - @item Support undo using lmi's @file{gnus-undo.el}. @item --- 653,658 ---- *************** *** 676,681 **** --- 673,684 ---- item in XEmacs. This is like the *Completions* buffer in XEmacs. Suggested by Jens Lautenbacher @samp{}.@refill + + @item + Use @file{font.el} to extract font attributes from rogue faces. + + @item + Empty customization groups should start open (harder than it looks). @end itemize *** pub/rgnus/texi/gnus.texi Wed Apr 2 14:21:20 1997 --- rgnus/texi/gnus.texi Sun Apr 6 21:51:48 1997 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Gnus 5.4.40 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Gnus 5.4.41 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 287,293 **** @tex @titlepage ! @title Gnus 5.4.40 Manual @author by Lars Magne Ingebrigtsen @page --- 287,293 ---- @tex @titlepage ! @title Gnus 5.4.41 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 323,329 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Gnus 5.4.40. @end ifinfo --- 323,329 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Gnus 5.4.41. @end ifinfo *************** *** 13997,14008 **** --- 13997,14010 ---- Raja R. Harinath, Hisashige Kenji, @c Hisashige Marc Horowitz, + Gunnar Horrigmo, François Felix Ingrand, Ishikawa Ichiro, @c Ishikawa Lee Iverson, Rajappa Iyer, Randell Jesup, Fred Johansen, + Kim-Minh Kaplan, Greg Klanderman, Karl Kleinpaste, Peter Skov Knudsen, *** pub/rgnus/texi/message.texi Wed Apr 2 14:21:21 1997 --- rgnus/texi/message.texi Sun Apr 6 21:51:48 1997 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Message 5.4.40 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Message 5.4.41 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 39,45 **** @tex @titlepage ! @title Message 5.4.40 Manual @author by Lars Magne Ingebrigtsen @page --- 39,45 ---- @tex @titlepage ! @title Message 5.4.41 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 79,85 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Message 5.4.40. Message is distributed with the Gnus distribution bearing the same version number as this manual has. --- 79,85 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Message 5.4.41. Message is distributed with the Gnus distribution bearing the same version number as this manual has. *** pub/rgnus/texi/widget.texi Mon Mar 24 01:28:39 1997 --- rgnus/texi/widget.texi Sun Apr 6 21:51:48 1997 *************** *** 1,6 **** \input texinfo.tex ! @c $Id: widget.texi,v 3.64 1997/03/23 01:55:29 larsi Exp $ @c %**start of header @setfilename widget --- 1,6 ---- \input texinfo.tex ! @c $Id: widget.texi,v 1.98 1997/04/02 16:26:18 abraham Exp $ @c %**start of header @setfilename widget *************** *** 15,21 **** @comment node-name, next, previous, up @top The Emacs Widget Library ! Version: 1.65 @menu * Introduction:: --- 15,21 ---- @comment node-name, next, previous, up @top The Emacs Widget Library ! Version: 1.70 @menu * Introduction:: *************** *** 1207,1212 **** --- 1207,1249 ---- Return the name of @var{widget}, a symbol. @end defun + Widgets can be in two states: active, which means they are modifiable by + the user, or inactive, which means they cannot be modified by the user. + You can query or set the state with the following code: + + @lisp + ;; Examine if @var{widget} is active or not. + (if (widget-apply @var{widget} :active) + (message "Widget is active.") + (message "Widget is inactive.") + + ;; Make @var{widget} inactive. + (widget-apply @var{widget} :deactivate) + + ;; Make @var{widget} active. + (widget-apply @var{widget} :activate) + @end lisp + + A widget is inactive if itself, or any of its ancestors (found by + following the @code{:parent} link) have been deactivated. To make sure + a widget is really active, you must therefore activate both itself, and + all its ancestors. + + @lisp + (while widget + (widget-apply widget :activate) + (setq widget (widget-get widget :parent))) + @end lisp + + You can check if a widget has been made inactive by examining the value + of @code{:inactive} keyword. If this is non-nil, the widget itself has + been deactivated. This is different from using the @code{:active} + keyword, in that the later tell you if the widget @strong{or} any of its + ancestors have been deactivated. Do not attempt to set the + @code{:inactive} keyword directly. Use the @code{:activate} + @code{:deactivated} keywords instead. + + @node Defining New Widgets, Widget Wishlist., Widget Properties, Top @comment node-name, next, previous, up @section Defining New Widgets *************** *** 1337,1349 **** The functions used in many widgets, like @code{widget-item-convert-widget}, should not have names that are specific to the first widget where I happended to use them. - - @item - Unchecked items in a @code{radio-button-choice} or @code{checklist} - should be grayed out, and the subwidgets should somehow become inactive. - This could perhaps be implemented by binding @code{widget-inactive} to t - when inserting the grayed out subwidget, and let the widget-specify - functions check that variable. @item Flag to make @code{widget-move} skip a specified button. --- 1374,1379 ----