;;; mh-speed.el --- MH-E speedbar support
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2011
+;; Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar mh-folder-speedbar-menu-items
'("--"
["Visit Folder" mh-speed-view
- (save-excursion
- (set-buffer speedbar-buffer)
- (get-text-property (line-beginning-position) 'mh-folder))]
+ (with-current-buffer speedbar-buffer
+ (get-text-property (mh-line-beginning-position) 'mh-folder))]
["Expand Nested Folders" mh-speed-expand-folder
- (and (get-text-property (line-beginning-position) 'mh-children-p)
- (not (get-text-property (line-beginning-position) 'mh-expanded)))]
+ (and (get-text-property (mh-line-beginning-position) 'mh-children-p)
+ (not (get-text-property (mh-line-beginning-position) 'mh-expanded)))]
["Contract Nested Folders" mh-speed-contract-folder
- (and (get-text-property (line-beginning-position) 'mh-children-p)
- (get-text-property (line-beginning-position) 'mh-expanded))]
+ (and (get-text-property (mh-line-beginning-position) 'mh-children-p)
+ (get-text-property (mh-line-beginning-position) 'mh-expanded))]
["Refresh Speedbar" mh-speed-refresh t])
"Extra menu items for speedbar.")
(defun mh-speed-stealth-update (&optional force)
"Do stealth update.
With non-nil FORCE, the update is always carried out."
- (cond ((save-excursion (set-buffer speedbar-buffer)
- (get-text-property (point-min) 'mh-level))
+ (cond ((with-current-buffer speedbar-buffer
+ (get-text-property (point-min) 'mh-level))
;; Execute this hook and *don't* run anything else
(mh-speed-update-current-folder force)
nil)
(forward-line -1)
(speedbar-change-expand-button-char ?+)
(add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
+ (mh-line-beginning-position) (1+ (line-beginning-position))
'(mh-expanded nil)))
(t
(forward-line)
(goto-char point)
(speedbar-change-expand-button-char ?-)
(add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
+ (mh-line-beginning-position) (1+ (line-beginning-position))
`(mh-expanded t)))))))
(defun mh-speed-view (&rest args)
The optional ARGS from speedbar are ignored."
(interactive)
(declare (ignore args))
- (let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
+ (let* ((folder (get-text-property (mh-line-beginning-position) 'mh-folder))
(range (and (stringp folder)
(mh-read-range "Scan" folder t nil nil
mh-interpret-number-as-range-flag))))
(forward-line -1)
(setf (gethash nil mh-speed-folder-map)
(set-marker (or (gethash nil mh-speed-folder-map) (make-marker))
- (1+ (line-beginning-position))))
+ (1+ (mh-line-beginning-position))))
(add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
+ (mh-line-beginning-position) (1+ (line-beginning-position))
`(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
(mh-speed-stealth-update t)
(when (> mh-speed-update-interval 0)
(speedbar-with-writable
(goto-char (gethash folder mh-speed-folder-map (point)))
(beginning-of-line)
- (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t)
+ (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (mh-line-end-position) t)
(setq face (mh-speed-bold-face face))
(setq face (mh-speed-normal-face face)))
(beginning-of-line)
- (when (re-search-forward "\\[.\\] " (line-end-position) t)
- (put-text-property (point) (line-end-position) 'face face)))))
+ (when (re-search-forward "\\[.\\] " (mh-line-end-position) t)
+ (put-text-property (point) (mh-line-end-position) 'face face)))))
(defun mh-speed-normal-face (face)
"Return normal face for given FACE."
(while suffix-list
;; We always need atleast one toggle. We need two if the directory list
;; is stale since a folder was added.
- (when (equal prefix (get-text-property (line-beginning-position)
+ (when (equal prefix (get-text-property (mh-line-beginning-position)
'mh-folder))
(mh-speed-toggle)
(unless (get-text-property (point) 'mh-expanded)
"Given an MH-E BUFFER find the folder that should be highlighted.
Do the right thing for the different kinds of buffers that MH-E
uses."
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(cond ((eq major-mode 'mh-folder-mode)
mh-current-folder)
((eq major-mode 'mh-show-mode)
(setf (gethash folder-name mh-speed-folder-map)
(set-marker (or (gethash folder-name mh-speed-folder-map)
(make-marker))
- (1+ (line-beginning-position))))
+ (1+ (mh-line-beginning-position))))
(add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
+ (mh-line-beginning-position) (1+ (mh-line-beginning-position))
`(mh-folder ,folder-name
mh-expanded nil
mh-children-p ,(not (not (cdr f)))
(interactive (list t))
(when force
(when mh-speed-flists-timer
- (cancel-timer mh-speed-flists-timer)
+ (mh-cancel-timer mh-speed-flists-timer)
(setq mh-speed-flists-timer nil))
(when (and (processp mh-speed-flists-process)
(not (eq (process-status mh-speed-flists-process) 'exit)))
(substring output position line-end))
mh-speed-partial-line "")
(multiple-value-setq (folder unseen total)
- (mh-parse-flist-output-line line mh-speed-current-folder))
+ (values-list
+ (mh-parse-flist-output-line line mh-speed-current-folder)))
(when (and folder unseen total
(let ((old-pair (gethash folder mh-speed-flists-cache)))
(or (not (equal (car old-pair) unseen))
(not (equal (cdr old-pair) total)))))
(setf (gethash folder mh-speed-flists-cache) (cons unseen total))
- (save-excursion
- (when (buffer-live-p (get-buffer speedbar-buffer))
- (set-buffer speedbar-buffer)
+ (when (buffer-live-p (get-buffer speedbar-buffer))
+ (with-current-buffer speedbar-buffer
(speedbar-with-writable
(when (get-text-property (point-min) 'mh-level)
(let ((pos (gethash folder mh-speed-folder-map))
face)
(when pos
(goto-char pos)
- (goto-char (line-beginning-position))
+ (goto-char (mh-line-beginning-position))
(cond
((null (get-text-property (point) 'mh-count))
- (goto-char (line-end-position))
+ (goto-char (mh-line-end-position))
(setq face (get-text-property (1- (point)) 'face))
(insert (format " (%s/%s)" unseen total))
(mh-speed-highlight 'unknown face)
- (goto-char (line-beginning-position))
+ (goto-char (mh-line-beginning-position))
(add-text-properties (point) (1+ (point))
`(mh-count (,unseen . ,total))))
((not (equal (get-text-property (point) 'mh-count)
(cons unseen total)))
- (goto-char (line-end-position))
+ (goto-char (mh-line-end-position))
(setq face (get-text-property (1- (point)) 'face))
- (re-search-backward " " (line-beginning-position) t)
- (delete-region (point) (line-end-position))
+ (re-search-backward " " (mh-line-beginning-position) t)
+ (delete-region (point) (mh-line-end-position))
(insert (format " (%s/%s)" unseen total))
(mh-speed-highlight 'unknown face)
- (goto-char (line-beginning-position))
+ (goto-char (mh-line-beginning-position))
(add-text-properties
(point) (1+ (point))
`(mh-count (,unseen . ,total))))))))))))
(defun mh-speed-invalidate-map (folder)
"Remove FOLDER from various optimization caches."
(interactive (list ""))
- (save-excursion
- (set-buffer speedbar-buffer)
+ (with-current-buffer speedbar-buffer
(let* ((speedbar-update-flag nil)
(last-slash (mh-search-from-end ?/ folder))
(parent (if last-slash (substring folder 0 last-slash) nil))
(caar parent-kids)))
(setq parent-change ? ))))
(goto-char parent-position)
- (when (equal (get-text-property (line-beginning-position) 'mh-folder)
+ (when (equal (get-text-property (mh-line-beginning-position) 'mh-folder)
parent)
- (when (get-text-property (line-beginning-position) 'mh-expanded)
+ (when (get-text-property (mh-line-beginning-position) 'mh-expanded)
(mh-speed-toggle))
(when parent-change
(speedbar-with-writable
(mh-speedbar-change-expand-button-char parent-change)
(add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
+ (mh-line-beginning-position) (1+ (mh-line-beginning-position))
`(mh-children-p ,(equal parent-change ?+)))))
(mh-speed-highlight mh-speed-last-selected-folder 'mh-speedbar-folder)
(setq mh-speed-last-selected-folder nil)
"Change the expansion button character to CHAR for the current line."
(save-excursion
(beginning-of-line)
- (if (re-search-forward "\\[.\\]" (line-end-position) t)
+ (if (re-search-forward "\\[.\\]" (mh-line-end-position) t)
(speedbar-with-writable
(backward-char 2)
(delete-char 1)
(defun mh-speed-add-folder (folder)
"Add FOLDER since it is being created.
The function invalidates the latest ancestor that is present."
- (save-excursion
- (set-buffer speedbar-buffer)
+ (with-current-buffer speedbar-buffer
(let ((speedbar-update-flag nil)
(last-slash (mh-search-from-end ?/ folder))
(ancestor folder)
(speedbar-with-writable
(mh-speedbar-change-expand-button-char ?+)
(add-text-properties
- (line-beginning-position) (1+ (line-beginning-position))
+ (mh-line-beginning-position) (1+ (mh-line-beginning-position))
`(mh-children-p t)))
- (when (get-text-property (line-beginning-position) 'mh-expanded)
+ (when (get-text-property (mh-line-beginning-position) 'mh-expanded)
(mh-speed-toggle))
(setq mh-speed-refresh-flag t))))
;; sentence-end-double-space: nil
;; End:
-;; arch-tag: d38ddcd4-3c00-4e37-99bf-8b89dda7b32c
;;; mh-speed.el ends here
HCoop / bpt / emacs.git / blobdiff