Emacs-PDE
view release on metacpan or search on metacpan
* lisp/perldoc.el (perldoc-symbol-type): New function to distinct
symbols in obarray. Change relate functions to use this.
* lisp/pde-util.el (pde-apropos-module): New command
2008-01-06 Ye Wenbin <wenbinye@gmail.com>
* lisp/pde.el (pde-compilation-buffer-name): fix bug: not 1 but 0
* lisp/tempo-x.el (tempo-x-snippet-clear): fix bug: clear forms
when source overlay is deleted
2008-01-01 Ye Wenbin <wenbinye@gmail.com>
* lisp/compile-dwim.el and others: change defvar to defcustom
definition
* lisp/doc/pde.texi (perlcritic): Add docuemnt for perlcritic
2007-12-31 Ye Wenbin <wenbinye@gmail.com>
lisp/imenu-tree.el view on Meta::CPAN
:notify tree-mode-reflesh-parent
:format "%[%t%]\n")
:dynargs imenu-tree-expand-bucket
:has-children t)
`(push-button
:tag ,(car item)
:imenu-marker ,(let ((pos (cdr item)))
(cond ((markerp pos) pos)
((numberp pos)
(set-marker (make-marker) pos buf))
((overlayp pos)
(set-marker (make-marker) (overlay-start pos) buf))
(t (error "Unknown position type: %S" pos))))
:button-icon ,icon
:format "%[%t%]\n"
:notify imenu-tree-select)))
(defun imenu-tree-select (node &rest ignore)
(let ((marker (widget-get node :imenu-marker)))
(select-window (display-buffer (marker-buffer marker)))
(goto-char marker)))
lisp/perldb-ui.el view on Meta::CPAN
(setq comint-prompt-regexp perldb-prompt-regexp)
(setq paragraph-start comint-prompt-regexp)
;; init variable
(setq gdb-buffer-fringe-width (car (window-fringes)))
(run-hooks 'perldb-mode-hook)
(sit-for 0)
(perldb-restore-windows))
(defun perldb-sentinel (proc msg)
(dolist (bp perldb-breakpoints)
(apply 'perldb-remove-breakpoint (overlay-get bp 'break-position)))
(gud-sentinel proc msg))
(defun perldb-install-methods ()
(with-temp-buffer
(let ((conf "~/.perldb")
found)
(if (file-exists-p conf)
(progn
(insert-file-contents conf)
(goto-char (point-min))
lisp/perldb-ui.el view on Meta::CPAN
(while (looking-at "^\\s-+\\([0-9]+\\):")
(setq line (string-to-number (match-string 1)))
;; (message "file: %s line: %d" file line)
(unless (setq bp (perldb-find-breakpoints file line))
(setq bp (perldb-put-breakpoint file line)))
(push bp new-breakpoints)
(forward-line 2)))
;; remove not exists breakpoints
(dolist (bp breakpoints)
(unless (memq bp new-breakpoints)
(apply 'perldb-remove-breakpoint (overlay-get bp 'break-position))))
;; install to perldb-breakpoints
(setq perldb-breakpoints new-breakpoints)))
(defun perldb-invalidate-temp-buffer ()
"Dummy function for future implement."
)
(defun perldb-check-status ()
(ignore-errors
(with-current-buffer (perldb-get-buffer 'gdb-partial-output-buffer)
lisp/perldb-ui.el view on Meta::CPAN
;; set or clear breakpoint
(defalias 'perldb-put-string 'gdb-put-string)
(defun perldb-find-breakpoints (file line)
(let ((breakpoints perldb-breakpoints))
(when breakpoints
(let ((pos (list file line))
found)
(while (and (not found) breakpoints)
(if (equal (overlay-get (car breakpoints) 'break-position) pos)
(setq found (car breakpoints)))
(setq breakpoints (cdr breakpoints)))
found))))
(defun perldb-put-breakpoint (file line)
(unless (perldb-find-breakpoints file line)
(let ((breakpoints perldb-breakpoints))
(with-current-buffer (perldb-find-file file)
(goto-char (point-min))
(forward-line (1- line))
lisp/perldb-ui.el view on Meta::CPAN
(when (< left-margin-width 2)
(save-current-buffer
(setq left-margin-width 2)
(let ((window (get-buffer-window (current-buffer) 0)))
(if window
(set-window-margins
window left-margin-width right-margin-width)))))
(perldb-put-string
(propertize putstring 'face 'breakpoint-enabled)
start))
(setq ov (overlays-in start start))
(unless (= (length ov) 1)
(while (and ov
(not (or (overlay-get (car ov) 'put-break)
(overlay-get (car ov) 'put-image))))
(setq ov (cdr ov))))
(setq ov (car ov))
(overlay-put ov 'break-position (list file line))
(add-to-list 'perldb-breakpoints ov)
ov)))))
(defun perldb-remove-breakpoint (file line)
(let ((bp (perldb-find-breakpoints file line)))
(when bp
(setq perldb-breakpoints (delq bp perldb-breakpoints))
(delete-overlay bp))))
(defun perldb-watchpoint-handler (output)
(let (start)
(while (string-match "^Watchpoint [0-9]+:\\s-+\\(.*\\) changed" output start)
(perldb-invalidate-watchpoints (list (match-string 1 output)))
(setq start (match-end 0)))
output))
(defun perldb-invalidate-watchpoints (&rest args)
lisp/re-builder-x.el view on Meta::CPAN
(defun reb-mode-common ()
"Setup functions common to functions `reb-mode' and `reb-mode-lisp'."
(setq reb-mode-string ""
reb-valid-string ""
mode-line-buffer-identification
'(25 . ("%b" reb-mode-string reb-valid-string)))
(reb-update-modestring)
(make-local-variable 'after-change-functions)
(add-hook 'after-change-functions
'reb-auto-update)
;; At least make the overlays go away if the buffer is killed
(add-hook 'kill-buffer-hook 'reb-kill-buffer nil t)
(reb-auto-update nil nil nil))
;; FIX FOR: call :cleaner function
(defun reb-kill-buffer ()
"When the RE Builder buffer is killed make sure no overlays stay around."
(when (memq major-mode (reb-all-in-builder :mode))
(reb-delete-overlays)
(funcall (or (reb-builder-get reb-re-builder :cleaner) 'ignore))))
;; FIX FOR: call :cleaner function
(defun reb-quit ()
"Quit the RE Builder mode."
(interactive)
(setq reb-subexp-mode nil
reb-subexp-displayed nil)
(reb-delete-overlays)
(funcall (or (reb-builder-get reb-re-builder :cleaner) 'ignore))
(bury-buffer)
(set-window-configuration reb-window-config))
;; FIX FOR: call :reader function
(defun reb-read-regexp ()
"Read current RE."
(save-excursion
(cond ((eq reb-re-syntax 'read)
(progn
lisp/re-builder-x.el view on Meta::CPAN
(goto-char (+ 2 (point-min)))
(funcall (or (reb-builder-get reb-re-builder :mode) 'reb-mode)))
;; FIX FOR: call :changer function
(defun reb-change-target-buffer (buf)
"Change the target buffer and display it in the target window."
(interactive "bSet target buffer to: ")
(let ((buffer (get-buffer buf)))
(if (not buffer)
(error "No such buffer")
(reb-delete-overlays)
(setq reb-target-buffer buffer)
(funcall (or (reb-builder-get reb-re-builder :changer) 'ignore))
(reb-do-update
(if reb-subexp-mode reb-subexp-displayed nil))
(reb-update-modestring))))
;; FIX FOR: call :matcher function
;; Note that `reb-count-subexps' is not needed in this function
(defun reb-update-overlays (&optional subexp)
"Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
If SUBEXP is non-nil mark only the corresponding sub-expressions."
(let ((submatches 0)
matches firstmatch i max-suffix suffix )
(save-excursion
(set-buffer reb-target-buffer)
(goto-char (point-min))
(setq matches (funcall (or (reb-builder-get reb-re-builder :matcher)
'reb-lisp-build-matches) subexp))
(reb-delete-overlays)
(dolist (match matches)
(setq i (or subexp 0))
(while match
(let ((overlay (make-overlay (car match) (cadr match)))
;; When we have exceeded the number of provided faces,
;; cycle thru them where `max-suffix' denotes the maximum
;; suffix for `reb-match-*' that has been defined and
;; `suffix' the suffix calculated for the current match.
(face
(cond
(max-suffix
(if (= suffix max-suffix)
(setq suffix 1)
(setq suffix (1+ suffix)))
(intern-soft (format "reb-match-%d" suffix)))
((intern-soft (format "reb-match-%d" i)))
((setq max-suffix (1- i))
(setq suffix 1)
;; `reb-match-1' must exist.
'reb-match-1))))
(setq reb-overlays (cons overlay reb-overlays)
submatches (1+ submatches))
(overlay-put overlay 'face face)
(overlay-put overlay 'priority i))
(setq i (1+ i)
match (cddr match)))))
(let ((count (if subexp submatches (length matches))))
(message "%s %smatch%s%s"
(if (= 0 count) "No" (int-to-string count))
(if subexp "subexpression " "")
(if (= 1 count) "" "es")
(if (and reb-auto-match-limit
(= reb-auto-match-limit count))
" (limit reached)" "")))
lisp/re-builder-x.el view on Meta::CPAN
"Go to next match in the RE Builder target window."
(interactive)
(reb-assert-buffer-in-window)
(with-selected-window reb-target-window
(let ((face-re (if reb-subexp-mode
"^reb-match-[0-9]+$"
"^reb-match-0$"))
(oldpos (point))
face found)
(while (and (not found) (not (eobp)))
(goto-char (next-overlay-change (point)))
(mapc (lambda (ov)
(and (not found)
(setq face (overlay-get ov 'face))
(string-match face-re (symbol-name face))
(setq found ov)))
(overlays-at (point))))
(if (not found)
(progn
(goto-char oldpos)
(message "No more matches."))
;; FIXME: save match data in overlay or just a little hack
(store-match-data (list (overlay-start found)
(overlay-end found)
(current-buffer)))
(reb-show-subexp 0 t)))))
(defun reb-prev-match ()
"Go to previous match in the RE Builder target window."
(interactive)
(reb-assert-buffer-in-window)
(with-selected-window reb-target-window
(let ((face-re (if reb-subexp-mode
"^reb-match-[0-9]+$"
"^reb-match-0$"))
(oldpos (point))
face found)
(while (and (not found) (not (bobp)))
(goto-char (previous-overlay-change (point)))
(mapc (lambda (ov)
(and (not found)
(setq face (overlay-get ov 'face))
(string-match face-re (symbol-name face))
(< (overlay-end ov) oldpos)
(setq found ov)))
(overlays-at (point))))
(if (not found)
(progn
(goto-char oldpos)
(message "No more matches."))
;; FIXME: save match data in overlay or just a little hack
(store-match-data (list (overlay-start found)
(overlay-end found)
(current-buffer)))
(reb-show-subexp 0 t)))))
;;; Regexp Builder for Perl
(defvar reb-perl-coding-system-alist
'((utf-8 . "utf8")
(chinese-gbk . "gbk"))
"Coding system conversion between emacs and perl")
(defvar reb-perl-process nil
"Process of perl re-builder")
lisp/tempo-x.el view on Meta::CPAN
(defvar tempo-x-snippet-map
(let ((map (make-sparse-keymap)))
(define-key map "\t" 'tempo-x-next-field)
(define-key map (kbd "<backtab>") 'tempo-x-previous-field)
map)
"*keymap for tempo marker")
(defvar tempo-x-delete-field-text nil)
(defvar tempo-x-snippet-overlay nil
"Overlay to install keymap")
(make-variable-buffer-local 'tempo-x-snippet-overlay)
(defvar tempo-x-snippet-sources nil
"List of source overlays for current snippet.")
(make-variable-buffer-local 'tempo-x-snippet-sources)
(defvar tempo-x-snippet-forms nil
"List of forms overlays for current snippet.")
(make-variable-buffer-local 'tempo-x-snippet-forms)
(defun tempo-x-insert-snippet (elements)
"Provide snippet abbev.
Syntax of snippet:
(snippet (S name &optional display insert)
(F (vars) forms))
S insert a field, the first NAME will be the source and other field
with the same NAME become mirrors. Change the source will also change
lisp/tempo-x.el view on Meta::CPAN
(mapc (lambda (elem)
(if (and (listp elem) (memq (car elem) '(S F)))
(cond ((eq (car elem) 'S)
(apply 'tempo-x-insert-field (cdr elem)))
((eq (car elem) 'F)
(apply 'tempo-x-insert-form (cdr elem))))
(tempo-insert elem nil)))
elements)
;; update all forms after sources are filled
(mapc (lambda (ov)
(let ((text (eval (overlay-get ov 'tempo-x-form))))
(when text
(tempo-x-set-overlay-text ov text))))
tempo-x-snippet-forms)
;; make keymap overlay
(setq ov (make-overlay beg (point)))
(overlay-put ov 'keymap tempo-x-snippet-map)
(setq tempo-x-snippet-overlay ov)
""))
(defun tempo-x-insert-field (name &optional display insert)
"Insert a field to buffer."
(if (tempo-x-find-source name)
(tempo-x-insert-mirror name)
(tempo-x-insert-source name display insert)))
(defun tempo-x-insert-source (name display insert)
"Insert source field to buffer"
(tempo-insert-mark (point-marker))
(let ((beg (point))
(text (or display (symbol-name name)))
ov)
(insert text)
(setq ov (make-overlay beg (point)))
(mapc (lambda (pair)
(overlay-put ov (car pair) (cdr pair)))
`((tempo-x-name . ,name)
(tempo-x-display . ,text)
(tempo-x-insert . ,insert)
(face . tempo-x-editable-face)
(intangible . ,(not insert))
,@(if insert
'((modification-hooks tempo-x-snippet-update)
(insert-behind-hooks tempo-x-snippet-update)
(insert-in-front-hooks tempo-x-snippet-update))
'((insert-in-front-hooks tempo-x-snippet-replace)
(modification-hooks tempo-x-snippet-update)))))
(push (cons name ov) tempo-x-snippet-sources)))
(defun tempo-x-insert-mirror (name)
"Insert mirror field to buffer"
(let ((beg (point))
(source (tempo-x-find-source name))
ov)
(when source
(insert (tempo-x-overlay-text source))
(setq ov (make-overlay beg (point)))
(let ((mirrors (overlay-get source 'tempo-x-mirrors)))
(push ov mirrors)
(overlay-put source 'tempo-x-mirrors mirrors))
(mapc (lambda (pair)
(overlay-put ov (car pair) (cdr pair)))
`((face . tempo-x-auto-face)
(modification-hooks tempo-x-delete-field)
(insert-in-front-hooks tempo-x-dont-grow-overlay))))))
(defun tempo-x-insert-form (vars &rest form)
"Insert form to buffer"
(setq form
`(let
,(mapcar (lambda (var)
`(,var (tempo-x-overlay-text (tempo-x-find-source ',var))))
vars)
,@form))
(let (ov)
(setq ov (make-overlay (point) (point)))
(mapc (lambda (pair)
(overlay-put ov (car pair) (cdr pair)))
`((tempo-x-form . ,form)
(face . tempo-x-form-face)
(modification-hooks tempo-x-delete-field)
(insert-in-front-hooks tempo-x-dont-grow-overlay)))
(mapc (lambda (name)
(let ((source (tempo-x-find-source name))
forms)
(if source
(progn
(setq forms (overlay-get source 'tempo-x-forms))
(push ov forms)
(overlay-put source 'tempo-x-forms forms))
(error "Unknown form variable '%s': maybe you didn't source it yet!" name))))
vars)
(push ov tempo-x-snippet-forms)))
;;{{{ basic functions
(defun tempo-x-delete-overlay (ov)
"Delete mirror field, add marker for navigator after deletion."
(when (and (overlayp ov) (overlay-buffer ov))
(tempo-insert-mark (copy-marker (overlay-start ov)))
(delete-overlay ov)))
(defun tempo-x-snippet-clear ()
"Clear current snippet."
(mapc (lambda (source)
(setq source (cdr source))
(mapc 'tempo-x-delete-overlay
(overlay-get source 'tempo-x-mirrors))
(and (overlayp source) (delete-overlay source)))
tempo-x-snippet-sources)
(mapc 'tempo-x-delete-overlay tempo-x-snippet-forms)
(tempo-x-delete-overlay tempo-x-snippet-overlay)
(setq tempo-x-snippet-sources nil
tempo-x-snippet-overlay nil
tempo-x-snippet-forms nil))
(defun tempo-x-find-source (name)
"Return the source overlay with the NAME"
(cdr (assq name tempo-x-snippet-sources)))
(defun tempo-x-overlay-text (ov)
"Text of the overlay"
(buffer-substring-no-properties (overlay-start ov) (overlay-end ov)))
(defun tempo-x-set-overlay-text (overlay text)
"Change the text of the overlay"
(save-excursion
(let ((beg (overlay-start overlay)))
(goto-char beg)
(delete-region beg (overlay-end overlay))
(insert text)
(move-overlay overlay beg (point)))))
(defun tempo-x-clear-source (overlay)
"Clear OVERLAY and its mirrors."
(mapc 'tempo-x-delete-overlay
(overlay-get overlay 'tempo-x-mirrors))
(mapc (lambda (ov)
(setq tempo-x-snippet-forms (delq ov tempo-x-snippet-forms))
(tempo-x-delete-overlay ov))
(overlay-get overlay 'tempo-x-forms))
(setq tempo-x-snippet-sources
(delq (assq (overlay-get overlay 'tempo-x-name) tempo-x-snippet-sources)
tempo-x-snippet-sources))
(delete-overlay overlay))
(defun tempo-x-propagate-source (ov)
"Change the mirrors and related forms."
(let ((text (tempo-x-overlay-text ov))
(mirrors (overlay-get ov 'tempo-x-mirrors))
(forms (overlay-get ov 'tempo-x-forms)))
(dolist (o mirrors)
(unless (eq o ov)
(tempo-x-set-overlay-text o text)))
(dolist (o forms)
(let ((text (eval (overlay-get o 'tempo-x-form))))
(when text
(tempo-x-set-overlay-text o text))))))
;;}}}
;;{{{ modification-hooks
(defun tempo-x-dont-grow-overlay (ov after-p beg end &optional r)
"Hooks to make start of overlay unchange."
(let ((inhibit-modification-hooks t))
(when after-p
(move-overlay ov end (overlay-end ov)))))
(defun tempo-x-delete-field (ov after-p beg end &optional r)
"A wrapper to call `delete-overlay' from modification hooks."
(if after-p
(unless (string= tempo-x-delete-field-text
(buffer-substring-no-properties beg end))
(tempo-x-delete-overlay ov))
(setq tempo-x-delete-field-text
(buffer-substring-no-properties beg end))))
(defun tempo-x-snippet-replace (ov after-p beg end &optional r)
"Hooks to convert intangible overlay to ordinary"
(when after-p
(let ((inhibit-modification-hooks t))
(mapc (lambda (pair)
(overlay-put ov (car pair) (cdr pair)))
`((intangible . nil)
(modification-hooks tempo-x-snippet-update)
(insert-behind-hooks tempo-x-snippet-update)
(insert-in-front-hooks tempo-x-snippet-update)))
(delete-region end (overlay-end ov))
(tempo-x-snippet-update ov t beg end nil))))
(defun tempo-x-snippet-update (ov after-p beg end &optional r)
"Update source overlay.
If insert chars in front or behind overlay that is in
`tempo-x-exclude-chars', don't grow the overlay.
Make mirrors and sources changes.
If the text become empty, if delete by deleting commands except DEL,
delete source field. Otherwise recover to beginning."
(let ((inhibit-modification-hooks t))
(when after-p
;; if the insert is not space, grow overlay
(when (/= beg end)
(cond ((= beg (overlay-start ov)) ; insert in the front
(save-excursion
(goto-char beg)
(skip-chars-forward tempo-x-exclude-chars)
(move-overlay ov (point) (overlay-end ov))))
((> end (overlay-end ov)) ; insert in the end
(save-excursion
(goto-char (overlay-end ov))
(skip-chars-forward (concat "^" tempo-x-exclude-chars))
(move-overlay ov (overlay-start ov) (min end (point)))))))
(tempo-x-propagate-source ov)
;; if there is no text in the field
(when (= (overlay-end ov) (overlay-start ov))
(if (> r 1)
;; if delete a word, delete the overlay and mirrors
(progn
(tempo-x-clear-source ov))
;; if delete a single character, give back a prompt
(tempo-x-set-overlay-text ov (overlay-get ov 'tempo-x-display))
(tempo-x-propagate-source ov)
(unless (overlay-get ov 'tempo-x-insert)
(mapc (lambda (pair)
(overlay-put ov (car pair) (cdr pair)))
'((intangible . t)
(insert-behind-hooks)
(insert-in-front-hooks tempo-x-snippet-replace)
(modification-hooks tempo-x-snippet-update)))))))))
;;}}}
;;{{{ movement commands
(defun tempo-x-next-field ()
"Move to next field, if already the next field clear all fields."
(interactive)
(let ((pos (point))
(sources tempo-x-snippet-sources)
(last (point-max))
ov found)
(while (and sources (not found))
(if (and (> (overlay-start (cdar sources)) pos)
(or (null (setq ov (cdr (cadr sources))))
(<= (overlay-start ov) pos)))
(setq found t)
(setq ov (car sources)
sources (cdr sources))))
(if found
(goto-char (overlay-start (cdar sources)))
(tempo-forward-mark)
(tempo-x-snippet-clear))))
(defun tempo-x-previous-field ()
"Move to previous field"
(interactive)
(let ((pos (point))
(sources tempo-x-snippet-sources)
ov found)
(while (and sources (not found))
(setq ov (cdar sources))
(if (<= (overlay-end ov) pos)
(setq found t)
(setq sources (cdr sources))))
(goto-char (overlay-start ov))))
;;}}}
;;}}}
(defmacro tempo-x-test-template (&rest tempo)
"Test the template without define it."
`(let ((tpl ,@tempo))
(tempo-insert-template 'tpl nil)))
(add-to-list 'tempo-user-elements 'tempo-x-elements-handler)
(provide 'tempo-x)
( run in 0.285 second using v1.01-cache-2.11-cpan-49f99fa48dc )