From 50733a269e82937750ff398d6bc9336f2ca8f26c Mon Sep 17 00:00:00 2001 From: hayashi Date: Mon, 21 Feb 2000 05:09:20 +0000 Subject: [PATCH] (mime-preview-follow-current-entity): Bug fixes. (mime-preview-toggle-button): New function. --- ChangeLog | 32 ++++++++++ mime-view.el | 201 +++++++++++++++++++++++++++++++++++----------------------- semi-def.el | 8 ++- 3 files changed, 157 insertions(+), 84 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8393150..b1b0fa9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,35 @@ +2000-02-21 Yoshiki Hayashi + + * EMY 1.13.4 is released. + +2000-02-20 Yoshiki Hayashi + + * semi-def.el (mime-insert-button): Insert newline to avoid + face property concatenation. + +2000-02-20 Yoshiki Hayashi + + * mime-view.el (mime-preview-toggle-button): New function. + (mime-view-define-keymap): Define C-h C-t b to + mime-preview-toggle-button. + (mime-preview-buttonize): Use it. + (mime-preview-unbuttonize): Ditto. + (mime-preview-type): Call mime-preview-toggle-body. + +2000-02-20 Yoshiki Hayashi + + * mime-view.el (mime-preview-toggle-header): Add optional + argument show. When show, always displays rather than toggle. + (mime-preview-toggle-all-header): Ditto. + (mime-preview-toggle-content): Ditto. + +2000-02-20 Yoshiki Hayashi + + * mime-view.el (mime-preview-follow-current-entity): + Delete header and insert new one. + (mime-preview-toggle-header): Don't manipulate entity button. + (mime-preview-toggle-all-header): New function. + 2000-02-16 Yoshiki Hayashi * mime-view.el (mime-preview-quit): Fix bug which unconditionally diff --git a/mime-view.el b/mime-view.el index 12507e8..740e1bb 100644 --- a/mime-view.el +++ b/mime-view.el @@ -314,6 +314,16 @@ mother-buffer." `(eq (cdr (or (assq '*children ,situation))) 'invisible)) +(defmacro mime-view-button-is-visible (situation) + ;; Kludge. + `(or (eq (or (cdr (assq '*entity-button ,situation)) + (cdr (assq 'entity-button ,situation))) + 'visible) + (and (not (eq (or (cdr (assq '*entity-button ,situation)) + (cdr (assq 'entity-button ,situation))) + 'invisible)) + (mime-view-entity-button-visible-p entity)))) + ;;; @ presentation of preview ;;; @@ -916,70 +926,29 @@ With prefix, it prompts for coding-system." (defun mime-preview-type () "View part as text without code conversion." (interactive) - (let ((inhibit-read-only t) - (entity (get-text-property (point) 'mime-view-entity)) - (situation (get-text-property (point) 'mime-view-situation)) - (mime-view-force-inline-types t) - start) - (when (and entity - (not (get-text-property (point) 'mime-view-entity-header)) - (not (memq (mime-entity-media-type entity) - '(multipart message)))) - (setq start (or (and (not (mime-entity-parent entity)) - (1+ (previous-single-property-change - (point) - 'mime-view-entity-header))) - (and (not (eq (point) (point-min))) - (not (eq (get-text-property (1- (point)) - 'mime-view-entity) - entity)) - (point)) - (previous-single-property-change (point) - 'mime-view-entity) - (point))) - (delete-region start - (1- - (or (next-single-property-change (point) - 'mime-view-entity) - (point-max)))) - (save-excursion - (save-restriction - (narrow-to-region (point) (point)) - (mime-display-entity entity (if (eq (assq 'body situation) - 'invisible) - situation - (put-alist 'body 'visible - situation)))) - (if (and (bolp) (eolp)) - (delete-char 1)))))) + (mime-preview-toggle-content t)) (defun mime-preview-buttonize () (interactive) (save-excursion (goto-char (point-min)) - (let ((inhibit-read-only t) - point) + (let (point) (while (setq point (next-single-property-change (point) 'mime-view-entity)) (goto-char point) (unless (get-text-property (point) 'mime-button-callback) - (mime-view-insert-entity-button - (get-text-property (point) 'mime-view-entity))))))) + (mime-preview-toggle-button)))))) (defun mime-preview-unbuttonize () (interactive) (save-excursion (goto-char (point-min)) - (let ((inhibit-read-only t) - point) + (let (point) (while (setq point (next-single-property-change (point) 'mime-view-entity)) (goto-char point) - (if (get-text-property (point) 'mime-button-callback) - (delete-region (point) (save-excursion - (goto-char - (next-single-property-change - (point) 'mime-button-callback))))))))) + (when (get-text-property (point) 'mime-button-callback) + (mime-preview-toggle-button)))))) ;;; @ acting-condition @@ -1099,19 +1068,12 @@ With prefix, it prompts for coding-system." (append (mime-entity-situation entity) default-situation)) default-situation))) - (let ((button-is-visible - ;; Kludge. - (or (eq (or (cdr (assq '*entity-button situation)) - (cdr (assq 'entity-button situation))) - 'visible) - (and (not (eq (or (cdr (assq '*entity-button situation)) - (cdr (assq 'entity-button situation))) - 'invisible)) - (mime-view-entity-button-visible-p entity)))) + (let ((button-is-visible (mime-view-button-is-visible situation)) (header-is-visible (mime-view-header-is-visible situation)) (header-presentation-method - (or (cdr (assq 'header-presentation-method situation)) + (or (cdr (assq '*header-presentation-method situation)) + (cdr (assq 'header-presentation-method situation)) (cdr (assq (cdr (assq 'major-mode situation)) mime-header-presentation-method-alist)))) (body-is-visible @@ -1265,8 +1227,16 @@ With prefix, it prompts for coding-system." (define-key mime-view-mode-map "\C-c\C-t\C-h" (function mime-preview-toggle-header)) (define-key mime-view-mode-map + "\C-c\C-th" (function mime-preview-toggle-header)) + (define-key mime-view-mode-map "\C-c\C-t\C-c" (function mime-preview-toggle-content)) (define-key mime-view-mode-map + "\C-c\C-tc" (function mime-preview-toggle-content)) + (define-key mime-view-mode-map + "\C-c\C-tH" (function mime-preview-toggle-all-header)) + (define-key mime-view-mode-map + "\C-c\C-tb" (function mime-preview-toggle-button)) + (define-key mime-view-mode-map "\C-c\C-p" (function mime-preview-print-current-entity)) (define-key mime-view-mode-map "a" (function mime-preview-follow-current-entity)) @@ -1515,8 +1485,6 @@ It calls following-method selected from variable (save-excursion (set-buffer (setq new-buf (get-buffer-create new-name))) (erase-buffer) - (unless header-exists - (insert ?\n)) ;; Compatibility kludge. ;; FSF Emacs can only take substring of current-buffer. (insert @@ -1524,6 +1492,10 @@ It calls following-method selected from variable (set-buffer the-buf) (buffer-substring-no-properties (car position) (cdr position)))) + (if header-exists + (delete-region (goto-char (point-min)) + (re-search-forward "^$")) + (insert "\n")) (goto-char (point-min)) (let ((current-entity (if (and (eq (mime-entity-media-type entity) 'message) @@ -1744,9 +1716,10 @@ If LINES is negative, scroll up LINES lines." nil (point-max))) (cons start end))) -(defun mime-preview-toggle-header () - "Toggle display of entity header." - (interactive) +(defun mime-preview-toggle-header (&optional show) + "Toggle display of entity header. +When prefix is given, it always displays the header." + (interactive "P") (let ((inhibit-read-only t) (mime-view-force-inline-types t) (position (mime-preview-entity-boundary)) @@ -1756,19 +1729,56 @@ If LINES is negative, scroll up LINES lines." (setq header-is-visible (mime-view-header-is-visible situation)) (save-excursion (delete-region (car position) (cdr position)) - (if header-is-visible - (mime-display-entity entity - (put-alist '*entity-button 'visible - (put-alist '*header 'invisible - situation))) - (mime-display-entity entity - (put-alist '*entity-button 'invisible - (put-alist '*header 'visible - situation))))))) - -(defun mime-preview-toggle-content () - "Toggle display of entity body." - (interactive) + (if (or show (not header-is-visible)) + (mime-display-entity + entity + (del-alist '*entity-button + (put-alist '*header 'visible + situation))) + (mime-display-entity + entity + (put-alist '*entity-button + 'visible + (put-alist '*header 'invisible + situation))))))) + +(defun mime-preview-toggle-all-header (&optional show) + "Toggle display of entity header. +When prefix is given, it always displays the header." + (interactive "P") + (let ((inhibit-read-only t) + (mime-view-force-inline-types t) + (position (mime-preview-entity-boundary)) + entity header-is-visible situation) + (setq entity (get-text-property (car position) 'mime-view-entity) + situation (get-text-property (car position) 'mime-view-situation)) + (setq header-is-visible (mime-view-header-is-visible situation)) + (save-excursion + (delete-region (car position) (cdr position)) + (if (or show (not header-is-visible)) + (mime-display-entity + entity + (del-alist '*entity-button + (del-alist '*header + (del-alist '*header-presentation-method + situation)))) + (mime-display-entity + entity + (put-alist + '*entity-button + 'visible + (put-alist + '*header 'invisible + (put-alist '*header-presentation-method + #'(lambda (entity situation) + (mime-insert-header + entity nil '(".*"))) + situation)))))))) + +(defun mime-preview-toggle-content (&optional show) + "Toggle display of entity body. +When prefix is given, it always displays the content." + (interactive "P") (let ((inhibit-read-only t) (mime-view-force-inline-types t) (position (mime-preview-entity-boundary)) @@ -1778,16 +1788,45 @@ If LINES is negative, scroll up LINES lines." (setq situation (if (mime-entity-children entity) ;; Entity body is always invisible for composite types. - (if (mime-view-children-is-invisible situation) - (put-alist '*children 'visible situation) - (put-alist '*children 'invisible situation)) - (if (mime-view-body-is-visible situation) - (put-alist '*body 'invisible situation) - (put-alist '*body 'visible situation)))) + (if (or show (mime-view-children-is-invisible situation)) + (del-alist + '*entity-button + (put-alist '*children 'visible situation)) + (put-alist + '*entity-button 'visible + (put-alist '*children 'invisible situation))) + (if (or show (not (mime-view-body-is-visible situation))) + (del-alist + '*entity-button + (put-alist '*body 'visible situation)) + (put-alist + '*entity-button 'visible + (put-alist '*body 'invisible situation))))) (save-excursion (delete-region (car position) (cdr position)) (mime-display-entity entity situation)))) +(defun mime-preview-toggle-button (&optional show) + "Toggle display of entity button. +When prefix is given, it always displays the content." + (interactive "P") + (let ((inhibit-read-only t) + (mime-view-force-inline-types t) + (position (mime-preview-entity-boundary)) + entity situation button-is-visible) + (setq entity (get-text-property (car position) 'mime-view-entity) + situation (get-text-property (car position) 'mime-view-situation) + button-is-visible (mime-view-button-is-visible situation)) + (save-excursion + (delete-region (car position) (cdr position)) + (if (or show (not button-is-visible)) + (mime-display-entity entity + (put-alist '*entity-button + 'visible situation)) + (mime-display-entity entity + (put-alist '*entity-button + 'invisible situation)))))) + ;;; @@ quitting ;;; diff --git a/semi-def.el b/semi-def.el index 5a836c0..3314750 100644 --- a/semi-def.el +++ b/semi-def.el @@ -30,7 +30,7 @@ (require 'custom) -(defconst mime-user-interface-product ["EMY" (1 13 3) "To err is human"] +(defconst mime-user-interface-product ["EMY" (1 13 4) "Nothing comes of nothing"] "Product name, version number and code name of MIME-kernel package.") (autoload 'mule-caesar-region "mule-caesar" @@ -76,8 +76,10 @@ (insert "\n")) (save-restriction (narrow-to-region (point)(point)) - (insert (concat "[" string "]\n")) - (mime-add-button (point-min)(point-max) function data))) + ;; One more newline to avoid concatenation of face property. + (insert (concat "[" string "]\n\n")) + (mime-add-button (point-min) (1- (point-max)) function data) + (delete-char -1))) (defvar mime-button-mother-dispatcher nil) -- 1.7.10.4