How to configure emacs/gnus to use per newsgroup time zone in posted messages?
I would like to use CET time zone in pl.* newsgroups and UCT in general newsgroups.
I would use message-header-setup-hook or message-send-hook with this function:
(defvar date-rewrite-rules
'(("pl" . return-time-string-in-CET)
("." . return-time-string-in-UTC)))
(defun rewrite-date-based-on-newsgroup ()
(save-excursion
(save-restriction
(widen)
(goto-char 0)
(narrow-to-region 0 (search-forward mail-header-separator))
(goto-char 0)
(search-forward-regexp "^Newsgroup: ")
(let ((date-f nil)
(tail date-rewrite-rules))
(while (and (null date-f)
tail)
(let ((rule (pop tail)))
(when (looking-at (car rule))
(setq date-f (cdr rule)))))
(when date-f
(goto-char 0)
(search-forward-regexp "^Date: ")
(delete-region (point) (line-end-position))
(insert (funcall date-f)))))))
NB: the code is untested, this is merely a starting point from which you should develop your solution.
Related
I'm trying to add source blocks to the visibility cycling tree. Essentially I want a source block to be treated as a child of its heading. Consider the following org-mode document:
* Heading 1
** Heading 2
#+BEGIN_SRC R
print("hello world")
#+END_SRC
** Heading 3
I would like to be able to press TAB on heading one to cycle through the folding of the various parts including the source block. Currently org-mode does seem to have the facilities for folding the source block, because I can fold that if I go to #+BEGIN_SRC R and hit tab, but it doesnt seem to be being treated in the global cycling. Any suggestions to add it?
Thanks!
This is a slight modification of the code contained in the link mentioned in my first comment above: https://stackoverflow.com/a/21594242/2112489
All I did was replace the begin / end html regexp for the SRC regexp. Go ahead and give it a whirl and see if it is what you're looking for. I left my prior footnote modification in there.
(require 'org)
(defalias 'org-cycle-hide-drawers 'lawlist-block-org-cycle-hide-drawers)
(defun lawlist-block-org-cycle-hide-drawers (state)
"Re-hide all drawers, footnotes or html blocks after a visibility state change."
(when
(and
(derived-mode-p 'org-mode)
(not (memq state '(overview folded contents))))
(save-excursion
(let* (
(globalp (memq state '(contents all)))
(beg (if globalp (point-min) (point)))
(end
(cond
(globalp
(point-max))
((eq state 'children)
(save-excursion (outline-next-heading) (point)))
(t (org-end-of-subtree t)) )))
(goto-char beg)
(while
(re-search-forward
".*\\[fn\\|^\\#\\+BEGIN_SRC.*$\\|^[ \t]*:PROPERTIES:[ \t]*$" end t)
(lawlist-org-flag t))))))
(defalias 'org-cycle-internal-local 'lawlist-block-org-cycle-internal-local)
(defun lawlist-block-org-cycle-internal-local ()
"Do the local cycling action."
(let ((goal-column 0) eoh eol eos has-children children-skipped struct)
(save-excursion
(if (org-at-item-p)
(progn
(beginning-of-line)
(setq struct (org-list-struct))
(setq eoh (point-at-eol))
(setq eos (org-list-get-item-end-before-blank (point) struct))
(setq has-children (org-list-has-child-p (point) struct)))
(org-back-to-heading)
(setq eoh (save-excursion (outline-end-of-heading) (point)))
(setq eos (save-excursion (1- (org-end-of-subtree t t))))
(setq has-children
(or
(save-excursion
(let ((level (funcall outline-level)))
(outline-next-heading)
(and
(org-at-heading-p t)
(> (funcall outline-level) level))))
(save-excursion
(org-list-search-forward (org-item-beginning-re) eos t)))))
(beginning-of-line 2)
(if (featurep 'xemacs)
(while
(and
(not (eobp))
(get-char-property (1- (point)) 'invisible))
(beginning-of-line 2))
(while
(and
(not (eobp))
(get-char-property (1- (point)) 'invisible))
(goto-char (next-single-char-property-change (point) 'invisible))
(and
(eolp)
(beginning-of-line 2))))
(setq eol (point)))
(cond
((= eos eoh)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'empty))
(org-unlogged-message "EMPTY ENTRY")
(setq org-cycle-subtree-status nil)
(save-excursion
(goto-char eos)
(outline-next-heading)
(if (outline-invisible-p)
(org-flag-heading nil))))
((and
(or
(>= eol eos)
(not (string-match "\\S-" (buffer-substring eol eos))))
(or
has-children
(not (setq children-skipped
org-cycle-skip-children-state-if-no-children))))
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'children))
(if (org-at-item-p)
;; then
(org-list-set-item-visibility (point-at-bol) struct 'children)
;; else
(org-show-entry)
(org-with-limited-levels (show-children))
(when (eq org-cycle-include-plain-lists 'integrate)
(save-excursion
(org-back-to-heading)
(while (org-list-search-forward (org-item-beginning-re) eos t)
(beginning-of-line 1)
(let* (
(struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(end (org-list-get-bottom-point struct)))
(mapc (lambda (e) (org-list-set-item-visibility e struct 'folded))
(org-list-get-all-items (point) struct prevs))
(goto-char (if (< end eos) end eos)))))))
(org-unlogged-message "CHILDREN")
(save-excursion
(goto-char eos)
(outline-next-heading)
(if (outline-invisible-p)
(org-flag-heading nil)))
(setq org-cycle-subtree-status 'children)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'children)))
((or
children-skipped
(and
(eq last-command this-command)
(eq org-cycle-subtree-status 'children)))
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'subtree))
(outline-flag-region eoh eos nil)
(org-unlogged-message
(if children-skipped
"SUBTREE (NO CHILDREN)"
"SUBTREE"))
(setq org-cycle-subtree-status 'subtree)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'subtree)))
((eq org-cycle-subtree-status 'subtree)
(org-show-subtree)
(message "ALL")
(setq org-cycle-subtree-status 'all))
(t
(run-hook-with-args 'org-pre-cycle-hook 'folded)
(outline-flag-region eoh eos t)
(org-unlogged-message "FOLDED")
(setq org-cycle-subtree-status 'folded)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'folded))))))
(defun lawlist-org-flag (flag)
"When FLAG is non-nil, hide any of the following: html code block;
footnote; or, the properties drawer. Otherwise make it visible."
(save-excursion
(beginning-of-line 1)
(cond
((looking-at ".*\\[fn")
(let* (
(begin (match-end 0))
end-footnote)
(if (re-search-forward "\\]"
(save-excursion (outline-next-heading) (point)) t)
(progn
(setq end-footnote (point))
(outline-flag-region begin end-footnote flag))
(user-error "Error beginning at point %s." begin))))
((looking-at "^\\#\\+BEGIN_SRC.*$\\|^[ \t]*:PROPERTIES:[ \t]*$")
(let* ((begin (match-end 0)))
(if (re-search-forward "^\\#\\+END_SRC.*$\\|^[ \t]*:END:"
(save-excursion (outline-next-heading) (point)) t)
(outline-flag-region begin (point-at-eol) flag)
(user-error "Error beginning at point %s." begin)))))))
(defun lawlist-toggle-block-visibility ()
"For this function to work, the cursor must be on the same line as the regexp."
(interactive)
(if
(save-excursion
(beginning-of-line 1)
(looking-at
".*\\[fn\\|^\\#\\+BEGIN_SRC.*$\\|^[ \t]*:PROPERTIES:[ \t]*$"))
(lawlist-org-flag (not (get-char-property (match-end 0) 'invisible)))
(message "Sorry, you are not on a line containing the beginning regexp.")))
Is it possible to calculate a new window-start/end without a redisplay occurring? If so, then an example would be greatly appreciated. If not, then what is the best way to approximate it?
Example: We want to move to a new area of the buffer somewhere off screen, and place overlays when we get there. We might be using page-down or scroll-down or paragraph-down or end-of-buffer. When we get to that new point, we want to calculate the new window-start and the new window-end. However, we want to avoid a momentary naked looking buffer without any overlays. Ideally, the redisplay would occur once those overlays are added. I want to restrict new overlays to the new region based upon the new window-start/end.
Point-Min: point = 1
Old Window Start: point = 1000
Old Window End: point = 1500
New Window Start: point = 3500
New Window End: point = 4000
Point-Max: point = 6000
Problem: When using the post-command-hook to try and calculate the new window-start and new window-end, the previous display positions are being used instead -- i.e., the old window-start and the old window-end.
Here is a sample of the project I am working on. Absent fixing the window-start \ window-end problem, I get the following error:
Error in post-command-hook (my-eol-ruler-function):
(error "Invalid search bound (wrong side of point)")`.
The error happens when going from (point-min) to the end of the buffer with the interactive function end-of-buffer. In the context of this error, (point-max) is beyond the old window-end.
EDIT: Updated code to include a message: (message "point: %s | window-start: %s | window-end: %s | point-max: %s" (point) (window-start) (window-end) (point-max) ). The message is used to demonstrate that the new window-start and new window-end are not calculated within the post-command-hook because a redisplay has not yet occurred. However, I am trying to avoid a redisplay until after the new overlays have been placed -- otherwise, a naked buffer without overlays is visible for a split second.
(defvar my-eol-ruler nil
"A horizontal ruler stretching from eol (end of line) to the window edge.")
(make-variable-buffer-local 'my-eol-ruler)
(defvar my-eol-pilcrow nil
"A pilcrow symbol placed at the end of every line except the current line.")
(make-variable-buffer-local 'my-eol-pilcrow)
(defun my-eol-ruler-function ()
(let* (
(opoint (point))
(window-width (window-width))
(window-start (window-start))
(window-end (window-end))
(col-eovl
(save-excursion
(vertical-motion 1)
(skip-chars-backward " \r\n" (- (point) 1))
(- (current-column) (progn (vertical-motion 0) (current-column)))))
(my-current-line-length (- (- window-width col-eovl) 3))
(pilcrow
(propertize (char-to-string ?\u00B6)
'face '(:foreground "white")
'cursor t))
(pilcrow-underlined
(propertize (char-to-string ?\u00B6)
'face '(:foreground "white" :underline "yellow")
'cursor t))
(underline (propertize (char-to-string ?\u2009)
'display `(space :width ,my-current-line-length)
'face '(:underline "yellow")
'cursor t)))
(when (or my-eol-ruler my-eol-pilcrow)
(dolist (description `(
,my-eol-ruler
,my-eol-pilcrow ))
(remove-overlays (point-min) (point-max)
'after-string description)) )
(setq my-eol-ruler (concat pilcrow-underlined underline))
(setq my-eol-pilcrow pilcrow)
(save-excursion
(end-of-line)
(overlay-put (make-overlay (point) (point))
'after-string my-eol-ruler ) )
(message "point: %s | window-start: %s | window-end: %s | point-max: %s"
(point)
(window-start)
(window-end)
(point-max) )
(save-excursion
(goto-char window-end)
(while (re-search-backward "\n" window-start t)
(let* (
(pbol (point-at-bol))
(pbovl (save-excursion (vertical-motion 0) (point)))
(peol (point))
(peol-pbol-region-p
(if (region-active-p)
(= peol pbol)))
(eol-inside-region-p
(if (region-active-p)
(and
(<= reg-beg peol)
(> reg-end peol))))
(col-eovl
(save-excursion
(vertical-motion 1)
(skip-chars-backward " \r\n" (- (point) 1))
(- (current-column) (progn (vertical-motion 0) (current-column)))))
(my-last-column (current-column))
(window-width-bug-p (= my-last-column (- window-width 1)))
(shazbot-pbol
(save-excursion
(end-of-line)
(re-search-backward "\s\\|\t" pbol t) (+ (point) 1)))
(wrapped-window-width-bug-p (= col-eovl (- window-width 1))) )
(when
(or
(< opoint pbol)
(> opoint peol))
(overlay-put (make-overlay peol peol) 'after-string my-eol-pilcrow))))) ))
(add-hook 'post-command-hook 'my-eol-ruler-function)
Beginning of the buffer, before the error occurs.
End of the buffer -- the error occurs when executing the interactive function end-of-buffer from a point at the beginning of the buffer.
Error in post-command-hook (my-eol-ruler-function):
(error "Invalid search bound (wrong side of point)")
See also Emacs bug tracker feature request #22404 (which has not yet been implemented, but the mailing archive contains a rough draft rudimentary patch that creates a new hook for this specific issue): https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22404
Minor-mode for testing window-start and window-end BEFORE visual redisplay.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; test-mode
;; A minor-mode for testing `window-start` / `window-end` BEFORE visual redisplay.
(defvar test-this-command nil
"This local variable is set within the `post-command-hook`; and,
is also used by the `window-scroll-functions` hook.")
(make-variable-buffer-local 'test-this-command)
(defun test-post-command-hook-fn ()
"A function attached to the `post-command-hook`."
(setq test-this-command this-command)
(test-demo-fn))
(defun test-window-scroll-functions-fn (win _start)
"A function attached to the `window-scroll-functions` hook."
(test-demo-fn))
(defun test-demo-fn ()
"This is a test-mode demonstration function."
(when
(and
test-mode
test-this-command
(window-live-p (get-buffer-window (current-buffer)))
(not (minibufferp))
(pos-visible-in-window-p (point)
(get-buffer-window (current-buffer) (selected-frame)) t))
(let* (
(selected-window (selected-window))
(window-start (window-start selected-window))
(window-end (window-end selected-window t)) )
(message "window-start: %s | window-end: %s" window-start window-end)
(setq test-this-command nil) )))
(define-minor-mode test-mode
"A minor-mode for testing `window-start` / `window-end` BEFORE visual redisplay."
:init-value nil
:lighter " TEST"
:keymap nil
:global nil
:group nil
(cond
(test-mode
(set (make-local-variable 'scroll-conservatively) 101)
(add-hook 'post-command-hook 'test-post-command-hook-fn nil t)
(add-hook 'window-scroll-functions 'test-window-scroll-functions-fn nil t)
(when (called-interactively-p 'any)
(message "Turned ON `test-mode`.")))
(t
(kill-local-variable 'scroll-conservatively)
(kill-local-variable 'test-this-command)
(remove-hook 'post-command-hook 'test-post-command-hook-fn t)
(remove-hook 'window-scroll-functions 'test-window-scroll-functions-fn t)
(when (called-interactively-p 'any)
(message "Turned OFF `test-mode`.") ))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Offhand, I'd say that the error is raised because you pass a BOUND arg to a search function. For example:
(re-search-backward "\n" window-start t)
(re-search-backward "\s\\|\t" pbol t)
Check your values of window-start and pbol. Remember that when you search backward the bound must not be greater than the current position (point).
I think you want to use jit-lock-register instead of post-command-hook. This way, the redisplay code will call you back once it has decided of a window-start and you'll be able to add the overlays you want before the buffer's content is displayed.
I have been unable to come up with a method to test for a syntax condition without moving the cursor -- e.g., skip-syntax-forward and skip-chars-forward both move the cursor in order to return t or a positive value. How can I return t or nil without moving the cursor?
(defun lawlist-kill-word ()
"Mark word / symbol + whitespace to the right of the cursor, and kill same."
(interactive)
(let* (
(symbol-regexp "\\s.\\|\\s_")
(word-regexp "\\sw"))
(modify-syntax-entry ?' "_") ;; apostrophe = symbol constituent
(cond
((< 0 (skip-syntax-forward "_."))
(let ((end (point)))
(set-mark end)
(while (looking-back symbol-regexp)
(backward-char))
(let ((beg (point)))
(delete-region beg end)
(setq beg (point))
(cond
((skip-chars-forward " \t")
(setq end (point))
(set-mark end)
(delete-region beg end))))))
((< 0 (skip-syntax-forward "w"))
(let ((end (point)))
(set-mark end)
(while (looking-back word-regexp)
(backward-char))
(let ((beg (point)))
(delete-region beg end)
(setq beg (point))
(cond
((skip-chars-forward " \t")
(setq end (point))
(set-mark end)
(delete-region beg end))))))
(t
(let ((beg (point)))
(set-mark beg)
(skip-chars-forward " \t")
(let ((end (point)))
(delete-region beg end)))
(deactivate-mark)))
(modify-syntax-entry ?' "w") )) ;; apostrophe = word constituent
EDIT: lawlist-kill-word is a work in progress -- any updates to this function will be posted to a thread related to that issue -- i.e.,: Emacs: delete whitespaces or a word
As #Tobias said: wrap cursor movements in save-excursion. Save any values you want (e.g., of (point)) in variables and return them as needed.
E.g., if you want the position four lines ahead, do something like this:
(let ((posn (save-excursion (forward-line 4) (point))))
posn)
I would like to set up a command that put the content of the lines between two § characters without moving the point (not including the lines containg the §).
Here is my current attempt
(defun copy-section ()
"Copy current section, that is lines between two §."
(interactive)
(save-excursion
(when (not (search-backward-regexp "§" nil t))
(goto-char (point-min)) )
(forward-line 1)
(when (not (search-forward-regexp "§" nil t))
(goto-char (point-max)) )
(move-beginning-of-line nil)
(kill-ring-save (mark) (point)) ) )
It works well but the remarks in the documentation about moving around the mark being bad style make me think taht there is a better way to achieve the same result.
Does saving position into variable (which I do not know how to do it) allows for a cleaner function.
Part of the code above comes from ergoemacs.
No "regexp" form needed as only a char is looked for
(defun copy-section ()
"Copy current section, that is lines between two §."
(interactive)
(save-excursion
(let* ((start (and (search-backward "§" nil t)
(forward-line 1)
(point)))
(end (progn (and start (search-forward "§" nil t))
(forward-line -1)
(end-of-line)
(point))))
(and start end (kill-new (buffer-substring-no-properties start end))))))
This version saves the beginning and end of your section in temporary local variables, and doesn't use the mark at all:
(defun copy-section ()
"Copy current page as defined by form feed characters."
(interactive)
(let (start end)
(save-excursion
(when (not (search-backward-regexp "§" nil t))
(goto-char (point-min)) )
(forward-line 1)
(setq start (point))
(when (not (search-forward-regexp "§" nil t))
(goto-char (point-max)) )
(move-beginning-of-line nil)
(setq end (point))
(kill-ring-save start end))))
Here's my extension to dabbrev-expand to support sub-string expansion.It works as expected, as far as I know. However I would find it even more useful if it supported in-symbol expansion similar to the behaviour of mdabbrev, which, by the way, is incomplete in terms of symbol-character and case-adjustment support. The pattern argument to dabbrev-substring-search, however, is only the pattern before point but for in-place expansions we need the pattern after point aswell. Why isn't this pattern available in hippie/dabbrev-expand and is there a preferred way to query it?
(defun dabbrev-substring-search (pattern &optional reverse limit syntax-context)
"Expand dabbrev substring. See:
http://www.emacswiki.org/cgi-bin/wiki/HippieExpand#toc5"
(let ((result ())
(regpat (cond ((not hippie-epxand-dabbrev-as-symbol)
(concat (regexp-quote pattern) W*))
;; ((eq (char-syntax (aref pattern 0)) ?_)
;; (concat (regexp-quote pattern)
;; "\\(\\sw\\|\\s_\\)*"))
(t
(concat "\\(?:"
Y<
"\\(" "\\(?:\\sw\\|\\s_\\)+" "\\)"
"\\(" (regexp-quote pattern) "\\)"
"\\(" "\\(?:\\sw\\|\\s_\\)*" "\\)"
Y>
"\\)"
"\\|"
"\\(?:"
Y<
"\\(" "\\(?:\\sw\\|\\s_\\)*" "\\)"
"\\(" (regexp-quote pattern) "\\)"
"\\(" "\\(?:\\sw\\|\\s_\\)+" "\\)"
Y>
"\\)"
)))))
(while (and (not result)
(if reverse
(re-search-backward regpat limit t)
(re-search-forward regpat limit t)))
(setq result (buffer-substring-no-properties (save-excursion
(goto-char (match-beginning 0))
;;(skip-syntax-backward "w_")
(point))
(match-end 0)))
(if (he-string-member result he-tried-table t)
(setq result nil))) ; ignore if bad prefix or already in table
(when nil
(when result
(let* ((p (point))
(end3 (match-end 3))
(beg2 (match-end 2))
(end2 (match-end 2))
(dummy (message "%s %s %s" end3 beg2 end2))
(beg (- end3 beg2)) ;begin offset from point
(end (- end3 end2))) ;end offset from point
(setq dabbrev-substring-match-region (cons beg end))
(hictx-generic (- p beg) (- p end) nil 'match 3))))
result))
;; Use: (dabbrev-substring-search "he")
(defun try-expand-dabbrev-substring-visible (old)
"Like `try-expand-dabbrev' but for visible part of buffer."
(interactive "P")
(let ((old-fun (symbol-function 'he-dabbrev-search)))
(fset 'he-dabbrev-search (symbol-function 'dabbrev-substring-search))
(unwind-protect (try-expand-dabbrev-visible old)
(fset 'he-dabbrev-search old-fun))))
(defun try-expand-dabbrev-substring (old)
"Like `try-expand-dabbrev' but for substring match."
(interactive "P")
(let ((old-fun (symbol-function 'he-dabbrev-search)))
(fset 'he-dabbrev-search (symbol-function 'dabbrev-substring-search))
(unwind-protect (try-expand-dabbrev old)
(fset 'he-dabbrev-search old-fun))))
(defun try-expand-dabbrev-substring-all-buffers (old)
"Like `try-expand-dabbrev-all-buffers' but for substring match."
(interactive "P")
(let ((old-fun (symbol-function 'he-dabbrev-search)))
(fset 'he-dabbrev-search (symbol-function 'dabbrev-substring-search))
(unwind-protect (try-expand-dabbrev-all-buffers old)
(fset 'he-dabbrev-search old-fun))))
which is activated for example using
(setq hippie-expand-try-functions-list
(append
'(
try-expand-dabbrev-substring-visible
try-expand-dabbrev-substring
try-expand-dabbrev-substring-all-buffers)))
This might or might not help. Like ordinary dabbrev, it works with the text before point, but candidate matching can be substring, regexp, or fuzzy (various kinds), in addition to prefix. Icicles - Dynamic Abbreviation