Mercurial > emacs
view lisp/gnus/sieve.el @ 110523:a5ad4f188e19
Synch Semantic to CEDET 1.0.
Move CEDET ChangeLog entries to new file lisp/cedet/ChangeLog.
* semantic.el (semantic-version): Update to 2.0.
(semantic-mode-map): Add "," and "m" bindings.
(navigate-menu): Update.
* semantic/symref.el (semantic-symref-calculate-rootdir):
New function.
(semantic-symref-detect-symref-tool): Use it.
* semantic/symref/grep.el (semantic-symref-grep-shell): New var.
(semantic-symref-perform-search): Use it. Calculate root dir with
semantic-symref-calculate-rootdir.
(semantic-symref-derive-find-filepatterns): Improve error message.
* semantic/symref/list.el
(semantic-symref-results-mode-map): New bindings.
(semantic-symref-auto-expand-results): New option.
(semantic-symref-results-dump): Obey auto-expand.
(semantic-symref-list-expand-all, semantic-symref-regexp)
(semantic-symref-list-contract-all)
(semantic-symref-list-map-open-hits)
(semantic-symref-list-update-open-hits)
(semantic-symref-list-create-macro-on-open-hit)
(semantic-symref-list-call-macro-on-open-hits): New functions.
(semantic-symref-list-menu-entries)
(semantic-symref-list-menu): New vars.
(semantic-symref-list-map-open-hits): Move cursor to beginning of
match before calling the mapped function.
* semantic/doc.el
(semantic-documentation-comment-preceeding-tag): Do nothing if the
mode doesn't provide comment-start-skip.
* semantic/scope.el
(semantic-analyze-scope-nested-tags-default): Strip duplicates.
(semantic-analyze-scoped-inherited-tag-map): Take the tag we are
looking for as part of the scoped tags list.
* semantic/html.el (semantic-default-html-setup): Add
senator-step-at-tag-classes.
* semantic/decorate/include.el
(semantic-decoration-on-unknown-includes): Change light bgcolor.
(semantic-decoration-on-includes-highlight-default): Check that
the include tag has a postion.
* semantic/complete.el (semantic-collector-local-members):
(semantic-complete-read-tag-local-members)
(semantic-complete-jump-local-members): New class and functions.
(semantic-complete-self-insert): Save excursion before completing.
* semantic/analyze/complete.el
(semantic-analyze-possible-completions-default): If no completions
are found, return the raw by-name-only completion list. Add FLAGS
arguments. Add support for 'no-tc (type constraint) and
'no-unique, or no stripping duplicates.
(semantic-analyze-possible-completions-default): Add FLAGS arg.
* semantic/util-modes.el
(semantic-stickyfunc-show-only-functions-p): New option.
(semantic-stickyfunc-fetch-stickyline): Don't show stickytext for
the very first line in a buffer.
* semantic/util.el (semantic-hack-search)
(semantic-recursive-find-nonterminal-by-name)
(semantic-current-tag-interactive): Deleted.
(semantic-describe-buffer): Fix expand-nonterminal. Add
lex-syntax-mods, type relation separator char, and command
separation char.
(semantic-sanity-check): Only message if called interactively.
* semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the
:filename property and the tag position.
* semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
Add recursion limit.
* semantic/imenu.el (semantic-imenu-bucketize-type-members):
Make this buffer local, not the obsoleted variable.
* semantic/idle.el: Add breadcrumbs support.
(semantic-idle-summary-current-symbol-info-default)
(semantic-idle-tag-highlight)
(semantic-idle-completion-list-default): Use
semanticdb-without-unloaded-file-searches for speed, and to
conform to the controls that specify if the idle timer is supposed
to be parsing unparsed includes.
(semantic-idle-symbol-highlight-face)
(semantic-idle-symbol-maybe-highlight): Rename from *-summary-*.
Callers changed.
(semantic-idle-work-parse-neighboring-files-flag): Default to nil.
(semantic-idle-work-update-headers-flag): New var.
(semantic-idle-work-for-one-buffer): Use it.
(semantic-idle-local-symbol-highlight): Rename from
semantic-idle-tag-highlight.
(semantic-idle-truncate-long-summaries): New option.
* semantic/ia.el (semantic-ia-cache)
(semantic-ia-get-completions): Deleted. Callers changed.
(semantic-ia-show-variants): New command.
(semantic-ia-show-doc): If doc is empty, don't make a temp buffer.
(semantic-ia-show-summary): If there isn't anything to show, say so.
* semantic/grammar.el (semantic-grammar-create-package):
Save the buffer even in batch mode.
* semantic/fw.el
(semanticdb-without-unloaded-file-searches): New macro.
* semantic/dep.el (semantic-dependency-find-file-on-path):
Fix case dereferencing ede-object when it is a list.
* semantic/db-typecache.el (semanticdb-expand-nested-tag)
(semanticdb-typecache-faux-namespace): New functions.
(semanticdb-typecache-file-tags)
(semanticdb-typecache-merge-streams): Use them.
(semanticdb-typecache-file-tags): When deriving tags from a file,
give the mode a chance to monkey with the tag copy.
(semanticdb-typecache-find-default): Wrap find in save-excursion.
(semanticdb-typecache-find-by-name-helper): Merge found names down.
* semantic/db-global.el
(semanticdb-enable-gnu-global-in-buffer): Don't show messages if
GNU Global is not available and we don't want to throw an error.
* semantic/db-find.el (semanticdb-find-result-nth-in-buffer):
When trying to normalize the tag to a buffer, don't error if
set-buffer method doesn't exist.
* semantic/db-file.el (semanticdb-save-db): Simplify msg.
* semantic/db.el (semanticdb-refresh-table): If forcing a
refresh on a file not in a buffer, use semantic-find-file-noselect
and delete the buffer after use.
(semanticdb-current-database-list): When calculating root via
hooks, force it through true-filename and skip the list of
possible roots.
* semantic/ctxt.el (semantic-ctxt-imported-packages): New.
* semantic/analyze/debug.el
(semantic-analyzer-debug-insert-tag): Reset standard output to
current buffer.
(semantic-analyzer-debug-global-symbol)
(semantic-analyzer-debug-missing-innertype): Change "prefix" to
"symbol" in messages.
* semantic/analyze/refs.el: (semantic-analyze-refs-impl)
(semantic-analyze-refs-proto): When calculating value, make sure
the found tag is 'similar' to the originating tag.
(semantic--analyze-refs-find-tags-with-parent): Attempt to
identify matches via imported symbols of parents.
(semantic--analyze-refs-full-lookup-with-parents): Do a deep
search during the brute search.
* semantic/analyze.el
(semantic-analyze-find-tag-sequence-default): Be robust to
calculated scopes being nil.
* semantic/bovine/c.el (semantic-c-describe-environment): Add
project macro symbol array.
(semantic-c-parse-lexical-token): Add recursion limit.
(semantic-ctxt-imported-packages, semanticdb-expand-nested-tag):
New overrides.
(semantic-expand-c-tag-namelist): Split a full type from a typedef
out to its own tag.
(semantic-expand-c-tag-namelist): Do not split out a typedef'd
inline type if it is an anonymous type.
(semantic-c-reconstitute-token): Use the optional initializers as
a clue that some function is probably a constructor. When
defining the type of these constructors, split the parent name,
and use only the class part, if applicable.
* semantic/bovine/c-by.el:
* semantic/wisent/python-wy.el: Regenerate.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 18 Sep 2010 22:49:54 -0400 |
parents | 1d1d5d9bd884 |
children | 8d09094063d0 376148b31b5e |
line wrap: on
line source
;;; sieve.el --- Utilities to manage sieve scripts ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> ;; This file is part of GNU Emacs. ;; 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 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 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; This file contain utilities to facilate upload, download and ;; general management of sieve scripts. Currently only the ;; Managesieve protocol is supported (using sieve-manage.el), but when ;; (useful) alternatives become available, they might be supported as ;; well. ;; ;; The cursor navigation was inspired by biff-mode by Franklin Lee. ;; ;; Release history: ;; ;; 2001-10-31 Committed to Oort Gnus. ;; 2002-07-27 Fix down-mouse-2 and down-mouse-3 in manage-mode. Fix menubar ;; in manage-mode. Change some messages. Added sieve-deactivate*, ;; sieve-remove. Fixed help text in manage-mode. Suggested by ;; Ned Ludd. ;; ;; Todo: ;; ;; * Namespace? This file contains `sieve-manage' and ;; `sieve-manage-mode', but there is a sieve-manage.el file as well. ;; Can't think of a good solution though, this file need a *-mode, ;; and naming it `sieve-mode' would collide with sieve-mode.el. One ;; solution would be to come up with some better name that this file ;; can use that doesn't have the managesieve specific "manage" in ;; it. sieve-dired? i dunno. we could copy all off sieve.el into ;; sieve-manage.el too, but I'd like to separate the interface from ;; the protocol implementation since the backends are likely to ;; change (well). ;; ;; * Define servers? We could have a customize buffer to create a server, ;; with authentication/stream/etc parameters, much like Gnus, and then ;; only use names of defined servers when interacting with M-x sieve-*. ;; Right now you can't use STARTTLS, which sieve-manage.el provides ;;; Code: (require 'sieve-manage) (require 'sieve-mode) ;; User customizable variables: (defgroup sieve nil "Manage sieve scripts." :version "22.1" :group 'tools) (defcustom sieve-new-script "<new script>" "Name of name script indicator." :type 'string :group 'sieve) (defcustom sieve-buffer "*sieve*" "Name of sieve management buffer." :type 'string :group 'sieve) (defcustom sieve-template "\ require \"fileinto\"; # Example script (remove comment character '#' to make it effective!): # # if header :contains \"from\" \"coyote\" { # discard; # } elsif header :contains [\"subject\"] [\"$$$\"] { # discard; # } else { # fileinto \"INBOX\"; # } " "Template sieve script." :type 'string :group 'sieve) ;; Internal variables: (defvar sieve-manage-buffer nil) (defvar sieve-buffer-header-end nil) ;; Sieve-manage mode: (defvar sieve-manage-mode-map nil "Keymap for `sieve-manage-mode'.") (if sieve-manage-mode-map () (setq sieve-manage-mode-map (make-sparse-keymap)) (suppress-keymap sieve-manage-mode-map) ;; various (define-key sieve-manage-mode-map "?" 'sieve-help) (define-key sieve-manage-mode-map "h" 'sieve-help) (define-key sieve-manage-mode-map "q" 'sieve-bury-buffer) ;; activating (define-key sieve-manage-mode-map "m" 'sieve-activate) (define-key sieve-manage-mode-map "u" 'sieve-deactivate) (define-key sieve-manage-mode-map "\M-\C-?" 'sieve-deactivate-all) ;; navigation keys (define-key sieve-manage-mode-map "\C-p" 'sieve-prev-line) (define-key sieve-manage-mode-map [up] 'sieve-prev-line) (define-key sieve-manage-mode-map "\C-n" 'sieve-next-line) (define-key sieve-manage-mode-map [down] 'sieve-next-line) (define-key sieve-manage-mode-map " " 'sieve-next-line) (define-key sieve-manage-mode-map "n" 'sieve-next-line) (define-key sieve-manage-mode-map "p" 'sieve-prev-line) (define-key sieve-manage-mode-map "\C-m" 'sieve-edit-script) (define-key sieve-manage-mode-map "f" 'sieve-edit-script) (define-key sieve-manage-mode-map "o" 'sieve-edit-script-other-window) (define-key sieve-manage-mode-map "r" 'sieve-remove) (define-key sieve-manage-mode-map [(down-mouse-2)] 'sieve-edit-script) (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-manage-mode-menu)) (easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map "Sieve Menu." '("Manage Sieve" ["Edit script" sieve-edit-script t] ["Activate script" sieve-activate t] ["Deactivate script" sieve-deactivate t])) (define-derived-mode sieve-manage-mode fundamental-mode "SIEVE" "Mode used for sieve script management." (setq mode-name "SIEVE") (buffer-disable-undo (current-buffer)) (setq truncate-lines t) (easy-menu-add sieve-manage-mode-menu sieve-manage-mode-map)) (put 'sieve-manage-mode 'mode-class 'special) ;; This is necessary to allow correct handling of \\[cvs-mode-diff-map] ;; in substitute-command-keys. ;(fset 'sieve-manage-mode-map sieve-manage-mode-map) ;; Commands used in sieve-manage mode: (defun sieve-activate (&optional pos) (interactive "d") (let ((name (sieve-script-at-point)) err) (when (or (null name) (string-equal name sieve-new-script)) (error "No sieve script at point")) (message "Activating script %s..." name) (setq err (sieve-manage-setactive name sieve-manage-buffer)) (sieve-refresh-scriptlist) (if (sieve-manage-ok-p err) (message "Activating script %s...done" name) (message "Activating script %s...failed: %s" name (nth 2 err))))) (defun sieve-deactivate-all (&optional pos) (interactive "d") (let ((name (sieve-script-at-point)) err) (message "Deactivating scripts...") (setq err (sieve-manage-setactive "" sieve-manage-buffer)) (sieve-refresh-scriptlist) (if (sieve-manage-ok-p err) (message "Deactivating scripts...done") (message "Deactivating scripts...failed: %s" (nth 2 err))))) (defalias 'sieve-deactivate 'sieve-deactivate-all) (defun sieve-remove (&optional pos) (interactive "d") (let ((name (sieve-script-at-point)) err) (when (or (null name) (string-equal name sieve-new-script)) (error "No sieve script at point")) (message "Removing sieve script %s..." name) (setq err (sieve-manage-deletescript name sieve-manage-buffer)) (unless (sieve-manage-ok-p err) (error "Removing sieve script %s...failed: " err)) (sieve-refresh-scriptlist) (message "Removing sieve script %s...done" name))) (defun sieve-edit-script (&optional pos) (interactive "d") (let ((name (sieve-script-at-point))) (unless name (error "No sieve script at point")) (if (not (string-equal name sieve-new-script)) (let ((newbuf (generate-new-buffer name)) err) (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer)) (switch-to-buffer newbuf) (unless (sieve-manage-ok-p err) (error "Sieve download failed: %s" err))) (switch-to-buffer (get-buffer-create "template.siv")) (insert sieve-template)) (sieve-mode) (message "Press C-c C-l to upload script to server."))) (defmacro sieve-change-region (&rest body) "Turns off sieve-region before executing BODY, then re-enables it after. Used to bracket operations which move point in the sieve-buffer." `(progn (sieve-highlight nil) ,@body (sieve-highlight t))) (put 'sieve-change-region 'lisp-indent-function 0) (defun sieve-next-line (&optional arg) (interactive) (unless arg (setq arg 1)) (if (save-excursion (forward-line arg) (sieve-script-at-point)) (sieve-change-region (forward-line arg)) (message "End of list"))) (defun sieve-prev-line (&optional arg) (interactive) (unless arg (setq arg -1)) (if (save-excursion (forward-line arg) (sieve-script-at-point)) (sieve-change-region (forward-line arg)) (message "Beginning of list"))) (defun sieve-help () "Display help for various sieve commands." (interactive) (if (eq last-command 'sieve-help) ;; would need minor-mode for log-edit-mode (describe-function 'sieve-mode) (message "%s" (substitute-command-keys "`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove")))) (defun sieve-bury-buffer (buf &optional mainbuf) "Hide the buffer BUF that was temporarily popped up. BUF is assumed to be a temporary buffer used from the buffer MAINBUF." (interactive (list (current-buffer))) (save-current-buffer (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window) (get-buffer-window buf t)))) (when win (if (window-dedicated-p win) (condition-case () (delete-window win) (error (iconify-frame (window-frame win)))) (if (and mainbuf (get-buffer-window mainbuf)) (delete-window win))))) (with-current-buffer buf (bury-buffer (unless (and (eq buf (window-buffer (selected-window))) (not (window-dedicated-p (selected-window)))) buf))) (when mainbuf (let ((mainwin (or (get-buffer-window mainbuf) (get-buffer-window mainbuf 'visible)))) (when mainwin (select-window mainwin)))))) ;; Create buffer: (defun sieve-setup-buffer (server port) (setq buffer-read-only nil) (erase-buffer) (buffer-disable-undo) (insert "\ Server : " server ":" (or port "2000") " ") (set (make-local-variable 'sieve-buffer-header-end) (point-max))) (defun sieve-script-at-point (&optional pos) "Return name of sieve script at point POS, or nil." (interactive "d") (get-char-property (or pos (point)) 'script-name)) (eval-and-compile (defalias 'sieve-make-overlay (if (featurep 'xemacs) 'make-extent 'make-overlay)) (defalias 'sieve-overlay-put (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) (defalias 'sieve-overlays-at (if (featurep 'xemacs) 'extents-at 'overlays-at))) (defun sieve-highlight (on) "Turn ON or off highlighting on the current language overlay." (sieve-overlay-put (car (sieve-overlays-at (point))) 'face (if on 'highlight 'default))) (defun sieve-insert-scripts (scripts) "Format and insert LANGUAGE-LIST strings into current buffer at point." (while scripts (let ((p (point)) (ext nil) (script (pop scripts))) (if (consp script) (insert (format " ACTIVE %s" (cdr script))) (insert (format " %s" script))) (setq ext (sieve-make-overlay p (point))) (sieve-overlay-put ext 'mouse-face 'highlight) (sieve-overlay-put ext 'script-name (if (consp script) (cdr script) script)) (insert "\n")))) (defun sieve-open-server (server &optional port) ;; open server (set (make-local-variable 'sieve-manage-buffer) (sieve-manage-open server)) ;; authenticate (sieve-manage-authenticate nil nil sieve-manage-buffer)) (defun sieve-refresh-scriptlist () (interactive) (with-current-buffer sieve-buffer (setq buffer-read-only nil) (delete-region (or sieve-buffer-header-end (point-max)) (point-max)) (goto-char (point-max)) ;; get list of script names and print them (let ((scripts (sieve-manage-listscripts sieve-manage-buffer))) (if (null scripts) (insert (format (concat "No scripts on server, press RET on %s to " "create a new script.\n") sieve-new-script)) (insert (format (concat "%d script%s on server, press RET on a script " "name edits it, or\npress RET on %s to create " "a new script.\n") (length scripts) (if (eq (length scripts) 1) "" "s") sieve-new-script))) (save-excursion (sieve-insert-scripts (list sieve-new-script)) (sieve-insert-scripts scripts))) (sieve-highlight t) (setq buffer-read-only t))) ;;;###autoload (defun sieve-manage (server &optional port) (interactive "sServer: ") (switch-to-buffer (get-buffer-create sieve-buffer)) (sieve-manage-mode) (sieve-setup-buffer server port) (if (sieve-open-server server port) (sieve-refresh-scriptlist) (message "Could not open server %s" server))) ;;;###autoload (defun sieve-upload (&optional name) (interactive) (unless name (setq name (buffer-name))) (when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage)) (let ((script (buffer-string)) err) (with-current-buffer (get-buffer sieve-buffer) (setq err (sieve-manage-putscript name script sieve-manage-buffer)) (if (sieve-manage-ok-p err) (message (concat "Sieve upload done. Use `C-c RET' to manage scripts.")) (message "Sieve upload failed: %s" (nth 2 err))))))) ;;;###autoload (defun sieve-upload-and-bury (&optional name) (interactive) (sieve-upload name) (bury-buffer)) (provide 'sieve) ;; arch-tag: 7f6a6d94-94e1-4654-ab9a-aee21b9b8a94 ;; sieve.el ends here