Skip to content

GitLab

Commit b2d3faed authored by David Byers's avatar David Byers
Browse files
Options

Improve compatibility with bleeding edge emacs

parent 4a710cf3
Hide whitespace changes
Inline Side-by-side
Showing with 308 additions and 320 deletions
src/ChangeLog
View file @ b2d3faed
2010-05-13 David Byers <davby@ida.liu.se>
Emacs 24 compatibility
* all: replaces many save-excursion with save-current-buffer in
order to avoid meaningless warnings in Gnu Emacs 24.1.
Menus on Macintosh:
* menus.el (lyskom-menu-encoding-rules): Applied patch from Mrten
Svensson for bug 1655.
Handle root review of root texts:
* view-text.el (lyskom-get-root-text-belongs-to): In node
transform, explicitly look in the cache (it's faster), and pass
text-no, not text-stat to lyskom-find-dag-roots.
......@@ -11,6 +17,7 @@
in the cache (it's faster), and pass text-no, not text-stat to
lyskom-find-dag-roots.
Improve handing of startup compatbility check:
* utilities.el (lyskom-check-configuration): Also look at
mime-charset.
(lyskom-magic-minibuffer-post-command): Check that
......
src/async.el
View file @ b2d3faed
......@@ -41,7 +41,7 @@
(defun lyskom-is-ignoring-async (buffer message &rest args)
(save-excursion
(save-current-buffer
(set-buffer buffer)
(let ((tmp (assq message lyskom-ignoring-async-list)))
(and tmp (equal args (cdr tmp))))))
......
src/buffers.el
View file @ b2d3faed
......@@ -87,37 +87,38 @@ they are created.")
(defun lyskom-set-buffer-parent (buffer parent)
"Set the parent buffer of BUFFER to PARENT. If buffer is already
a child of some buffer, reparent it."
(save-excursion (set-buffer buffer)
(if (and lyskom-buffer-parent
(buffer-live-p lyskom-buffer-parent))
(lyskom-remove-buffer-child lyskom-buffer-parent buffer))
(setq lyskom-buffer-parent parent)
(if parent (lyskom-add-buffer-child parent buffer))))
(save-current-buffer
(set-buffer buffer)
(if (and lyskom-buffer-parent
(buffer-live-p lyskom-buffer-parent))
(lyskom-remove-buffer-child lyskom-buffer-parent buffer))
(setq lyskom-buffer-parent parent)
(if parent (lyskom-add-buffer-child parent buffer))))
(defun lyskom-remove-buffer-child (buffer child)
"Remove CHILD from BUFFER's list of children. Args: BUFFER CHILD"
(save-excursion (set-buffer buffer)
(if (boundp 'lyskom-buffer-children)
(setq lyskom-buffer-children
(delq child lyskom-buffer-children)))))
(save-current-buffer (set-buffer buffer)
(if (boundp 'lyskom-buffer-children)
(setq lyskom-buffer-children
(delq child lyskom-buffer-children)))))
(defun lyskom-add-buffer-child (buffer child)
"Add CHILD as a child of BUFFER. Args: BUFFER CHILD"
(save-excursion (set-buffer buffer)
(setq lyskom-buffer-children
(cons child lyskom-buffer-children))))
(save-current-buffer (set-buffer buffer)
(setq lyskom-buffer-children
(cons child lyskom-buffer-children))))
(defun lyskom-get-buffer-parent (buffer)
"Return the parent of BUFFER or nil if it has no parent"
(save-excursion (set-buffer buffer)
(and (boundp 'lyskom-buffer-parent)
lyskom-buffer-parent)))
(save-current-buffer (set-buffer buffer)
(and (boundp 'lyskom-buffer-parent)
lyskom-buffer-parent)))
(defun lyskom-get-buffer-children (buffer)
"Return the list of children of buffer BUFFER or nil if there are none."
(save-excursion (set-buffer buffer)
(and (boundp 'lyskom-buffer-children)
lyskom-buffer-children)))
(save-current-buffer (set-buffer buffer)
(and (boundp 'lyskom-buffer-children)
lyskom-buffer-children)))
(defun lyskom-buffer-root-ancestor (buffer)
"Return the ultimate ancestor of buffer BUFFER."
......@@ -218,9 +219,10 @@ the children object"
(while buffers
(if (lyskom-buffer-p (car buffers))
(setq result (cons (car buffers) result))
(save-excursion (set-buffer (car buffers))
(setq lyskom-session-has-unread-letters nil)
(setq lyskom-session-has-unreads nil)))
(save-current-buffer
(set-buffer (car buffers))
(setq lyskom-session-has-unread-letters nil)
(setq lyskom-session-has-unreads nil)))
(setq buffers (cdr buffers)))
(nreverse result)))
......@@ -238,15 +240,15 @@ If BUFFER is not specified, assume the current buffer"
(unless letters-only
(lyskom-traverse-buffer-hierarchy
(lambda (x)
(save-excursion (set-buffer x)
(setq lyskom-session-has-unreads nil)))
(save-current-buffer (set-buffer x)
(setq lyskom-session-has-unreads nil)))
buffer)
(setq lyskom-sessions-with-unread
(delq buffer lyskom-sessions-with-unread)))
(lyskom-traverse-buffer-hierarchy
(lambda (x)
(save-excursion (set-buffer x)
(setq lyskom-session-has-unread-letters nil)))
(save-current-buffer (set-buffer x)
(setq lyskom-session-has-unread-letters nil)))
buffer)
(setq lyskom-sessions-with-unread-letters
(delq buffer lyskom-sessions-with-unread-letters))
......@@ -258,8 +260,8 @@ If BUFFER is not specified, assume the current buffer"
(unless (memq buffer lyskom-sessions-with-unread)
(lyskom-traverse-buffer-hierarchy
(lambda (x)
(save-excursion (set-buffer x)
(setq lyskom-session-has-unreads t)))
(save-current-buffer (set-buffer x)
(setq lyskom-session-has-unreads t)))
buffer)
(setq lyskom-sessions-with-unread
(cons buffer lyskom-sessions-with-unread)))
......@@ -267,8 +269,8 @@ If BUFFER is not specified, assume the current buffer"
(memq buffer lyskom-sessions-with-unread-letters))
(lyskom-traverse-buffer-hierarchy
(lambda (x)
(save-excursion (set-buffer x)
(setq lyskom-session-has-unread-letters t)))
(save-current-buffer (set-buffer x)
(setq lyskom-session-has-unread-letters t)))
buffer)
(setq lyskom-sessions-with-unread-letters
(cons buffer lyskom-sessions-with-unread-letters)))
......@@ -378,7 +380,7 @@ categories")
(defun lyskom-generate-new-buffer (name)
(setq name (lyskom-recode-buffer-name name))
(let ((buf (generate-new-buffer name)))
(save-excursion
(save-current-buffer
(set-buffer buf))
buf))
......@@ -393,24 +395,24 @@ The created buffer is made a child of the current buffer."
(buffer nil))
(if (and unique buffers)
(progn (setq buffer (car buffers))
(save-excursion (set-buffer buffer)
(let ((inhibit-read-only t))
(save-current-buffer (set-buffer buffer)
(let ((inhibit-read-only t))
;;; +++ FIXME: This is that erase-buffer works if there are widgets
(setq before-change-functions
(delq 'widget-before-change
before-change-functions))
(erase-buffer))
(kill-all-local-variables)
(if (equal (buffer-name (current-buffer))
name)
nil
(rename-buffer name t))))
(setq before-change-functions
(delq 'widget-before-change
before-change-functions))
(erase-buffer))
(kill-all-local-variables)
(if (equal (buffer-name (current-buffer))
name)
nil
(rename-buffer name t))))
(progn (setq buffer (generate-new-buffer name))
(lyskom-add-buffer-of-category buffer category)))
(lyskom-set-buffer-parent buffer (current-buffer))
(lyskom-update-inherited-variables buffer)
(save-excursion (set-buffer buffer)
(setq lyskom-buffer-category category))
(save-current-buffer (set-buffer buffer)
(setq lyskom-buffer-category category))
buffer))
......@@ -491,7 +493,7 @@ Returns the window displaying BUFFER."
"-in-window")))
(open (lyskom-default-value-safe sym))
(saved-window-configuration
(save-excursion
(save-current-buffer
(set-buffer (or (and (boundp 'lyskom-buffer)
lyskom-buffer)
(current-buffer)))
......
src/command.el
View file @ b2d3faed
......@@ -682,8 +682,8 @@ chosen according to this"
(run-hooks 'lyskom-after-command-hook)
(when (and (lyskom-have-feature idle-time)
(not lyskom-is-anonymous))
(save-excursion (set-buffer lyskom-buffer)
(initiate-user-active 'background nil)))
(lyskom-with-lyskom-buffer
(initiate-user-active 'background nil)))
(if kom-inhibit-typeahead
(discard-input))
;; lyskom-pending-commands should probably be a queue or a stack.
......
src/commands1.el
View file @ b2d3faed
......@@ -1420,7 +1420,7 @@ Don't ask for confirmation."
(lyskom-get-string 'ssh-unknown-host))))
(delete-process proc)
(when (get-buffer bufname)
(save-excursion
(save-current-buffer
(set-buffer bufname)
(goto-char (point-max))
(insert "\n--- closed connection ---\n")))))))
......
src/commands2.el
View file @ b2d3faed
......@@ -1626,7 +1626,7 @@ If optional second argument MAY-BE-DEAD is non-nil, this function returns t
whether the session is alive or not. Otherwise it checks that the session
is alive."
(when (buffer-live-p buf)
(save-excursion
(save-current-buffer
(set-buffer buf)
(and (eq major-mode 'lyskom-mode)
(boundp 'lyskom-proc)
......@@ -1767,7 +1767,7 @@ See `kom-next-kom' and `kom-previous-kom' for related commands."
(when lyskom-sessions-with-unread
(let ((unreads
(mapcar (lambda (buffer)
(save-excursion
(save-current-buffer
(set-buffer buffer)
(vector
(lyskom-format "%#1P, %#2s%#3?b%[ (%#4s)%]%[%]"
......@@ -2378,10 +2378,10 @@ This command accepts text number prefix arguments \(see
(defun lyskom-keep-alive-callback (buffer)
(condition-case nil
(save-excursion (set-buffer buffer)
(if (eq (process-status lyskom-proc) 'open)
(initiate-get-time 'keep nil)
(lyskom-stop-keep-alive)))
(save-current-buffer (set-buffer buffer)
(if (eq (process-status lyskom-proc) 'open)
(initiate-get-time 'keep nil)
(lyskom-stop-keep-alive)))
(error (lyskom-stop-keep-alive))))
(def-kom-command kom-keep-alive ()
......
src/edit-text.el
View file @ b2d3faed
......@@ -297,9 +297,6 @@ NUMBER is the number of the person. Used if the conf-stat is nil."
(if text-stat
(let ((mx-from (car (lyskom-get-aux-item (text-stat->aux-items text-stat) 17)))
(mx-author (car (lyskom-get-aux-item (text-stat->aux-items text-stat) 16))))
(lyskom-edit-insert-commented-author
(if (or mx-from mx-author)
(lyskom-format-mx-author mx-from mx-author)
......@@ -659,16 +656,7 @@ This runs `kom-send-text-hook' and (for backwards compatibility)
(lyskom-beep kom-ding-on-no-subject)
(if (cdr-safe (cdr-safe err))
(goto-char (car-safe (cdr-safe (cdr-safe err)))))
(lyskom-message "%s" (lyskom-get-string (car (cdr err))))
(condition-case nil
(let ((text ""))
(save-excursion
(set-buffer lyskom-buffer)
(if (and (string= "kom.lysator.liu.se" lyskom-server-name)
(eq lyskom-pers-no 698))
(setq text "rende, IDI!")))
(save-excursion (insert text)))
(error nil)))
(lyskom-message "%s" (lyskom-get-string (car (cdr err)))))
(lyskom-unknown-header
(lyskom-message "%s" (lyskom-get-string (car (cdr err)))))))
......@@ -795,8 +783,7 @@ Cannot be called from a callback."
(collector (make-collector))
(extra-headers nil)
(buffer (current-buffer))
(me (save-excursion (set-buffer lyskom-buffer)
lyskom-pers-no))
(me (lyskom-with-lyskom-buffer lyskom-pers-no))
(num-me 0)
(num-real-recpt 0))
(lyskom-ignore text-stat) ; Have no idea if its ever used...
......@@ -837,15 +824,14 @@ Cannot be called from a callback."
;; Check for new comments
;;
(when (save-excursion (set-buffer lyskom-buffer)
(cond ((null kom-check-for-new-comments) nil)
((functionp kom-check-for-new-comments)
(funcall kom-check-for-new-comments
buffer misc-list subject))
(t t)))
(when (lyskom-with-lyskom-buffer
(cond ((null kom-check-for-new-comments) nil)
((functionp kom-check-for-new-comments)
(funcall kom-check-for-new-comments
buffer misc-list subject))
(t t)))
(lyskom-message "%s" (lyskom-format 'checking-comments))
(save-excursion
(set-buffer lyskom-buffer)
(lyskom-with-lyskom-buffer
(set-collector->value collector nil)
(mapc (lambda (text-stat)
......@@ -967,7 +953,7 @@ Cannot be called from a callback."
"lyskom-enriched"
t)))
(unwind-protect
(save-excursion
(save-current-buffer
(set-buffer buf)
(insert lyskom-edit-text)
(goto-char (point-min))
......@@ -978,8 +964,7 @@ Cannot be called from a callback."
(replace-in-string (buffer-substring (point) (point-max))
"<<" "<" t)
lyskom-edit-text))
(save-excursion
(set-buffer lyskom-buffer)
(lyskom-with-lyskom-buffer
(lyskom-j-or-n-p
(lyskom-get-string 'send-formatted))))
(setq lyskom-edit-text (buffer-substring (point) (point-max)))
......@@ -1131,7 +1116,7 @@ info node in a LysKOM text."
(interactive)
(condition-case nil
(let ((link nil))
(save-excursion
(save-current-buffer
(set-buffer (get-buffer "*info*"))
(setq link (format "*Note %s: (%s)%s,"
Info-current-node
......@@ -1206,7 +1191,7 @@ text was."
(defun lyskom-edit-move-recipients (conf-stat insert-at edit-buffer)
(save-excursion
(save-current-buffer
(set-buffer edit-buffer)
(let* ((headers (lyskom-edit-parse-headers))
(subject (lyskom-text-headers->subject headers))
......@@ -1236,11 +1221,11 @@ text was."
miscs)))))
(lyskom-edit-replace-headers subject (cons 'MISC-LIST miscs) aux-list))))
(defun lyskom-edit-do-add-recipient/copy (recpt-type recpt-no edit-buffer)
(save-excursion
(save-current-buffer
(set-buffer edit-buffer)
(let* ((headers (lyskom-edit-parse-headers))
(miscs (lyskom-edit-translate-headers (lyskom-text-headers->misc-info headers)))
......@@ -1264,54 +1249,54 @@ RECPT-TYPE is the type of recipient to add."
(insert-at (point-min-marker))
(conf-stat (lyskom-read-conf-stat prompt '(all) nil nil t)))
(lyskom-save-excursion
(save-excursion
(set-buffer lyskom-buffer)
;; +++ The information about msg-of-day might be old. We should
;; make sure it is up-to-date.
(let ((text-no (conf-stat->msg-of-day conf-stat))
(win-config nil)
(text nil)
(text-stat nil)
(collector (make-collector)))
(unless (zerop text-no)
(initiate-get-text 'edit 'collector-push text-no collector)
(initiate-get-text-stat 'edit 'collector-push text-no collector)
(lyskom-wait-queue 'edit)
(setq text-stat (elt (collector->value collector) 0))
(setq text (elt (collector->value collector) 1)))
(when (or (null text)
(null text-stat)
(null (get-buffer-window edit-buffer))
(progn (setq win-config (current-window-configuration))
(with-output-to-temp-buffer "*Motd*"
(lyskom-princ
(lyskom-format 'conf-has-motd-no
(text->text-no text)
(text->decoded-text-mass text
text-stat))))
(j-or-n-p (lyskom-get-string 'still-want-to-add))))
(when (and kom-confirm-add-recipients
(eq recpt-type 'RECPT)
(not (lyskom-j-or-n-p (lyskom-format
'really-add-as-recpt-q
conf-stat))))
(setq recpt-type 'CC-RECPT))
(if what-to-do
(funcall what-to-do conf-stat insert-at edit-buffer)
(lyskom-edit-do-add-recipient/copy recpt-type
(conf-stat->conf-no conf-stat)
edit-buffer)))
(when win-config (set-window-configuration win-config))))
(save-current-buffer
(set-buffer lyskom-buffer)
;; +++ The information about msg-of-day might be old. We should
;; make sure it is up-to-date.
(let ((text-no (conf-stat->msg-of-day conf-stat))
(win-config nil)
(text nil)
(text-stat nil)
(collector (make-collector)))
(unless (zerop text-no)
(initiate-get-text 'edit 'collector-push text-no collector)
(initiate-get-text-stat 'edit 'collector-push text-no collector)
(lyskom-wait-queue 'edit)
(setq text-stat (elt (collector->value collector) 0))
(setq text (elt (collector->value collector) 1)))
(when (or (null text)
(null text-stat)
(null (get-buffer-window edit-buffer))
(progn (setq win-config (current-window-configuration))
(with-output-to-temp-buffer "*Motd*"
(lyskom-princ
(lyskom-format 'conf-has-motd-no
(text->text-no text)
(text->decoded-text-mass text
text-stat))))
(j-or-n-p (lyskom-get-string 'still-want-to-add))))
(when (and kom-confirm-add-recipients
(eq recpt-type 'RECPT)
(not (lyskom-j-or-n-p (lyskom-format
'really-add-as-recpt-q
conf-stat))))
(setq recpt-type 'CC-RECPT))
(if what-to-do
(funcall what-to-do conf-stat insert-at edit-buffer)
(lyskom-edit-do-add-recipient/copy recpt-type
(conf-stat->conf-no conf-stat)
edit-buffer)))
(when win-config (set-window-configuration win-config))))
(set-marker insert-at nil))))
(defun lyskom-edit-sub-recipient/copy (recpt-no edit-buffer)
"Remove the recipient having RECPT-NO from EDIT-BUFFER"
(save-excursion
(save-current-buffer
(set-buffer edit-buffer)
(let* ((headers (lyskom-edit-parse-headers))
(miscs (lyskom-edit-translate-headers (lyskom-text-headers->misc-info headers)))
......@@ -1452,28 +1437,28 @@ link as a string."
(defun lyskom-edit-toggle-secret-aux (buf arg text)
(interactive)
(lyskom-save-excursion
(save-current-buffer
(set-buffer (car arg))
(goto-char (cdr arg))
(lyskom-edit-toggle-aux-item-flag buf arg text 'secret)))
(defun lyskom-edit-toggle-anonymous-aux (buf arg text)
(interactive)
(save-excursion
(save-current-buffer
(set-buffer (car arg))
(goto-char (cdr arg))
(lyskom-edit-toggle-aux-item-flag buf arg text 'anonymous)))
(defun lyskom-edit-toggle-inherit-aux (buf arg text)
(interactive)
(save-excursion
(save-current-buffer
(set-buffer (car arg))
(goto-char (cdr arg))
(lyskom-edit-toggle-aux-item-flag buf arg text 'inherit)))
(defun lyskom-edit-delete-aux (buf arg text)
(interactive)
(save-excursion
(save-current-buffer
(set-buffer (car arg))
(goto-char (cdr arg))
(beginning-of-line)
......@@ -1481,8 +1466,7 @@ link as a string."
(defun lyskom-edit-generate-aux-item-flags (flags)
(save-excursion
(let ((str (mapconcat 'identity
(let ((str (mapconcat 'identity
(delq nil
(list
(and (aux-item-flags->secret flags)
......@@ -1493,7 +1477,7 @@ link as a string."
(lyskom-get-string 'inherit-aux-flag))))
", ")))
(when (not (string= str ""))
(format " [%s]" str)))))
(format " [%s]" str))))
(defun lyskom-edit-insert-aux-item-flags (flags)
(end-of-line)
......@@ -1593,53 +1577,54 @@ non-nil. If MATCH-NUMBER is 'angled, only match a number inside <>."
"Parse the headers of an article.
The value returned is a lyskom-text-headers structure."
(goto-char (point-min))
(let ((misc nil)
(subject nil)
(aux nil))
(save-restriction
;; Narrow to headers
(lyskom-edit-find-separator t)
(narrow-to-region (point-min) (point))
(goto-char (point-min))
(while (< (point) (point-max))
(let ((case-fold-search t)
(n nil))
(cond
((setq n (lyskom-looking-at-header 'recipient-prefix 'angled))
(setq misc (nconc misc (list 'RECPT n))))
((setq n (lyskom-looking-at-header 'carbon-copy-prefix 'angled))
(setq misc (nconc misc (list 'CC-RECPT n))))
((setq n (lyskom-looking-at-header 'blank-carbon-copy-prefix
'angled))
(setq misc (nconc misc (list 'BCC-RECPT n))))
((setq n (lyskom-looking-at-header 'comment-prefix t))
(setq misc (nconc misc (list 'COMM-TO n))))
((setq n (lyskom-looking-at-header 'footnote-prefix t))
(setq misc (nconc misc (list 'FOOTN-TO n))))
((lyskom-looking-at-header 'header-subject nil)
(setq subject (lyskom-edit-extract-subject)))
((lyskom-looking-at (lyskom-get-string 'aux-item-prefix-regexp))
(goto-char (match-end 0))
(let ((item (lyskom-edit-parse-aux-item)))
(if item
(setq aux (cons item aux))
(signal 'lyskom-unknown-header
(list 'unknown-header (point))))))
((lyskom-looking-at (lyskom-get-string 'comment-item-prefix))
nil)
((or (lyskom-looking-at-header 'blank-carbon-copy-prefix 'empty)
(lyskom-looking-at-header 'carbon-copy-prefix 'empty)
(lyskom-looking-at-header 'recipient-prefix 'empty))
nil)
((lyskom-looking-at-header 'add-recpt-button-text-regex nil) nil)
(t (signal 'lyskom-unknown-header (list 'unknown-header (point))))))
(forward-line 1)))
(lyskom-create-lyskom-text-headers subject misc aux)))
(save-excursion
(goto-char (point-min))
(let ((misc nil)
(subject nil)
(aux nil))
(save-restriction
;; Narrow to headers
(lyskom-edit-find-separator t)
(narrow-to-region (point-min) (point))
(goto-char (point-min))
(while (< (point) (point-max))
(let ((case-fold-search t)
(n nil))
(cond
((setq n (lyskom-looking-at-header 'recipient-prefix 'angled))
(setq misc (nconc misc (list 'RECPT n))))
((setq n (lyskom-looking-at-header 'carbon-copy-prefix 'angled))
(setq misc (nconc misc (list 'CC-RECPT n))))
((setq n (lyskom-looking-at-header 'blank-carbon-copy-prefix
'angled))
(setq misc (nconc misc (list 'BCC-RECPT n))))
((setq n (lyskom-looking-at-header 'comment-prefix t))
(setq misc (nconc misc (list 'COMM-TO n))))
((setq n (lyskom-looking-at-header 'footnote-prefix t))
(setq misc (nconc misc (list 'FOOTN-TO n))))
((lyskom-looking-at-header 'header-subject nil)
(setq subject (lyskom-edit-extract-subject)))
((lyskom-looking-at (lyskom-get-string 'aux-item-prefix-regexp))
(goto-char (match-end 0))
(let ((item (lyskom-edit-parse-aux-item)))
(if item
(setq aux (cons item aux))
(signal 'lyskom-unknown-header
(list 'unknown-header (point))))))
((lyskom-looking-at (lyskom-get-string 'comment-item-prefix))
nil)
((or (lyskom-looking-at-header 'blank-carbon-copy-prefix 'empty)
(lyskom-looking-at-header 'carbon-copy-prefix 'empty)
(lyskom-looking-at-header 'recipient-prefix 'empty))
nil)
((lyskom-looking-at-header 'add-recpt-button-text-regex nil) nil)
(t (signal 'lyskom-unknown-header (list 'unknown-header (point))))))
(forward-line 1)))
(lyskom-create-lyskom-text-headers subject misc aux))))
(defun lyskom-edit-parse-aux-item ()
(let ((definitions lyskom-aux-item-definitions)
......@@ -1737,8 +1722,8 @@ Point must be located on the line where the subject is."
(initiate-get-conf-stat 'background